delphi – 如何消除TPaintBox右边缘的闪烁(例如调整大小时)

组件上DoubleBuffered的默认值为false.

在绘图过程中,闪烁很明显,因为表格,面板都绘制了背景.

由于表单由面板覆盖,因此拦截其WM_ERASEBKGND消息可能很好.如果没有,可以看到面板上闪烁,并且在调整窗体大小时在面板的右边缘闪烁,因为窗体会绘制其背景.

其次,因为alTop面板是一个按钮的容器,所以将DoubleBuffered设置为true可能很好,让Delphi确保它没有闪烁.它可能不会带来太多的性能负担.

第三,因为alClient面板仅用作另一个绘图组件的容器,所以此面板很可能不参与组成最终绘图.在这方面,使用TPanel后代而不是标准TPanel可能是好事.在这个TPanel后代中,覆盖受保护的过程Paint并在过程中不执行任何操作,尤其是不继承调用以避免在基类TCustomPanel.Paint中进行FillRect调用.此外,拦截WM_ERASEBKGND消息并且内部也不执行任何操作.这是因为当TPanel.ParentBackground为False时,Delphi负责重新绘制背景,当它为True时,ThemeService负责.

最后,在TPaintBox中绘制没有闪烁：
(1)使用VCL内置绘图程序,可能更好……
(2)使用OpenGL,启用OpenGL的双缓冲.
(3)……

===问：如何消除TPaintBox右边缘的闪烁？===

假设对于一个TForm,我有两个面板.顶部相对于表单对齐alTop并被视为按钮的容器.另一个是相对于表单对齐的alClient,并被视为绘制组件的容器(例如来自VCL的TPaintBox,或来自Graphics32的TPaintBox32).对于后一个面板,它的WM_ERASEBKGND消息被截获.

现在,我在以下示例代码中使用TPaintBox实例.在它的OnPaint处理程序中,我有两个选择来绘制一个我希望无闪烁的绘图.选择1是在填充矩形后绘制的.由于其父面板不应擦除背景,因此绘图应无闪烁.选择2正在绘制到TBitmap上,然后将其Canvas复制回到paintbox.

然而,两种选择都是闪烁的,第二种选择尤其是闪烁.我主要担心的是选择1.如果您调整表单大小,您可能会看到闪烁的主要部分发生在右边缘.为什么会这样？有人可以帮助评论原因和可能的解决方案吗？ (注意,如果我在这里使用TPaintBox32而不是TPaintBox,右边缘根本不会闪烁.)

我的第二个担忧是,当使用选项1时,闪烁的次要部分随机出现在绘图箱上.如果您快速调整表单大小,它不是很明显但仍然可以观察到.此外,当使用选择2时,这种闪烁变得更加严重.我没有找到原因.有人可以帮助评论可能的原因和解决方案吗？

任何建议表示赞赏!!

unit uMainForm;

    interface

    uses
      Windows,Messages,SysUtils,Variants,Classes,Graphics,Controls,Forms,ExtCtrls,Dialogs;

    type
      TMainForm = class(TForm)
        procedure FormCreate(Sender: TObject);
      private
        { Private declarations }
        FPnlCtrl,FPnlScene: TPanel;
        FPbScene: TPaintBox;

        OldPnlWndProc: TWndMethod;

        procedure PnlWndProc(var Message: TMessage);
        procedure OnScenePaint(Sender: TObject);
      public
        { Public declarations }
      end;

    var
      MainForm: TMainForm;

    implementation

    {$R *.dfm}

    procedure TMainForm.FormCreate(Sender: TObject);
    begin
      Self.Color := clYellow;
      Self.DoubleBuffered := False;

      FPnlCtrl := TPanel.Create(Self);
      FPnlCtrl.Parent := Self;
      FPnlCtrl.Align := alTop;
      FPnlCtrl.Color := clPurple;
      FPnlCtrl.ParentColor := False;
      FPnlCtrl.ParentBackground := False;
      FPnlCtrl.FullRepaint := False;
      FPnlCtrl.DoubleBuffered := False;

      FPnlScene := TPanel.Create(Self);
      FPnlScene.Parent := Self;
      FPnlScene.Align := alClient;
      FPnlScene.Color := clBlue;
      FPnlScene.ParentColor := False;
      FPnlScene.ParentBackground := False;
      FPnlScene.FullRepaint := False;
      FPnlScene.DoubleBuffered := False;

      FPbScene := TPaintBox.Create(Self);
      FPbScene.Parent := FPnlScene;
      FPbScene.Align := alClient;
      FPbScene.Color := clRed;
      FPbScene.ParentColor := False;

      //
      OldPnlWndProc := Self.FPnlScene.WindowProc;
      Self.FPnlScene.WindowProc := Self.PnlWndProc;

      FPbScene.OnPaint := Self.OnScenePaint;

    end;

    procedure TMainForm.PnlWndProc(var Message: TMessage);
    begin
      if (Message.Msg = WM_ERASEBKGND) then
        Message.Result := 1
      else
        OldPnlWndProc(Message);
    end;

    procedure TMainForm.OnScenePaint(Sender: TObject);
    var
      tmpSceneBMP: TBitmap;
    begin
      // Choice 1
       FPbScene.Canvas.FillRect(FPbScene.ClientRect);
       FPbScene.Canvas.Ellipse(50,50,150,150);

      // Choice 2
    //  tmpSceneBMP := TBitmap.Create;
    //  tmpSceneBMP.Width := FPbScene.ClientWidth;
    //  tmpSceneBMP.Height := FPbScene.ClientHeight;
    //  tmpSceneBMP.Canvas.Brush.Color := FPbScene.Color;
    //  tmpSceneBMP.Canvas.FillRect(FPbScene.ClientRect);
    //  tmpSceneBMP.Canvas.Ellipse(50,150);
    //  FPbScene.Canvas.CopyRect(FPbScene.ClientRect,tmpSceneBMP.Canvas,//    FPbScene.ClientRect);

    end;

    end.

