如何消除TPaintBox右边缘的闪烁（例如调整大小时）

Posted 2023-02-23

【中文标题】如何消除TPaintBox右边缘的闪烁（例如调整大小时）

【英文标题】：How to eliminate the flicker on the right edge of TPaintBox (for example when resizing)

【发布时间】：2011-07-08 09:18:46

【问题描述】：

总结： 假设我有一个 TForm 和两个面板。面板对齐 alTop 和 alClient。 alClient 面板包含一个 TPaintBox，其 OnPaint 涉及绘图代码。

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) ...

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

假设对于一个 TForm，我有两个面板。顶部相对于表单对齐 alTop 并被视为按钮的容器。另一个是 alClient 相对于窗体对齐，并被视为绘制组件的容器（例如 VCL 中的 TPaintBox，或 Graphics32 中的 TPaintBox32）。对于后一个面板，它的 WM_ERASEBKGND 消息被截获。

现在，我在下面的示例代码中使用了一个 TPaintBox 实例。在它的 OnPaint 处理程序中，我有两种选择来绘制我希望没有闪烁的绘图。选项 1 是在填充矩形后绘制。因为它的父面板不应该擦除背景，所以绘图应该是无闪烁的。选择 2 是在 TBitmap 上绘图，然后将其 Canvas 复制回绘画盒。

但是，两个选项都在闪烁，第二个选项尤其闪烁。我主要关心的是选项 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, 50, 150, 150);
    //  FPbScene.Canvas.CopyRect(FPbScene.ClientRect, tmpSceneBMP.Canvas,
    //    FPbScene.ClientRect);

    end;

    end.

===问：如何正确拦截面板重绘背景？ === （如果我应该在一个单独的问题中提出这个问题，请直接说出来，我会删除它。）

新建一个VCL应用，粘贴示例代码，附上FormCreate，运行调试。现在将鼠标悬停在表单上，​​您可以看到面板正在重新绘制其背景。但是，如示例代码所示，我应该已经通过拦截 WM_ERASEBKGND 消息来拦截此行为。

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

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

然后可以捕获 WM_ERASEBKGND 消息。我不知道这种差异。

有人可以帮助评论这种行为的原因，以及如何正确拦截 WM_ERASEBKGND 消息（当 ParentBackground := False 时）？

    unit Unit1;

    interface

    uses
      Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
      ExtCtrls, 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, 50, 150, 150);
    end;

    end.

【问题讨论】：

打开 Form.DoubleBuffered 而不是面板双缓冲属性时会发生什么？尝试关闭任何 XP 主题或航空玻璃，（返回 Windows 经典模式）。是否还有闪烁？

@Warren P：非常感谢您的评论！通过打开 Form.DoubleBuffered 但关闭 Panel.DoubleBuffered，右侧边缘的闪烁确实消失了！ （但 PaintBox 本身的闪烁变得更加严重。）我觉得可能有一些我应该遵循的最佳实践？

如果你摆脱面板并将TPaintBox直接放在表单上闪烁消失？在这种情况下，您需要的可能是一个修改过的面板控件（子类化 TPanel 并更改它的绘制并在其中截取 WM_ERASEBACKGROUND）。

@Warren P：非常感谢您的帮助！完全使用上面的示例代码，如果我注释掉paintbox的容器面板，则存在闪烁。但是闪烁是在重新绘制表单的背景和paintbox的内容之间。之前，它是随机闪烁显示paintbox的容器面板的颜色。

@Warren P：谢谢你的推荐。很抱歉，但实际上我不知道如何正确识别 WM_ERASEBKGND。我不确定我是否应该问一个单独的问题。可能我应该先在这里发布一个示例代码，显示我未能拦截面板的绘画背景。

【参考方案1】：

不管怎样，以下对我来说是无闪烁的：

unit uMainForm;

interface

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

type
  TMainForm = class(TForm)
    procedure FormCreate(Sender: TObject);
  private
    FPnlCtrl, FPnlScene: TPanel;
    FPbScene: TPaintBox;
    procedure OnScenePaint(Sender: TObject);
  end;

implementation

