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

非常像“项目|选项|应用程序|启用运行时主题”复选框，但在运行时动态。
[Delphi XE目标Win XP或Win 7]

我尝试用uxTheme.SetWindowTheme玩一点没有成功到目前为止….

解决方法

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

uses
 UxTheme;

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

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

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

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

  end;
end;

UPDATE

由于为您描述的问题，我检查UxTheme单元的代码，我看到的问题是与UseThemes函数有关。所以我写了这个小补丁(使用函数来修补由Andreas Hausladen开发的HookProc，UnHookProc和GetActualAddr)，这在我的测试中可以正常工作。让我知道如果为你工作。

您必须在使用列表中包含PatchUxTheme。并调用这些功能
DisableThemesApp和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,@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,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,0);
end;

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

initialization
 HookUseThemes;
finalization
 UnHookUseThemes;
end.

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

解决方法

猜你在找的Delphi相关文章