正如我在论坛中看到的,常见的方法是覆盖PaintWindow方法.
我在一个干净的项目上试过这个:
type
TMyFrame = class(TFrame)
private
FCanvas: TCanvas;
protected
procedure PaintWindow(DC: HDC); override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy(); override;
end;
implementation
{$R *.dfm}
constructor TMyFrame.Create(AOwner: TComponent);
begin
inherited;
FCanvas := TCanvas.Create();
end;
destructor TMyFrame.Destroy();
begin
FCanvas.Free();
inherited;
end;
procedure TMyFrame.PaintWindow(DC: HDC);
begin
inherited;
FCanvas.Handle := DC;
FCanvas.Pen.Width := 3;
FCanvas.Pen.Color := clRed;
FCanvas.MoveTo(0, 0);
FCanvas.LineTo(ClientWidth, ClientHeight);
FCanvas.Pen.Color := clGreen;
FCanvas.MoveTo(ClientWidth, 0);
FCanvas.LineTo(0, ClientHeight);
end;
但是,在将我的框架放在主窗体上后,调试器从未进入此方法,直到我在框架的属性中启用了DoubleBuffered. ParentBackground的任何值都不会影响结果.
覆盖WM_PAINT处理程序也解决了问题:
type
TMyFrame = class(TFrame)
protected
procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
...
procedure TMyFrame.WMPaint(var Message: TWMPaint);
begin
inherited;
FCanvas.Handle := GetDC(Handle);
FCanvas.Pen.Width := 3;
FCanvas.Pen.Color := clRed;
FCanvas.MoveTo(0, 0);
FCanvas.LineTo(ClientWidth, ClientHeight);
FCanvas.Pen.Color := clGreen;
FCanvas.MoveTo(ClientWidth, 0);
FCanvas.LineTo(0, ClientHeight);
ReleaseDC(Handle, FCanvas.Handle);
end;
无论将哪个值分配给DoubleBuffered或ParentBackground,此代码始终绘制交叉线.
但是当我尝试使用BeginPaint / EndPaint而不是GetDC / ReleaseDC时,问题又返回了:
procedure TMyFrame.WMPaint(var Message: TWMPaint); var PS: PAINTSTRUCT; begin inherited; FCanvas.Handle := BeginPaint(Handle, PS); FCanvas.Pen.Width := 3; FCanvas.Pen.Color := clRed; FCanvas.MoveTo(0, 0); FCanvas.LineTo(ClientWidth, ClientHeight); FCanvas.Pen.Color := clGreen; FCanvas.MoveTo(ClientWidth, 0); FCanvas.LineTo(0, ClientHeight); EndPaint(Handle, PS); end;
FCanvas.Handle不为零,但结果是空白帧.在这种情况下,设置DoubleBuffered或ParentBackground不会改变任何东西.
也许我说他们错了?
现在我使用带有GetDC / ReleaseDC的WM_PAINT处理程序,因为我不想在这个帧上启用DoubleBuffered.另外我担心其他程序员在将我的框架放入他们的项目之后会意外地禁用DoubleBuffered并且会像我一样头疼.
但也许有更安全和正确的方法在框架表面上绘画?
如果我不对测试框架进行任何控制,我可以复制你的问题(这也可能是我们没有人可以复制你的问题的原因 – f.i.抛出一个控件以确保框架在框架上).当没有控件时没有调用PaintHandler的原因,以及设置DoubleBuffered时调用它的原因,虽然它没有控件,只是如何设计TWinControl的WM_PAINT消息处理程序:
procedure TWinControl.WMPaint(var Message: TWMPaint);
var
..
begin
if not FDoubleBuffered or (Message.DC <> 0) then
begin
if not (csCustomPaint in ControlState) and (ControlCount = 0) then
inherited
else
PaintHandler(Message);
end
else
begin
..
正如您所看到的,当没有设置DoubleBuffered并且没有控件时,不会调用PaintHandler(毕竟没有任何东西可以绘制:我们不是自定义绘图(没有csCustomPaint标志),也没有要显示的控件).设置DoubleBuffered时,会跟随一个不同的代码路径,调用WMPrintClient,后者又调用PaintHandler.
如果你最终会使用没有任何控件的框架(尽管不太可能),那么从上面的代码片段来看,修复是明显的(当你知道它时也很明智):在ControlState中包含csCustomPaint:
type
TMyFrame = class(TFrame)
..
protected
procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
..
procedure TMyFrame.WMPaint(var Message: TWMPaint);
begin
ControlState := ControlState + [csCustomPaint];
inherited;
ControlState := ControlState - [csCustomPaint];
end;
那么继承的WM_PAINT处理程序将调用PaintHandler.
至于为什么在WM_PAINT消息处理程序中使用BeginPaint / EndPaint进行绘制似乎不起作用,原因是绘制代码之前的继承调用验证了更新区域.在调用BeginPaint后检查PAINTSTRUCT的rcPaint成员,你会发现它是(0,0,0,0).
由于当时没有无效区域,操作系统只是忽略了以下的绘图调用.您可以在绘制画布之前通过使框架的客户端矩形无效来验证这一点:
procedure TMyFrame.WMPaint(var Message: TWMPaint); var PS: PAINTSTRUCT; begin inherited; InvalidateRect(Handle, nil, False); // <- here FCanvas.Handle := BeginPaint(Handle, PS); FCanvas.Pen.Width := 3; FCanvas.Pen.Color := clRed; FCanvas.MoveTo(0, 0); FCanvas.LineTo(ClientWidth, ClientHeight); FCanvas.Pen.Color := clGreen; FCanvas.MoveTo(ClientWidth, 0); FCanvas.LineTo(0, ClientHeight); EndPaint(Handle, PS); end;
现在您将看到您的绘图将生效.当然,您可以选择不调用继承,或仅使您要绘制的部分无效.