$R *.dfm

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

  FPnlCtrl := TPanel.Create(Self);
  FPnlCtrl.Parent := Self;
  FPnlCtrl.Align := alTop;
  FPnlCtrl.Color := clPurple;

  FPnlScene := TPanel.Create(Self);
  FPnlScene.Parent := Self;
  FPnlScene.Align := alClient;
  FPnlScene.Color := clBlue;

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

  FPbScene.OnPaint := Self.OnScenePaint;
end;

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

end.

【讨论】：

@David Heffernan：感谢您抽出宝贵时间！但是怎么来的？您看到的是一个顶部有一个黄色面板，底部有一个红色颜料盒的表格吗？例如，当表单被调整大小时，闪烁是可观察到的。

这就是我所看到的。无闪烁。

@David：很抱歉，但我不知道会发生什么。在您修改的代码中，诸如 ParentBackground、ParentColor、FullRepaint 等属性的值将取决于 Delphi 版本。我希望面板有自己的背景，这样我们会在顶部看到一个紫色面板，在底部看到一个红色油漆框，并且在调整大小时不易观察闪烁，或者我们会看到一个黄色面板顶部和底部的红色颜料盒，但闪烁更严重。前者闪烁较少，但我认为它仍然可以观察到。

@David：感谢您的宝贵时间！你能帮忙上传你编译的二进制文件，以便我可以下载并查看它的外观吗？使用上面的代码我无法获得无闪烁的应用程序，但我可能在这里错过了一些东西。

@Xichen Li：你有没有尝试我的建议换成windows经典主题？

【参考方案2】：

通常的技术是使用 form.DoubleBuffered，我看到你已经在代码中这样做了，所以如果这么简单，我想你已经解决了。

我认为除了从屏幕外位图中直接拉伸到您的paintbox.Canvas 之外，还可以避免在 OnPaint 中的任何操作。 OnPaint 中的任何其他内容都可能导致闪烁错误。这意味着，不会从 OnPaint 中修改 TBitmap。让我再说一遍；不要更改绘画事件中的状态。绘制事件应该包含“位图块”操作、GDI 矩形和线条调用等，但仅此而已。

我不愿向任何尝试 WM_SETREDRAW 的人推荐，但这是人们使用的一种技术。您可以捕获移动/调整窗口大小事件或消息，并打开/关闭 WM_SETREDRAW，但这充满了复杂性和问题，我不推荐它。你也可以调用各种Win32函数来锁定一个窗口，这些都是非常危险的，不推荐使用。

【讨论】：

P：非常感谢您提出的有益建议！当其中有面板时，Form.DoubleBuffered=true 似乎不能很好地工作。或者，如果可行，那么我一定错过了最佳/常见做法？我关闭内置双缓冲的第二个原因是性能。使用 OpenGL 或使用 Graphics32 或使用离屏位图，双缓冲区已经完成一次。启用 Form 或 Panel 的 DoubleBuffer 确实会减慢某些实时应用程序的速度。我会尝试阅读您推荐的内容！谢谢！

P：您强调不应从 OnPaint 中修改屏幕外 TBitmap。但是，系统警告我是否应该刷新/重绘是 OnPaint？ （我觉得我在这里缺乏基本逻辑。）此外，你提到我不应该在绘画事件中改变状态。你能帮忙评论一下我不应该改变什么状态吗？我的意思是，颜色、笔/画笔属性等状态经常会发生变化。

您不应该认为在位图上绘图和在画布画布上绘图必须同时完成，因为您目前对此感到困惑。您应该只绘制一次位图，当它所依赖的内容发生变化时。然后您应该将位图绘制到事件内部的画布上。明白了吗？将位图传输到油漆盒上确实非常快。事实上，如果你只需要一张位图，为什么不直接使用 TImage 呢？

以下是您应该在绘画事件中执行的操作： 写入或调用 Paintbox.Canvas 下的任何函数。您访问的任何其他内容都应该是只读操作（没有状态更改、副作用）并且必须非常非常快。避免任何需要很长时间才能处理的函数/过程调用。一个非常常见的闪烁来源是在您重绘画框时进行大量非常缓慢的函数调用。

P：非常感谢您的建议！然后我会尝试了解这个最佳实践！