Question

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

SetWindowTheme(Button1.Handle, nil, nil);

这适用于很多控件，但它不适用于某些控件，如TBitBtn或TSpeedButton。我认为这必须是因为TBitBtn和TSpeedButton不是Windows控件，而是自定义控件？

可能还有其他控件无法正常工作，所以我希望有人可以分享解决方案或替代方案来实现这一目标吗？

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

感谢。

Answer 1

您的分析是正确的。 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);

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

Answer 2

如果查看TBitBtn的源代码（特别是TBitBtn.DrawItem），您会看到它是在Delphi源代码中手动绘制的。如果启用了主题，它使用Windows视觉主题API在当前主题中绘制按钮（ThemeServices.Draw*）。如果没有，它使用旧式Windows API函数来绘制控件，例如Rectangle和DrawFrameControl。我认为你必须改变控件的源代码以避免这种行为。

在特定控件上禁用主题？

2 个答案: