Delphi: TGraphicControl支持PaintTo方法

Posted 2020-11-20 crwy

Delphi之TWinControl支持PaintTo方法，可以方便的Paint有句柄控件，而此方法，TGraphicControl没有。

这使得有时需要Paint无句柄控件诸如TLabel时颇为费事，能否扩充它？

可以。使用class helper for技术，通过其Parent，仍然调用TWinControl支持PaintTo方法，中转一下。

 

直上代码吧，以做备忘：

  TGraphicControlHelper = class helper for TGraphicControl
    procedure PaintTo(Canvas: TCanvas; X, Y: Integer);
  end;

实现：

{ TGraphicControlHelper }

procedure TGraphicControlHelper.PaintTo(Canvas: TCanvas; X, Y: Integer);
var
  bmp: TBitmap;
  sr: TRect;
begin
  if Self.Parent = nil then Exit;

  bmp := TBitmap.Create;
  try
    bmp.SetSize(Parent.Width, Parent.Height);
    Self.Parent.PaintTo(bmp.Canvas.Handle, X, Y);
    sr := Self.BoundsRect;
    Windows.OffsetRect(sr, 1, 1);
    Canvas.CopyRect(Self.ClientRect, bmp.Canvas, sr);
  finally
    bmp.Free;
  end;
end;

 

完美支持