使所有者绘制的TPageControl选项卡看起来更好，就像没有所有者绘制一样 [英] Make owner-drawn TPageControl tabs look nicer, like without owner-draw

问题描述

我使用拥有者绘图的Delphi7，PageControl。正如我在非所有者绘制的PageControl上所看到的那样，标签的外观如此简洁明快。不好的地方：
使用owner-draw时，我无法在整个标签页眉区域上绘图，标签页眉周围的1-2px小边框由操作系统绘制。

I use Delphi7, PageControl with owner-draw. I can't get so plain and nice look of tabs, as I see on not-owner-drawn PageControls. What's bad: when using owner-draw, I can't draw on "entire" tab header area, small 1-2px frame around tab header is painted by OS.

1）Delphi不是所有者绘制的，看起来也不错（使用XPMan）：

1) Delphi not owner-draw, look is OK too (XPMan used):

2）Delphi owner-draw，您看不到整个标签页头都可以着色（使用XPMan）：

2) Delphi owner-draw, you see not entire tab header can be colored (XPMan used):

在这里，我用蓝色绘制当前标签，而其他用白色绘制。仅是示例。
代码：

I draw current tab with blue and others with white, here. Only example. Code:

procedure TForm1.PageControl1DrawTab(Control: TCustomTabControl;
  TabIndex: Integer; const Rect: TRect; Active: Boolean);
var
  c: TCanvas;
begin
  c:= (Control as TPageControl).Canvas;
  if Active then
    c.Brush.Color:= clBlue
  else
    c.Brush.Color:= clWhite;
  c.FillRect(Rect);    
end;

2b）Delphi所有者在真实应用程序中绘制（使用XPMan）：

2b) Delphi owner-draw in real app (XPMan used):

为什么需要使用所有者提款？简单。在标签页眉上绘制X按钮，以自定义颜色绘制上划线，从图像列表中绘制图标。

Why do i need to use owner-draw? Simple. To draw X button on tab headers, to paint upper-line with custom color, to paint icons from imagelists.

我正在寻找一种绘画的方法标签页头的全部矩形，而不是减少给PageControl所有者绘制事件的矩形。我试图增加所有者绘制事件给定的矩形，但这无济于事，操作系统无论如何都会在制表符标题周围重绘此1-2px的细边框。

I'm looking for a way to paint ENTIRE rect of tab headers, not decreased rect which is given to PageControl owner-draw events. I tried to increase the rect given by owner-draw events, but this doesn't help, OS repaints this thin 1-2px frame around tab headers anyway.

推荐答案

所有者的选项卡在VCL中绘制了本机选项卡控件（ TPageControl ，尽管其提升方被适当地命名为 TCustomTabControl -有人猜测为什么要在处理 WM_DRAWITEM 消息（如 href = http://msdn.microsoft.com/zh-cn/library/windows/desktop/bb760550%28v=vs.85%29.aspx#owner_drawn_tabs rel = noreferrer>在此处记录。

