4

我的项目中有一个框架（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;

但是，在将我的框架放在主窗体上之后，调试器从未进入此方法，直到我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不更改任何内容。

也许我叫他们错了？

现在我使用带有/的WM_PAINT处理程序，因为我不想在这个框架上启用。另外我担心其他程序员在将我的框架放入他们的项目后会不小心禁用，并且会和我一样头疼。GetDCReleaseDCDoubleBufferedDoubleBuffered

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

4

2 回答 2

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
    ..

如您所见，whenDoubleBuffered未设置且没有控件时，PaintHandler不会调用（毕竟没有什么可绘制的：我们不是自定义绘图（没有 csCustomPaint 标志），也没有要显示的控件）。设置时DoubleBuffered，将遵循不同的代码路径，该路径调用WMPrintClient，然后调用PaintHandler.


如果您最终要使用没有任何控件的框架（尽管不太可能），那么从上面的代码中可以看出修复（当您知道时也是明智的）：包含csCustomPaint在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;

然后继承的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;

现在你会看到你的绘图会生效。当然，您可以选择不调用inherited，或者仅使您将绘制的部分无效。

于 2012-06-04T00:55:54.350 回答
0

看起来它只有在设计器中才被调用

procedure TCustomFrame.PaintWindow(DC: HDC);
begin
   // Paint a grid if designing a frame that paints its own background
   if (csDesigning in ComponentState) and (Parent is TForm) then
   with TForm(Parent) do
      if (Designer <> nil) and (Designer.GetRoot = Self) and
         (not StyleServices.Enabled or not Self.ParentBackground) then
          Designer.PaintGrid
   end;

做一些特殊绘画的唯一方法是将 WM_PAINT 添加到您的框架中：

TFrame3 = class(TFrame)
protected
  procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
end;
于 2012-05-21T07:45:53.043 回答