如何在運行時切換主題和非主題之間的應用程序？

Question

非常像「項目|選項|應用程序|啓用運行時主題」複選框，但在運行時動態地改爲。
[德爾福XE靶向的Win XP或Win 7]

我試着打了一下，有沒有uxTheme.SetWindowTheme到目前爲止成功....

Answer 1

只是爲了補充Rob Kennedy的回答，您必須以這種方式使用SetThemeAppProperties。

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功能。

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功能。所以我寫了這個小補丁（使用功能補丁HookProc，UnHookProc和GetActualAddr由Andreas Hausladen開發），這在我的測試中工作正常。讓我知道你是否也適合你。

您必須在您的使用列表中包含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, 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. 

Answer 2

呼叫SetThemeAppProperties。

Answer 3

爲我的項目之一，我使用的是這樣的：

Procedure RemoveTheme(Const Controls : Array Of HWnd; Const Redraw : Boolean = True); 
Var 
    I : Integer; 
Begin 
    If IsAppThemed And IsThemeActive Then Try 
    I := 0; 
    While (I < Length(Controls)) Do Begin 
     If (Controls[I] > 0) And IsWindow(Controls[I]) Then SetWindowTheme(Controls[I], '', ''); 
     If Redraw Then Begin 
     InvalidateRect(Controls[I], Nil, True); 
     UpdateWindow(Controls[I]); 
     End; 
     Inc(I); 
    End; 
    Except 
    End; 
End; 

使用像： RemoveTheme（[Edit1.Handle，Edit2.Handle]）;