The tabs of an owner drawn native "tab control" (TPageControl in VCL, although its ascendant is appropriately named TCustomTabControl - it is anyone's guess why the creative naming..), is expected to be painted by its parent control while processing WM_DRAWITEM messages, as documented here.

VCL通过将消息变异为 CN_DRAWITEM 消息并将其发送到控件来减轻父级的负担本身。在此过程中，VCL没有进一步的干预。如果它是由用户代码分配的，则会调用 OnDrawTab 消息处理程序，并传递适当的参数。

The VCL takes the burden from the parent by mutating the message to a CN_DRAWITEM message and sending it to the control itself. In this process the VCL has no further intervention. It just calls the OnDrawTab message handler if it is assigned by user code, passing appropriate parameters.

因此，不是在选项卡周围绘制边框的VCL，而是操作系统本身。另外，很明显，它在处理 WM_DRAWITEM 消息期间不会执行此操作，但在绘画过程的后期会执行此操作。您可以通过在页面控件的父级上放置一个空的 WM_DRAWITEM 处理程序来验证这一点。结果是，无论我们在事件处理程序中绘制什么，它稍后都会被操作系统所限制。

So, it's not the VCL that draws the borders around tabs, but the OS itself. Also, evidently, it doesn't do this during processing of WM_DRAWITEM messages but later in the painting process. You can verify this by putting an empty WM_DRAWITEM handler on the parent of a page control. Result is, whatever we paint in the event handler, it will later get borders by the OS.

我们可能想做的是尝试防止操作系统绘制的内容生效，毕竟我们拥有设备上下文（如Canvas.Handle）。不幸的是，这条路线也是一条死胡同，因为在事件处理程序返回后，VCL会恢复设备上下文的状态。

What we might try is to try to prevent what the OS draws take effect, we have the device context (as Canvas.Handle) after all. Unfortunately this route also is a dead end because the VCL, after the event handler returns, restores the device context's state.

唯一的办法是，完全放弃处理 OnDrawTab 事件，并根据 CN_DRAWITEM 消息采取行动。下面的示例代码使用插入器类，但是您可以按照自己喜欢的任何方式对控件进行子类化。确保设置了 OwnerDrawn 。

The only way, then, we have is to completely abandon handling an OnDrawTab event, and acting upon CN_DRAWITEM message. Below sample code use an interposer class, but you can subclass the control any way you like. Make sure that OwnerDrawn is set.

type
  TPageControl = class(comctrls.TPageControl)
  protected
    procedure CNDrawitem(var Message: TWMDrawItem); message CN_DRAWITEM;
  end;

  TForm1 = class(TForm)
    ..

..

procedure TPageControl.CNDrawitem(var Message: TWMDrawItem);
var
  Color: TColor;
  Rect: TRect;
  Rgn: HRGN;
begin
  Color := 0;  
  // draw in different colors so we see where we've drawn
  case Message.DrawItemStruct.itemID of
    0: Color := $D0C0BF;
    1: Color := $D0C0DF;
    2: Color := $D0C0FF;
  end;
  SetDCBrushColor(Message.DrawItemStruct.hDC, Color);

  // we don't want to get clipped in the passed rectangle
  SelectClipRgn(Message.DrawItemStruct.hDC, 0);

  // magic numbers corresponding to where the OS draw the borders
  Rect := Message.DrawItemStruct.rcItem;
  if Bool(Message.DrawItemStruct.itemState and ODS_SELECTED) then begin
    Inc(Rect.Left, 2);
//    Inc(Rect.Top, 1);
    Dec(Rect.Right, 2);
    Dec(Rect.Bottom, 3);
  end else begin
    Dec(Rect.Left, 2);
    Dec(Rect.Top, 2);
    Inc(Rect.Right, 2);
    Inc(Rect.Bottom);
  end;
  FillRect(Message.DrawItemStruct.hDC, Rect,
      GetStockObject(DC_BRUSH));

  // just some indication for the active tab
  SetROP2(Message.DrawItemStruct.hDC, R2_NOTXORPEN);
  if Bool(Message.DrawItemStruct.itemState and ODS_SELECTED) then
    Ellipse(Message.DrawItemStruct.hDC, Rect.Left + 4, Rect.Top + 4,
      Rect.Left + 12, Rect.Top + 12);

  // we want to clip the DC so that the borders to be drawn are out of region
  Rgn := CreateRectRgn(0, 0, 0, 0);
  SelectClipRgn(Message.DrawItemStruct.hDC, Rgn);
  DeleteObject(Rgn);

  Message.Result := 1;
  inherited;
end;

这是上面的样子：

< img src = https://i.stack.imgur.com/1NLOG.png alt =在此处输入图片描述>

Here is how the above looks here:

这篇关于使所有者绘制的TPageControl选项卡看起来更好，就像没有所有者绘制一样的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！