8

总结：
假设我有一个 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，运行debug。现在将鼠标悬停在表单上，​​您可以看到面板正在重新绘制其背景。但是，如示例代码所示，我应该已经通过拦截 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.
4

2 回答 2

4

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

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

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

于 2011-03-03T21:33:31.587 回答
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.
于 2011-03-03T22:21:20.577 回答