总结:
假设我有一个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.