[Lazarus] from hfiandor

[Gerard N/A]

On Tue, May 13, 2008 at 11:12 AM, Gerard N/A <gerardusmercator at gmail.com> wrote:
> Hi,
>
>  Get TCustomForm.GetFormImage is not yet implemented.
>  I opened a bug report about his:
>  http://bugs.freepascal.org/view.php?id=11292
>  I was about to propose a quick pach, but can't figure out how to get
>  the right offset to paint just the form's client area, since it seems
>  (in win32 widgetset, at least) that ClientWidth=Width and
>  Clientheight=Height.
>
Here's a quick and dirty solution without patching the LCL:

interface

type

  THackForm = class(TForm)
  public
    function GetClientOrigin: TPoint; override;
  end;

implementation

function THackForm.GetClientOrigin: TPoint;
begin
  Result:=inherited GetClientOrigin;
end;

and then

function GetFormImage(aForm: TForm): TBitmap;
begin
  Result := TBitmap.Create;
  try
   Result.Width  := aForm.ClientWidth;
   Result.Height := aForm.ClientHeight;
   Result.Canvas.Brush := aForm.Brush;
   Result.Canvas.FillRect(aForm.ClientRect);
   Result.Canvas.Lock;
   try
     aForm.PaintTo(Result.Canvas.Handle,
aForm.Left-THackForm(aForm).GetClientOrigin.X,
aForm.Top-THackForm(aForm).GetClientOrigin.Y);
   finally
     Result.Canvas.Unlock;
   end;
  except
   Result.Free;
   raise;
  end;
end;


Regards,

Gerard.