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

Question

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

组件上 DoubleBuffered 的默认值为 false。

在绘制过程中，闪烁很明显，因为表单、面板都绘制了它们的背景。

因为表单被面板覆盖，拦截它的 WM_ERASEBKGND 消息可能没问题。如果不是，则可以看到面板上闪烁，并在调整窗体大小时在面板的右边缘闪烁，因为窗体绘制其背景。

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

第三，因为 alClient 面板只是作为另一个绘图组件的容器，所以这个面板很可能是 不是 参与完成最终绘图。在这方面，使用 TPanel 后代而不是标准 TPanel 可能更好。在这个 TPanel 后代中，覆盖 protected 过程 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 复制回油漆盒。

但是，这两个选项都在闪烁，其中第 2 个选项尤其闪烁。我主要关注的是选项 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.

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

Answer 1

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

我认为除了从屏幕外位图直接拉伸(stretch)到您的paintbox.Canvas 之外，还可以避免在OnPaint 中进行任何操作。 OnPaint 中的其他任何内容都是潜在的引起闪烁的错误。这意味着，不会在 OnPaint 中修改 TBitmap。让我说第三次；不要在绘制事件中更改状态。绘制事件应包含“位图 blit”操作、GDI 矩形和线条调用等，但仅此而已。

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