如何在运行时在主题和非主题之间切换应用程序? [英] How to switch an Application between Themed and not Themed at run-time?

问题描述

非常像项目|选项|应用程序|启用运行时主题"复选框，但在运行时是动态的.
[Delphi XE 针对 Win XP 或 Win 7]

Very much like the "Project|Options|Application|Enable runtime themes" CheckBox, but dynamically at run-time instead.
[Delphi XE targetting Win XP or Win 7]

到目前为止，我尝试使用 uxTheme.SetWindowTheme 玩了一下，但没有成功......

I tried playing a bit with uxTheme.SetWindowTheme without success so far....

推荐答案

为了补充 Rob Kennedy 的答案，您必须以这种方式使用 SetThemeAppProperties.

Just for complement the Rob Kennedy answer, you must use the SetThemeAppProperties in this way.

uses
 UxTheme;

procedure DisableThemesApp;
begin
  SetThemeAppProperties(0);
  SendMessage(Application.Handle,WM_THEMECHANGED,0,0);
  SendMessage(Application.MainForm.Handle,CM_RECREATEWND,0,0);
end;

procedure EnableThemesApp;
begin
  SetThemeAppProperties(STAP_ALLOW_NONCLIENT or STAP_ALLOW_CONTROLS or STAP_ALLOW_WEBCONTENT);
  SendMessage(Application.Handle,WM_THEMECHANGED,0,0);
  SendMessage(Application.MainForm.Handle,CM_RECREATEWND,0,0);
end;

并确定您的控件是否具有主题，您可以使用 GetThemeAppProperties 函数.

and to determine if your controls are themed or not you can use the GetThemeAppProperties function.

var
  Flag : DWORD;
begin
  Flag:=GetThemeAppProperties;
  if (Flag and STAP_ALLOW_CONTROLS)<>0 then //if the controls are themed
  begin

  end;
end;

更新

由于为您描述的问题，我检查了 UxTheme 单元的代码，发现问题与 UseThemes 功能有关.所以我写了这个小补丁(使用由 Andreas Hausladen 开发的 HookProc、UnHookProc 和 GetActualAddr 补丁的功能)，它在我的测试中运行良好.如果也适合您，请告诉我.

Due to the issues described for you , i check the code of the UxTheme unit and i see the problem is related to the UseThemes function . so i wrote this small patch (using the functions to patch HookProc, UnHookProc and GetActualAddr developed by Andreas Hausladen), which works ok on my tests. let my know if works for you too.

您必须在使用列表中包含 PatchUxTheme.并调用函数DisableThemesApp 和 EnableThemesApp.

you must include the PatchUxTheme in your uses list. and call the functions DisableThemesApp and EnableThemesApp.

unit PatchUxTheme;

interface


procedure EnableThemesApp;
procedure DisableThemesApp;


implementation

uses
Controls,
Forms,
Messages,
UxTheme,
Sysutils,
Windows;

type
  TJumpOfs = Integer;
  PPointer = ^Pointer;

  PXRedirCode = ^TXRedirCode;
  TXRedirCode = packed record
    Jump: Byte;
    Offset: TJumpOfs;
  end;

  PAbsoluteIndirectJmp = ^TAbsoluteIndirectJmp;
  TAbsoluteIndirectJmp = packed record
    OpCode: Word;
    Addr: PPointer;
  end;

var
 UseThemesBackup: TXRedirCode;

function GetActualAddr(Proc: Pointer): Pointer;
begin
  if Proc <> nil then
  begin
    if (Win32Platform = VER_PLATFORM_WIN32_NT) and (PAbsoluteIndirectJmp(Proc).OpCode = $25FF) then
      Result := PAbsoluteIndirectJmp(Proc).Addr^
    else
      Result := Proc;
  end
  else
    Result := nil;
end;


procedure HookProc(Proc, Dest: Pointer; var BackupCode: TXRedirCode);
var
  n: DWORD;
  Code: TXRedirCode;
begin
  Proc := GetActualAddr(Proc);
  Assert(Proc <> nil);
  if ReadProcessMemory(GetCurrentProcess, Proc, @BackupCode, SizeOf(BackupCode), n) then
  begin
    Code.Jump := $E9;
    Code.Offset := PAnsiChar(Dest) - PAnsiChar(Proc) - SizeOf(Code);
    WriteProcessMemory(GetCurrentProcess, Proc, @Code, SizeOf(Code), n);
  end;
end;

procedure UnhookProc(Proc: Pointer; var BackupCode: TXRedirCode);
var
  n: Cardinal;
begin
  if (BackupCode.Jump <> 0) and (Proc <> nil) then
  begin
    Proc := GetActualAddr(Proc);
    Assert(Proc <> nil);
    WriteProcessMemory(GetCurrentProcess, Proc, @BackupCode, SizeOf(BackupCode), n);
    BackupCode.Jump := 0;
  end;
end;

function UseThemesH:Boolean;
Var
 Flag : DWORD;
begin
  Flag:=GetThemeAppProperties;
  if ( (@IsAppThemed<>nil) and (@IsThemeActive<>nil) ) then
    Result := IsAppThemed and IsThemeActive and ((Flag and STAP_ALLOW_CONTROLS)<>0)
  else
    Result := False;
end;

procedure HookUseThemes;
begin
  HookProc(@UxTheme.UseThemes, @UseThemesH, UseThemesBackup);
end;

procedure UnHookUseThemes;
begin
  UnhookProc(@UxTheme.UseThemes, UseThemesBackup);
end;


Procedure DisableThemesApp;
begin
  SetThemeAppProperties(0);
  SendMessage(Application.Handle,WM_THEMECHANGED,0,0);
  SendMessage(Application.MainForm.Handle,CM_RECREATEWND,0,0);
end;

Procedure EnableThemesApp;
begin
  SetThemeAppProperties(STAP_ALLOW_NONCLIENT or STAP_ALLOW_CONTROLS or STAP_ALLOW_WEBCONTENT);
  SendMessage(Application.Handle,WM_THEMECHANGED,0,0);
  SendMessage(Application.MainForm.Handle,CM_RECREATEWND,0,0);
end;

initialization
 HookUseThemes;
finalization
 UnHookUseThemes;
end.

这篇关于如何在运行时在主题和非主题之间切换应用程序?的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！