Отключить тему на определенных элементах управления? - PullRequest
Новая
       16

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

8 голосов
/ 01 апреля 2012

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

SetWindowTheme(Button1.Handle, nil, nil);

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

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

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

Спасибо.

Ответы [ 2 ]

13 голосов
/ 01 апреля 2012

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

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

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);

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

5 голосов
/ 01 апреля 2012

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

...