delphi - 禁用特定控件上的主题？

Question

我知道您可以使用 uxTheme.pas 中的 SetWindowTheme 来禁用/启用控件上的主题，例如:

SetWindowTheme(Button1.Handle, nil, nil);

这适用于相当多的控件，但不适用于某些控件，例如 TBitBtn 或 TSpeedButton。我想这一定是因为 TBitBtn 和 TSpeedButton 不是 Windows 控件，而是自定义控件？

很可能还有其他控件也不起作用，所以我希望有人可以分享解决方案或替代方案来实现此目的？

我希望某些控件根本没有主题，例如它们将显示为经典主题，而其余控件不会受到影响。

谢谢。

Answer 1

你的分析是正确的。 SetWindowTheme 适用于窗口控件，但 TSpeedButton 和 TBitBtn 是非窗口控件。

在XE中，从我的快速扫描来看，似乎大多数控件都会调用Themes.ThemeControl来确定是否绘制主题。因此，简单的解决方案就是用您控制的逻辑替换该例程。由于它不提供任何扩展点，因此您需要 Hook 它。像这样:

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

就目前情况而言，这不适用于运行时包，但扩展代码以使用包很容易。