And*_*rew 4 delphi paint frame delphi-xe
我的项目(TFrame
后代)有一个框架,想在上面画一些东西.
正如我在论坛上看到的那样,常见的方法是覆盖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;
Run Code Online (Sandbox Code Playgroud)
但是,在将我的框架放在主窗体上之后,调试器从未进入此方法,直到我启用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;
Run Code Online (Sandbox Code Playgroud)
此代码始终绘制交叉线,无论分配给哪个值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;
Run Code Online (Sandbox Code Playgroud)
FCanvas.Handle不为零,但结果是空白帧.在这种情况下设置DoubleBuffered
或ParentBackground
不更改任何内容.
也许我说他们错了?
现在我使用WM_PAINT
处理程序和GetDC
/ ReleaseDC
,因为我不想DoubleBuffered
在这个框架上启用.另外我担心其他程序员DoubleBuffered
在将我的框架放入他们的项目后会意外停用,并且会像我一样头疼.
但也许有更安全和正确的方法在框架表面上绘画?
如果我没有对测试框架进行任何控制,我可以复制你的问题(这也可能是我们没有人可以复制你的问题的原因 - fi抛出一个控件来直观地确保框架在框架上).
PaintHandler
当没有控件时,没有调用原因,并且DoubleBuffered
虽然没有控件,但是在设置时调用的原因是设计WM_PAINT
消息处理程序的简单方法TWinControl
:
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
..
Run Code Online (Sandbox Code Playgroud)
正如你所看到的,当DoubleBuffered
没有设置时和没有控件时,PaintHandler
没有被调用(毕竟没有什么可以绘制:我们不是自定义绘图(没有csCustomPaint标志),也没有要显示的控件).当DoubleBuffered
被设置时,一个不同的代码路径进行它调用WMPrintClient
,后者又调用PaintHandler
.
如果你最终会在没有任何控制的情况下使用框架(尽管不太可能),那么从上面的代码片段来看,修复是明显的(当你知道它时也很明智):include csCustomPaint
in ControlState
:
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;
Run Code Online (Sandbox Code Playgroud)
然后继承的WM_PAINT
处理程序将调用PaintHandler
.
BeginPaint
/ 绘制似乎不起作用,原因是绘制代码之前的调用验证了更新区域.在你打电话后检查你的会员,你会发现它是(0,0,0,0).EndPaint
WM_PAINT
inherited
rcPaint
PAINTSTRUCT
BeginPaint
由于当时没有无效区域,操作系统只是忽略了以下的绘图调用.您可以在绘制画布之前通过使框架的客户端矩形无效来验证这一点:
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;
Run Code Online (Sandbox Code Playgroud)
现在您将看到您的绘图将生效.当然,您可以选择不拨打电话inherited
,或仅使您将要绘制的部分无效.