delphi - 如何在 VCL 风格的页面控件上进行所有者绘制

Question

当我有这个时:

if not _nightMode then
  TStyleManager.TrySetStyle('Windows', False);

我可以在页面控件上进行所有者绘制:

procedure TMyMainForm.pcDetailedDrawTab(Control: TCustomTabControl; TabIndex: Integer;
    const Rect: TRect; Active: Boolean);
var
  can: TCanvas;
  cx, by: Integer;
  aclr: TColor;
begin
  if pcDetailed.Pages[TabIndex] = tsActualData then begin
    can := pcDetailed.Canvas;
    cx := Rect.Left + Rect.Width div 2;
    by := Rect.Bottom - 2;
    if _nightMode then aclr := clWhite else aclr := clBlack;
    can.Pen.Color := aclr;
    can.Brush.Color := aclr;
    can.Polygon([Point(cx - 10, by - 10), Point(cx + 10, by - 10), Point(cx, by)]);
  end;
end;

当我有这个时:

if _nightMode then
  TStyleManager.TrySetStyle('Cobalt XEMedia', False);

我画的三角形丢失了。

如何用任何VCL风格绘制三角形？

德尔福 10 西雅图。

Answer 1

何时 Styles除了选择原生的“Windows”样式之外，StyleHook 类将开始将绘制相关的 Windows 消息 Hook 到控件。不同的控件类有不同的 StyleHook 类。

对于TPageControl，它是TTabControlStyleHook。钩子(Hook)类组合在 TCustomTabControl 的类构造函数中使用 TCustomStyleEngine.RegisterStyleHook(TCustomTabControl, TTabControlStyleHook); 注册。该钩子(Hook)类会覆盖控件绘制，因为当启用样式时它将绘制 TCustomTabControl 本身。

可以做的就是注销默认的TStyleHookClass并注册一个可以让开发人员绘制的:

  TCustomStyleEngine.UnRegisterStyleHook(TCustomTabControl, TTabControlStyleHook);
  TCustomStyleEngine.RegisterStyleHook(TCustomTabControl, TMyTabControlStyleHook);

其中TMyTabControlStyleHook如下:

type
  TMyTabControlStyleHook = class(TTabControlStyleHook)
  public
    constructor Create(AControl: TWinControl); override;
  end;

constructor TMyTabControlStyleHook.Create(AControl: TWinControl);
begin
  inherited Create(AControl);
  OverridePaint := False;
end;

但这并不完全等同于仅绘制 TPageControl 中的选项卡，因为 TTabControlStyleHook 负责绘制完整的 TPageControl控制。

但是TTabControlStyleHook有过程DrawTab(Canvas: TCanvas; Index: Integer); virtual; 可以为此重写。

type
  TMyTabControlStyleHook = class(TTabControlStyleHook)
  strict protected
    procedure DrawTab(Canvas: TCanvas; Index: Integer); override;
  end;

procedure TMyTabControlStyleHook.DrawTab(Canvas: TCanvas; Index: Integer);
begin
  DrawTabOverride(Canvas, Index, TabRect[Index], TCustomTabControl(Control).MouseInClient);
end;

其中DrawTabOverride是这样的

procedure DrawTabOverride(Canvas: TCanvas;
  TabIndex: Integer; const Rect: TRect; Active: Boolean);

因此可以在绘制 native 时在 OnDrawTab 事件中调用它，并在设置样式时在 StyleHook 类 DrawTab 中调用它。