Delphi: TGraphicControl支持PaintTo方法

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;

完美支持

猜你喜欢

转载自www.cnblogs.com/crwy/p/9233230.html
今日推荐