delphi - 创建/恢复表单时，重叠的 TCustomControl 对象绘制顺序不正确

Question

我在 Delphi 2007 中让 TCustomControl 与透明度一起工作时遇到问题。我目前已将问题简化为下面的代码。问题是最初创建表单时，控件以相反的顺序绘制，它们被添加到表单中。当窗体被调整大小时，它们以正确的顺序绘制。我究竟做错了什么？排除第 3 方解决方案，是否有更合适的路径可以遵循？



这是我的示例项目，演示了 Delphi 2007 中的问题。

unit Main;

interface

uses
  Forms, Classes, Controls, StdCtrls, Messages,
  ExtCtrls;

type
  // Example of a TWinControl derived control
  TMyCustomControl = class(TCustomControl)
  protected
    procedure CreateParams(var params: TCreateParams); override;
    procedure WMEraseBkGnd(var msg: TWMEraseBkGnd);
      message WM_ERASEBKGND;
    procedure Paint; override;
  end;

type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormPaint(Sender: TObject);
  private
    YellowBox: TMyCustomControl;
    GreenBox: TMyCustomControl;
  end;

var
  Form1: TForm1;

implementation

uses
  Windows, Graphics;

{$R *.dfm}

{ TForm1 }

procedure TForm1.FormCreate(Sender: TObject);
begin
  self.OnPaint := FormPaint;

  GreenBox := TMyCustomControl.Create(self);
  GreenBox.Parent := self;
  GreenBox.SetBounds(10,10,200,200);
  GreenBox.color := clGreen;

  YellowBox := TMyCustomControl.Create(self);
  YellowBox.Parent := self;
  YellowBox.SetBounds(100,100,200,200);
  YellowBox.color := clYellow;

end;

// Paint bars on form background
procedure TForm1.FormPaint(Sender: TObject);
var
  Idx: Integer;
begin
  for Idx := 0 to ClientHeight div 8 do
  begin
    if Odd(Idx) then
      Canvas.Brush.Color := clWhite
    else
      Canvas.Brush.Color := clSilver;  // pale yellow
    Canvas.FillRect(Rect(0, Idx * 8, ClientWidth, Idx * 8 + 8));
  end;
end;

{ TMyCustomControl }

procedure TMyCustomControl.CreateParams(var params: TCreateParams);
begin
  inherited;
  params.ExStyle := params.ExStyle or WS_EX_TRANSPARENT;
end;

procedure TMyCustomControl.WMEraseBkGnd(var msg: TWMEraseBkGnd);
begin
  SetBkMode (msg.DC, TRANSPARENT);
  msg.result := 1;
end;

procedure TMyCustomControl.Paint;
begin
  Canvas.Brush.Color := color;
  Canvas.RoundRect(0,0,width,height,50,50);
end;



end.

Answer 1

错误的是您对控件绘制顺序的期望。控件接收顺序WM_PAINT消息被记录为实际上是完全相反的顺序，最顶层的控件首先接收消息。稍后会详细介绍文档，因为有了 WS_EX_TRANSPARENT风格的 sibling 让我们处于无证领域。正如您已经注意到的，您有一个接收控件的顺序 WM_PAINT 的情况。消息不是确定性的 - 调整窗口大小时，顺序会发生变化。

我已经修改了一些你的复制案例，看看发生了什么。修改包括两个面板和一个调试输出，当他们收到 WM_PAINT 时.

unit Unit1;

interface

uses
  Forms, Classes, Controls, StdCtrls, Messages, ExtCtrls;

type
  TMyCustomControl = class(TCustomControl)
  protected
    procedure CreateParams(var params: TCreateParams); override;
    procedure WMEraseBkGnd(var msg: TWMEraseBkGnd);
      message WM_ERASEBKGND;
    procedure Paint; override;
    procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
  end;

  TPanel = class(extctrls.TPanel)
  protected
    procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
  end;

type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormPaint(Sender: TObject);
  private
    YellowBox: TMyCustomControl;
    GreenBox: TMyCustomControl;
    Panel1, Panel2: TPanel;
  end;

var
  Form1: TForm1;

implementation

uses
  sysutils, windows, graphics;

{$R *.dfm}

{ TForm1 }

procedure TForm1.FormCreate(Sender: TObject);
begin
  Width := 590;
  Height := 270;
  OnPaint := FormPaint;

  GreenBox := TMyCustomControl.Create(self);
  GreenBox.Parent := self;
  GreenBox.SetBounds(20, 20, 140, 140);
  GreenBox.color := clGreen;
  GreenBox.Name := 'GreenBox';
