且构网

分享程序员开发的那些事...
且构网 - 分享程序员编程开发的那些事

如何在运行时在主题和非主题之间切换应用程序?

更新时间:2022-11-10 17:54:55

为了补充 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 开发的 HookProcUnHookProcGetActualAddr 补丁的功能),它在我的测试中运行良好.如果也适合您,请告诉我.

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.并调用函数DisableThemesAppEnableThemesApp.

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.