===问：如何拦截面板正确重新绘制背景？ ===
(如果我在一个单独的问题中提出这个问题,请这样说,我会删除它.)

新建一个VCL应用程序,粘贴示例代码,附加FormCreate,运行debug.现在将鼠标悬停在表单上,??您可以看到面板显然正在重新绘制其背景.但是,如示例代码所示,我应该通过拦截WM_ERASEBKGND消息来截获此行为.

注意,如果我注释掉这三行,

FPnlScene.Color := clBlue;
FPnlScene.ParentColor := False;
FPnlScene.ParentBackground := False;

然后可以捕获WM_ERASEBKGND消息.我对这种差异一无所知.

有人可以帮助评论这种行为的原因,以及如何正确拦截WM_ERASEBKGND消息(当ParentBackground：= False时)？

unit Unit1;

    interface

    uses
      Windows,Dialogs;

    type
      TForm1 = class(TForm)
        procedure FormCreate(Sender: TObject);
      private
        { Private declarations }
        FPnlScene: TPanel;
        FPbScene: TPaintBox;

        FOldPnlWndProc: TWndMethod;

        procedure PnlWndProc(var Message: TMessage);

        procedure OnSceneMouseMove(Sender: TObject; Shift: TShiftState;
          X,Y: Integer);
        procedure OnScenePaint(Sender: TObject);
      public
        { Public declarations }
      end;

    var
      Form1: TForm1;

    implementation

    {$R *.dfm}

    procedure TForm1.FormCreate(Sender: TObject);
    begin
      Self.Color := clYellow;
      Self.DoubleBuffered := False;

      FPnlScene := TPanel.Create(Self);
      FPnlScene.Parent := Self;
      FPnlScene.Align := alClient;
      FPnlScene.Color := clBlue;
      FPnlScene.ParentColor := False;
      FPnlScene.ParentBackground := False;
      FPnlScene.FullRepaint := False;
      FPnlScene.DoubleBuffered := False;

      FPbScene := TPaintBox.Create(Self);
      FPbScene.Parent := FPnlScene;
      FPbScene.Align := alClient;
      FPbScene.Color := clRed;
      FPbScene.ParentColor := False;

      //
      FOldPnlWndProc := Self.FPnlScene.WindowProc;
      Self.FPnlScene.WindowProc := Self.PnlWndProc;

      Self.FPbScene.OnMouseMove := Self.OnSceneMouseMove;
      Self.FPbScene.OnPaint := Self.OnScenePaint;

    end;

    procedure TForm1.PnlWndProc(var Message: TMessage);
    begin
      if Message.Msg = WM_ERASEBKGND then
      begin
        OutputDebugStringW('WM_ERASEBKGND');
        Message.Result := 1;
      end
      else
        FOldPnlWndProc(Message);
    end;

    procedure TForm1.OnSceneMouseMove(Sender: TObject; Shift: TShiftState; X,Y: Integer);
    begin
      FPbScene.Repaint;
    end;

    procedure TForm1.OnScenePaint(Sender: TObject);
    begin
      FPbScene.Canvas.FillRect(FPbScene.ClientRect);
      FPbScene.Canvas.Ellipse(50,150);
    end;

    end.