当窗体被创建/恢复时,重叠的TCustomControl对象绘制顺序有误

8
我在 Delphi 2007 中遇到了使用 TCustomControl 实现透明度的问题。 我已经将问题简化为以下代码。 当创建窗体时,控件的绘制顺序与其添加到窗体中的顺序相反。 但是,当调整窗体大小后,它们按正确的顺序绘制。 我做错了什么? 除第三方解决方案之外,是否有更合适的方法可供选择?
以下是我的示例项目,演示了 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.

1
只使用TCustomTransparentControl进行绘制(仅限此项,不需要使用CreateParams或处理WM_ERASEBKGND消息)。 - Victoria
这样说吧:我从来没有处理过WM_ERASEBKGND消息的理由,而且我编写了许多具有自己100%纯绘画的自定义控件。我还做了一些透明的控件,而不必专门从TCustomTransparentControl继承。尝试仅使用您的“Paint”过程,看看是否有帮助。不是说它们没用,但要从小处开始,逐步提高到事情开始失败的地步。 - Jerry Dodge
3
第一篇帖子中的MCVE非常出色。 - Sertac Akyuz
3
考虑发表答案,但认为可能不太有说服力,因此留下评论……问题在于 WS_EX_TRANSPARENT 标志,而不是 z-order。与预期相反,兄弟窗口/控件不总是以从底部到顶部的顺序接收 WM_PAINT。保留视觉 z-order 的是更新区域 (WS_CLIPSIBLINGS)。透明 控件不能使用更新区域,它总是覆盖非透明的兄弟。总之:透明控件不应该是兄弟。 - Sertac Akyuz
2
评论一直很误导,直到Sertac到来才解决了问题。 - David Heffernan
显示剩余13条评论
1个回答

5
你的问题在于对控件绘制顺序的期望。文档中规定,接收WM_PAINT消息的控件实际上是按照相反的顺序进行的,最上面的控件首先接收到消息。稍后会详细介绍文档,因为具有WS_EX_TRANSPARENT样式的兄弟控件使我们处于未记录的领域。正如你已经注意到的那样,当调整窗口大小时,控件接收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.

这会生成以下表单:

enter image description here

根据创建的顺序,从下到上的Z顺序是:
  1. 绿色框
  2. 面板1
  3. 面板2
  4. 黄色框
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在Panel1之前收到了绘制消息。
那么为什么我们看到Panel2是整体的,而尽管Panel1后来被绘制,但我们只看到了它的一部分呢?这就是更新区域发挥作用的地方。控件中的WS_CLIPSIBLINGS样式标志告诉操作系统,由高于其在z轴顺序中的兄弟占据的控件部分不会被绘制。
引用:
将子窗口相对于彼此裁剪;也就是说,当特定的子窗口接收到WM_PAINT消息时,WS_CLIPSIBLINGS样式会将所有其他重叠的子窗口剪切出要更新的子窗口区域之外。
让我们深入探讨一下Panel1的WM_PAINT处理程序,并查看操作系统的更新区域的样子。
{ 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 的引用或缺少的错误检查,我们只是在调试。无论如何,这将产生以下表单:

enter image description here

因此,无论您在Panel1的客户区域中绘制什么,它都会被剪切成黑色形状,因此无法在Panel2的前面可视化。

其次,请记住,绿色框先创建,然后是面板,最后是黄色。那么为什么两个透明控件在两个面板之后才被绘制?

首先,请记住,控件从上到下绘制。现在,一个透明控件如何可能绘制到在它之后绘制的内容上?显然这是不可能的。所以整个绘画算法必须改变。没有关于此的文档,我找到的最好的解释来自Raymond Chen的博客文章

... WS_EX_TRANSPARENT 扩展窗口样式会改变绘制算法,具体如下:如果一个需要被绘制的 WS_EX_TRANSPARENT 窗口有任何非 WS_EX_TRANSPARENT 窗口兄弟(属于同一进程)也需要被绘制,则窗口管理器将首先绘制非 WS_EX_TRANSPARENT 窗口。

自上而下的绘制顺序在具有透明控件时变得困难。还有一种情况是重叠的透明控件 - 哪个比另一个更透明?只要接受这样一个事实:重叠的透明控件会产生不确定的行为。

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


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

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;


enter image description here

右侧的黑色形状是GreenBox的系统更新区域。在所有系统中,都可以对透明控件应用剪辑。我认为,在有大量透明控件时,可以得出绘画算法并不完美的结论。
作为承诺,文档中提到了WM_PAINT消息的引用。我将这留到最后的原因之一是它包含了一个可能的解决方案(当然我们已经找到了一个解决方案,在你的透明控件之间散布一些非透明控件):

... 如果父级链中的窗口是组合的(带有WX_EX_COMPOSITED),同级窗口以其Z顺序位置的相反顺序接收WM_PAINT消息。鉴于此,Z顺序最高的窗口(在顶部)最后接收其WM_PAINT消息,反之亦然。如果父级链中没有组合窗口,则同级窗口按Z顺序接收WM_PAINT消息。

据我测试,只需在父窗体上设置WS_EX_COMPOSITED即可。但我不知道是否适用于您的情况。

在上面的原始示例代码中,为TCustomControl添加样式WS_EX_COMPOSITED确实有效。对于那些派生自TCustomTransparentControl的控件来说,它并不起作用。这些控件按预期顺序绘制,但透明度会丢失,这是值得好奇的。 - c0pp3rt0p

网页内容由stack overflow 提供, 点击上面的
可以查看英文原文,
原文链接