在TFrame表面上绘制最安全,最正确的方法是什么?

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)

此代码始终绘制交叉线,无论分配给哪个值DoubleBufferedParentBackground.

但是当我尝试使用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不为零,但结果是空白帧.在这种情况下设置DoubleBufferedParentBackground不更改任何内容.

也许我说他们错了?

现在我使用WM_PAINT处理程序和GetDC/ ReleaseDC,因为我不想DoubleBuffered在这个框架上启用.另外我担心其他程序员DoubleBuffered在将我的框架放入他们的项目后会意外停用,并且会像我一样头疼.

但也许有更安全和正确的方法在框架表面上绘画?

Ser*_*yuz 5

如果我没有对测试框架进行任何控制,我可以复制你的问题(这也可能是我们没有人可以复制你的问题的原因 - 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 csCustomPaintin 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).EndPaintWM_PAINTinheritedrcPaintPAINTSTRUCTBeginPaint

由于当时没有无效区域,操作系统只是忽略了以下的绘图调用.您可以在绘制画布之前通过使框架的客户端矩形无效来验证这一点:

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,或仅使您将要绘制的部分无效.