如何在运行时切换主题与主题之间的应用？

问题描述

限时删除！！

非常像项目|选项|应用程序|启用运行时主题复选框，但在运行时动态更改。

[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....

推荐答案

p>为了补充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;

并确定您的控件是否为主题，您可以使用功能。

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 函数。所以我写了这个小补丁（使用函数来修补 HookProc ， UnHookProc 和 GetActualAddr 由Andreas Hausladen开发），这在我的测试中工作正常。让我知道，如果你也适合你。

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 functionsDisableThemesApp 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.

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

1403页，肝出来的..