总结:
假设我有一个 TForm 和两个面板。面板对齐 alTop 和 alClient。 alClient面板包含一个TPaintBox,其OnPaint涉及绘图代码。
组件上 DoubleBuffered 的默认值为 false。
在绘制过程中,闪烁很明显,因为表格、面板都绘制了背景。
由于窗体被面板覆盖,因此拦截其 WM_ERASEBKGND 消息可能没问题。如果没有,人们可能会看到面板上闪烁,并且当调整表单大小时,面板的右边缘会闪烁,因为表单会绘制其背景。
其次,因为 alTop 面板旨在成为某些按钮的容器,所以将其 DoubleBuffered 设置为 true 可能很好,以让 Delphi 确保其上没有闪烁。它可能不会带来太多的性能负担。
第三,由于 alClient 面板仅用作另一个绘图组件的容器,因此该面板很可能是not参与最终绘图的创作。在这方面,使用 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 复制回绘画箱。
然而,这两个选择都在闪烁,其中第二个选择尤其闪烁。我主要关心的是选择 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.