Отключить постановку на определенные элементы управления?

Question

Я знаю, что вы можете использовать SetWindowTheme найденный в uxTheme.pas, чтобы отключить/включить тематизации на элементы управления, как это, например:

SetWindowTheme(Button1.Handle, nil, nil); 

Это работает довольно много элементов управления, однако он не будет работать на некоторые элементы управления, такие как TBitBtn или TSpeedButton. Я думаю, это должно быть потому, что TBitBtn и TSpeedButton не являются элементами управления Windows, а обычными?

Могут быть другие элементы управления, которые также не будут работать, поэтому я надеялся, что кто-то может поделиться решением или альтернативой для достижения этого?

Я хочу, чтобы некоторые элементы управления вообще не имели тематики, например, они будут отображаться как классические, пока остальные элементы управления не будут затронуты.

Спасибо.

Answer 1

Ваш анализ верен. SetWindowTheme работает для управления окнами, но TSpeedButton и TBitBtn - это элементы управления, не связанные с winower.

В XE, из моего быстрого сканирования, кажется, что большинство элементов управления вызывает Themes.ThemeControl, чтобы определить, следует ли рисовать themed. Таким образом, простым решением является замена этой процедуры логикой, которую вы контролируете. Поскольку он не предоставляет никаких точек расширения, вам нужно подключить его. Как это:

procedure PatchCode(Address: Pointer; const NewCode; Size: Integer); 
var 
    OldProtect: DWORD; 
begin 
    if VirtualProtect(Address, Size, PAGE_EXECUTE_READWRITE, OldProtect) then 
    begin 
    Move(NewCode, Address^, Size); 
    FlushInstructionCache(GetCurrentProcess, Address, Size); 
    VirtualProtect(Address, Size, OldProtect, @OldProtect); 
    end; 
end; 

type 
    PInstruction = ^TInstruction; 
    TInstruction = packed record 
    Opcode: Byte; 
    Offset: Integer; 
    end; 

procedure RedirectProcedure(OldAddress, NewAddress: Pointer); 
var 
    NewCode: TInstruction; 
begin 
    NewCode.Opcode := $E9;//jump relative 
    NewCode.Offset := NativeInt(NewAddress)-NativeInt(OldAddress)-SizeOf(NewCode); 
    PatchCode(OldAddress, NewCode, SizeOf(NewCode)); 
end; 

function MyThemeControl(AControl: TControl): Boolean; 
begin 
    Result := False; 
    if AControl = nil then exit; 
    if AControl is TSpeedButton then exit; 
    if AControl is TBitBtn then exit; 
    Result := (not (csDesigning in AControl.ComponentState) and ThemeServices.ThemesEnabled) or 
      ((csDesigning in AControl.ComponentState) and (AControl.Parent <> nil) and 
      (ThemeServices.ThemesEnabled and not UnthemedDesigner(AControl.Parent))); 
end; 

initialization 
    RedirectProcedure(@Themes.ThemeControl, @MyThemeControl); 

Как можно заметить, это не будет работать с пакетами времени выполнения, но это достаточно легко расширить код для работы с пакетами.

Answer 2

Если вы посмотрите на исходный код для TBitBtn (в частности, TBitBtn.DrawItem), вы увидите, что он нарисован вручную в исходном коде Delphi. Он использует API визуальных тем Windows для рисования кнопки (ThemeServices.Draw*) в текущей теме, если темы включены. Если нет, он использует функции Windows API старого стиля для рисования элементов управления, таких как Rectangle и DrawFrameControl. Я думаю, вам нужно изменить исходный код элемента управления, чтобы обойти это поведение.