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

8

总结:
假设我有一个TForm和两个面板。这些面板都对齐在顶部和客户端上。alClient面板包含一个TPaintBox,其OnPaint涉及绘图代码。

组件的DoubleBuffered属性默认值为false。

在绘制过程中,由于窗体和面板都会绘制它们的背景,所以闪烁很明显。

因为窗体被面板覆盖,拦截其WM_ERASEBKGND消息可能是可以的。如果不这样做,可能会看到面板上的闪烁,以及当调整窗体大小时,面板右侧的闪烁,因为窗体会绘制其背景。

其次,由于alTop面板旨在成为一些按钮的容器,因此将其DoubleBuffered设置为true,让Delphi确保没有闪烁,可能是可以的。它可能不会带来太多性能负担。

第三,因为alClient面板仅用于另一个绘图组件的容器,所以该面板最有可能参与组合最终的绘图。在这方面,最好使用TPanel的派生类而不是标准的TPanel。在此TPanel派生类中,重写受保护的过程Paint,并在过程内部什么也不做,特别是不调用继承。此外,拦截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复制回PaintBox。

然而,这两种选择都会出现闪烁,尤其是第二个选择。我主要担心的是第一种选择。如果您调整表单大小,您会发现闪烁的主要部分发生在右侧边缘。为什么会出现这种情况?有人可以帮忙解释原因并提供可能的解决方案吗?(请注意,如果我在此处使用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.

===Q: 如何正确拦截面板的背景重绘?===
(如果我应该在单独的问题中提问,请告诉我,我会删除这个问题。)

新建一个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.

1
当您打开Form.DoubleBuffered但未打开面板的双缓冲属性时会发生什么?尝试关闭任何XP主题或Aero Glass(返回到Windows经典模式)。是否仍然存在闪烁? - Warren P
@Warren P:非常感谢您的评论!通过打开Form.DoubleBuffered但关闭Panel.DoubleBuffered,确实可以消除右侧边缘的闪烁!(但PaintBox本身的闪烁变得更加严重。)我觉得可能有一些最佳实践应该遵循? - SOUser
1
如果您将面板移除并直接将TPaintBox放置在窗体上,闪烁是否会消失?在这种情况下,您可能需要一个修改过的面板控件(子类化TPanel并更改其绘制方式,在其中拦截WM_ERASEBACKGROUND)。 - Warren P
@Warren P:非常感谢您的帮助!使用上述示例代码,如果我注释掉paintbox的容器面板,闪烁就会存在。但是闪烁是在重新绘制表单背景和paintbox内容之间发生的。以前,它是随机闪烁显示paintbox容器面板的颜色。 - SOUser
@Warren P:感谢您的推荐。很抱歉,我实际上不知道如何正确地拦截WM_ERASEBKGND。我不确定是否应该提出单独的问题。也许我应该先在这里发布一个示例代码,展示我未能拦截面板绘制背景的情况。 - SOUser
2个回答

4
通常的技巧是通过设置 DoubleBuffered 属性来解决问题。我看到你已经在代码中这样做了,所以如果这么简单的话,我认为你应该已经解决了它。
我认为你也可以避免在 OnPaint 中进行任何操作,除了直接将离屏位图拉伸绘制到你的 PaintBox.Canvas 上。OnPaint 中的任何其他操作都有可能导致闪烁。这意味着,在 OnPaint 中不要修改 TBitmap 的状态。让我再说一遍; 不要在绘画事件中改变状态。绘画事件应该包含“位图-块”操作、GDI 矩形和线条调用等内容,但不应包含其他内容。
我不太敢建议任何人尝试使用 WM_SETREDRAW,但这是一种人们使用的技术。你可以捕获移动/调整窗口事件或消息,并打开/关闭 WM_SETREDRAW,但这会带来很多复杂性和问题,我不建议这样做。你还可以调用各种 Win32 函数来锁定一个窗口,但这些都是非常危险的,不建议使用。

非常感谢您的有益建议!当窗体中有面板时,Form.DoubleBuffered=true似乎不起作用。如果可行的话,我可能错过了最佳/常见做法?我关闭内置双缓冲的第二个原因是性能。使用OpenGl或使用Graphics32或使用离屏位图,双缓冲已经完成一次。启用Form或Panel的DoubleBuffer会使某些实时应用程序变慢。我会尝试阅读您推荐的内容!谢谢! - SOUser
你强调不应该在OnPaint内修改offscreen TBitmap。然而,系统警告我需要在OnPaint中刷新/重绘。这是正确的吗?(我感觉我缺乏基本逻辑)此外,您提到我不应该在绘画事件中更改状态。您能否帮忙评论一下我不应该更改哪些状态?我的意思是,颜色、笔/刷属性等状态经常会发生变化。 - SOUser
1
你不应该认为在位图上绘制和在画布上绘制必须同时进行,因为你目前很困惑。你应该只在它所依赖的内容发生变化时绘制一次位图。然后在事件中将位图绘制到画布上。清楚吗?将位图传输到画盒非常快。实际上,如果你只需要一个位图,为什么不使用TImage呢? - Warren P
1
在绘制事件中,你应该做以下事情:写入或调用任何Paintbox.Canvas下的函数。你访问的其他内容都应该是只读操作(没有状态更改、副作用),而且必须非常非常快速。避免使用任何需要长时间处理的函数/过程调用。在重绘Paintbox时,非常常见的闪烁源之一是进行大量非常缓慢的函数调用。 - Warren P
非常感谢您的建议!我会尝试学习这些最佳实践! - SOUser

2

就我个人而言,以下内容对我来说是无闪烁的:

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:感谢您的时间!但是为什么呢?您看到的是一个顶部带有黄色面板和底部带有红色画板的表单吗?例如,当表单被调整大小时,会出现闪烁。 - SOUser
2
这就是我看到的。没有闪烁。 - David Heffernan
@David:很抱歉,我不知道发生了什么。在您修改的代码中,像ParentBackground、ParentColor、FullRepaint等属性的值将取决于Delphi版本。我预期要么面板有自己的背景,这样我们就会看到一个紫色面板在顶部和一个红色PaintBox在底部,并且当调整大小时有不太明显的闪烁,要么我们会看到一个黄色面板在顶部和一个红色PaintBox在底部,并且有更明显的闪烁。前者闪烁较少,但我认为它仍然是可以观察到的。 - SOUser
2
@Xichen Li:你试过我的建议,改成Windows经典主题了吗? - Warren P
@Warren P:只是想知道为什么你告诉我尝试使用Windows Classic。再次感谢!https://forums.embarcadero.com/message.jspa?messageID=229495 最后一篇帖子提到了“DwmCompositionEnabled”,这在使用Windows Aero时是启用的。 - SOUser
显示剩余2条评论

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