//{
  Panel1 := TPanel.Create(Self);
  Panel1.Parent := Self;
  Panel1.SetBounds(240, 40, 140, 140);
  Panel1.ParentBackground := False;
  Panel1.Color := clMoneyGreen;
  Panel1.Name := 'Panel1';

  Panel2 := TPanel.Create(Self);
  Panel2.Parent := Self;
  Panel2.SetBounds(260, 60, 140, 140);
  Panel2.ParentBackground := False;
  Panel2.Color := clCream;
  Panel2.Name := 'Panel2';
//}
  YellowBox := TMyCustomControl.Create(self);
  YellowBox.Parent := self;
  YellowBox.SetBounds(80, 80, 140, 140);
  YellowBox.color := clYellow;
  YellowBox.Name := 'YellowBox';
  YellowBox.BringToFront;
end;

// Paint bars on form background
procedure TForm1.FormPaint(Sender: TObject);
var
  Idx: Integer;
begin
  for Idx := 0 to ClientHeight div 8 do
  begin
    if Odd(Idx) then
      Canvas.Brush.Color := clWhite
    else
      Canvas.Brush.Color := clSilver;  // pale yellow
    Canvas.FillRect(Rect(0, Idx * 8, ClientWidth, Idx * 8 + 8));
  end;
end;

{ TPanel }

procedure TPanel.WMPaint(var Message: TWMPaint);
begin
  OutputDebugString(PChar(Format(' %s painting..', [Name])));
  inherited;
end;

{ TMyCustomControl }

procedure TMyCustomControl.CreateParams(var params: TCreateParams);
begin
  inherited;
  params.ExStyle := params.ExStyle or WS_EX_TRANSPARENT;
end;

procedure TMyCustomControl.WMEraseBkGnd(var msg: TWMEraseBkGnd);
begin
  msg.Result := 1;
end;

procedure TMyCustomControl.WMPaint(var Message: TWMPaint);
begin
  OutputDebugString(PChar(Format(' %s painting..', [Name])));
  inherited;
end;

procedure TMyCustomControl.Paint;
begin
  Canvas.Brush.Color := Color;
  Canvas.RoundRect(0, 0, Width, Height, 50, 50);
end;

end.

产生这种形式:



根据创建顺序确定，z 顺序是，从下到上，

绿盒子，

Panel1,

Panel2,

黄箱。

WM_PAINT 的调试输出消息是这样的:

Debug Output:  Panel2 painting.. Process Project1.exe (12548)
Debug Output:  Panel1 painting.. Process Project1.exe (12548)
Debug Output:  YellowBox painting.. Process Project1.exe (12548)
Debug Output:  GreenBox painting.. Process Project1.exe (12548)

在这个顺序中有两件事值得注意。

第一 , Panel2 在 Panel1 之前接收绘制消息，尽管 Panel2 在 z 顺序中更高。

那么为什么我们看到 Panel2 是一个整体，但我们看到 Panel1 的一部分，即使它是后来绘制的呢？这就是更新区域发挥作用的地方。 WS_CLIPSIBLINGS 控件中的样式标志告诉操作系统，z 顺序中较高的同级控件占用的控件部分不会被绘制。

Clips child windows relative to each other; that is, when a particular child window receives a WM_PAINT message, the WS_CLIPSIBLINGS style clips all other overlapping child windows out of the region of the child window to be updated.

让我们深入了解 WM_PAINT Panel1 的处理程序并查看操作系统的更新区域的外观。

{ TPanel }

// not declared in D2007
function GetRandomRgn(hdc: HDC; hrgn: HRGN; iNum: Integer): Integer; stdcall;
    external gdi32;
const
  SYSRGN = 4;

procedure TPanel.WMPaint(var Message: TWMPaint);
var
  PS: TPaintStruct;
  Rgn: HRGN;

  TestDC: HDC;
begin
  OutputDebugString(PChar(Format(' %s painting..', [Name])));

  Message.DC := BeginPaint(Handle, PS);
  Rgn := CreateRectRgn(0, 0, 0, 0);
  if (Name = 'Panel1') and (GetRandomRgn(Message.DC, Rgn, SYSRGN) = 1) then begin
    OffsetRgn(Rgn, - Form1.ClientOrigin.X + Width + 40, - Form1.ClientOrigin.Y);
    TestDC := GetDC(Form1.Handle);
    SelectObject(TestDC, GetStockObject(BLACK_BRUSH));
    PaintRgn(TestDC, Rgn);
    ReleaseDC(Form1.Handle, TestDC);
    DeleteObject(Rgn);
  end;
  inherited;
  EndPaint(Handle, PS);
