¿Cómo cambiar una aplicación entre temática y no temática en tiempo de ejecución?

Question

Muy parecido al "Proyecto | Opciones | Aplicación | Habilitar temas de tiempo de ejecución" CheckBox, pero dinámicamente en tiempo de ejecución.
[Delphi XE que apuntan a Win XP o Win 7]

Traté de jugar un poco con uxTheme.SetWindowTheme sin éxito hasta el momento ....

Answer 1

Solo para complementar la respuesta de Rob Kennedy, debe usar el SetThemeAppProperties de esta manera.

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; 

y para determinar si los controles son temáticos o no puede utilizar la función GetThemeAppProperties.

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

    end; 
end; 

ACTUALIZACIÓN

Debido a los problemas descritos para usted, puedo comprobar el código de la unidad UxTheme y veo el problema está relacionado con la función UseThemes. así que escribí este pequeño parche (usando las funciones del parche HookProc, UnHookProc y GetActualAddr desarrollado por Andreas Hausladen), que funciona bien en mis pruebas. déjame saber si funciona para ti también.

debe incluir el PatchUxTheme en su lista de usos. y llame a las funciones DisableThemesApp y 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

llamada SetThemeAppProperties.

Answer 3

Para uno de mis proyectos que utilizan algo como esto:

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; 

Uso como: RemoveTheme ([Edit1.Handle, Edit2.Handle]);