在特定控件上禁用主题？

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源代码中手动绘制的.ThemeServices.Draw*如果启用了主题,它使用Windows视觉主题API 在当前主题中绘制button().如果没有,它使用旧式Windows API函数来绘制控件,例如Rectangle和DrawFrameControl.我认为你必须改变控件的源代码以避免这种行为.