end;

BeginPaint将使用系统更新区域剪辑更新区域，然后您可以使用 GetRandomRgn 检索该区域。 .我已将裁剪的更新区域转储到表单右侧。不要介意 Form1引用或缺少错误检查，我们只是在调试。无论如何，这会产生以下形式:



因此，无论您在 Panel1 的客户区中绘制什么，它都会被剪裁成黑色形状，因此它无法在视觉上出现在 Panel2 的前面。

第二 ，请记住首先创建绿色框，然后是面板，最后是黄色。那么为什么要在两个面板之后绘制两个透明控件呢？

首先，请记住控件是从上到下绘制的。现在，透明控件怎么可能绘制在它之后绘制的东西上？显然这是不可能的。所以整个绘画算法必须改变。没有这方面的文档，我找到的最好的解释来自 blog entry Raymond Chen:

... The WS_EX_TRANSPARENT extended window style alters the painting algorithm as follows: If a WS_EX_TRANSPARENT window needs to be painted, and it has any non-WS_EX_TRANSPARENT windows siblings (which belong to the same process) which also need to be painted, then the window manager will paint the non-WS_EX_TRANSPARENT windows first.

当您拥有透明控件时，从上到下的绘制顺序会使其变得困难。然后是重叠透明控件的情况 - 哪个比另一个更透明？只需接受重叠透明控件会产生不确定行为的事实。

如果您调查上述测试案例中透明框的系统更新区域，您会发现两者都是精确的正方形。

让我们将面板移到盒子之间。

procedure TForm1.FormCreate(Sender: TObject);
begin
  Width := 590;
  Height := 270;
  OnPaint := FormPaint;

  GreenBox := TMyCustomControl.Create(self);
  GreenBox.Parent := self;
  GreenBox.SetBounds(20, 20, 140, 140);
  GreenBox.color := clGreen;
  GreenBox.Name := 'GreenBox';
//{
  Panel1 := TPanel.Create(Self);
  Panel1.Parent := Self;
  Panel1.SetBounds(40, 40, 140, 140);
  Panel1.ParentBackground := False;
  Panel1.Color := clMoneyGreen;
  Panel1.Name := 'Panel1';

  Panel2 := TPanel.Create(Self);
  Panel2.Parent := Self;
  Panel2.SetBounds(60, 60, 140, 140);
  Panel2.ParentBackground := False;
  Panel2.Color := clCream;
  Panel2.Name := 'Panel2';
//}
  YellowBox := TMyCustomControl.Create(self);
  YellowBox.Parent := self;
  YellowBox.SetBounds(80, 80, 140, 140);
  YellowBox.color := clYellow;
  YellowBox.Name := 'YellowBox';
  YellowBox.BringToFront;
end;

 ...

procedure TMyCustomControl.WMPaint(var Message: TWMPaint);
var
  PS: TPaintStruct;
  Rgn: HRGN;

  TestDC: HDC;
begin
  OutputDebugString(PChar(Format(' %s painting..', [Name])));

  Message.DC := BeginPaint(Handle, PS);
  Rgn := CreateRectRgn(0, 0, 0, 0);
  if (Name = 'GreenBox') and (GetRandomRgn(Message.DC, Rgn, SYSRGN) = 1) then begin
    OffsetRgn(Rgn, - Form1.ClientOrigin.X + Width + 260, - Form1.ClientOrigin.Y);
    TestDC := GetDC(Form1.Handle);
    SelectObject(TestDC, GetStockObject(BLACK_BRUSH));
    PaintRgn(TestDC, Rgn);
    ReleaseDC(Form1.Handle, TestDC);
    DeleteObject(Rgn);
  end;
  inherited;
  EndPaint(Handle, PS);
end;

最右边的黑色形状是 GreenBox 的系统更新区域。毕竟系统可以将裁剪应用于透明控件。我认为当您拥有一堆透明控件时，可以得出结论，绘画算法并不完美。

正如 promise 的那样， documentation报价为 WM_PAINT命令。我把它留到最后的一个原因是它包含一个可能的解决方案(当然我们已经找到了一个解决方案，在透明控件之间散布一些非透明控件):

... If a window in the parent chain is composited (a window with WX_EX_COMPOSITED), sibling windows receive WM_PAINT messages in the reverse order of their position in the Z order. Given this, the window highest in the Z order (on the top) receives its WM_PAINT message last, and vice versa. If a window in the parent chain is not composited, sibling windows receive WM_PAINT messages in Z order.

正如我测试的那样，设置 WS_EX_COMPOSITED在父表单上似乎有效。但我不知道它是否适用于您的情况。