在创建/恢复表单时,重叠的TCustomControl对象不按顺序绘制

时间:2017-09-01 18:38:43

标签: delphi delphi-2007

我在让Delust 2007中使用TCustomControl处理透明度方面遇到了问题。我目前已将问题减少到下面的代码中。问题是,在最初创建表单时,控件的绘制顺序与它们添加到表单的顺序相反。调整表单大小后,它们会以正确的顺序绘制。我究竟做错了什么?排除第三方解决方案是否有更合适的路径?

Screen shot of the sample program after resizing the window

这是我的示例项目,展示了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 个答案:

答案 0 :(得分:4)

您对控件绘画顺序的期望是什么?记录接收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. GreenBox,
  2. Panel1,
  3. Panel2,
  4. YellowBox。
  5. 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顺序中较高的同级所占用的控件的一部分不会被绘制。

      

    将儿童窗户相对夹住;也就是说,当一个特定的   子窗口收到 WM_PAINT 消息, WS_CLIPSIBLINGS   样式剪辑所有其他重叠的子窗口   要更新的子窗口。

    让我们在Panel1的WM_PAINT处理程序中深入了解一下,看看OS'更新区域看起来像。

    { 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的blog entry

      

    ... 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订单的documentation引用。我之所以留下这个的一个原因是它包含了一个可能的解决方案(当然我们已经找到了一个解决方案,在透明控件之间分散了一些非透明控件):

      

    ...如果父链中的窗口是合成的(窗口有   WX_EX_COMPOSITED),兄弟窗口接收WM_PAINT消息   它们在Z顺序中的位置的逆序。鉴于此,窗口   Z顺序中最高(在顶部)收到 WM_PAINT 消息   最后,反之亦然。如果父链中的窗口不是   composited,兄弟窗口按Z顺序接收 WM_PAINT 消息。

    对于我测试的一点点,在父表单上设置WS_EX_COMPOSITED似乎有效。但我不知道它是否适用于你的情况。