如何在 VCL 样式的页面控件上进行所有者绘制答案

【问题标题】：How to owner-draw on VCL-styled Page Control如何在 VCL 样式的页面控件上进行所有者绘制
【发布时间】：2017-10-19 07:52:59
【问题描述】：

当我有这个时：

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风格绘制三角形？

Delphi 10 西雅图。

【问题讨论】：

它是 VCL 样式而不是主题。而 Delphi 的版本通常对此类问题很重要。

标签： delphi canvas delphi-10-seattle ownerdrawn tpagecontrol

【解决方案1】：

When Styles other than the native 'Windows'-style are chosen a StyleHook-class will begin to hook paint relevant windows messages to controls.不同的控件类有不同的StyleHook 类。

如果是TPageControl，则为TTabControlStyleHook。 hook-class-combination 在TCustomTabControl 的类构造函数中注册为TCustomStyleEngine.RegisterStyleHook(TCustomTabControl, TTabControlStyleHook);。这个钩子类覆盖了控件绘制，因为它会在启用样式时绘制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 有 procedure 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);

所以它可以在绘制原生时在 OnDrawTab 事件中调用，在样式化时在 StyleHook 类 DrawTab 中调用。

【讨论】：