paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-07 05:18:00 +02:00
Code Issues Packages Projects Releases Wiki Activity

lcl: add TCustomForm.GetFormImage from Gerard Visent (issue #0011292 with modifications)

Browse Source 
git-svn-id: trunk@15127 -
This commit is contained in:
paul 2008-05-14 06:43:38 +00:00
parent 5860bfb71a
commit 1fe620b00a
2 changed files with 19 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
lcl/forms.pp
View File

@ -523,9 +523,10 @@ type
procedure RemoveHandlerClose(OnCloseHandler: TCloseEvent);
procedure AddHandlerCreate(OnCreateHandler: TNotifyEvent; AsLast: Boolean=true);
procedure RemoveHandlerCreate(OnCreateHandler: TNotifyEvent);
function IsShortcut(var Message: TLMKey): boolean; virtual;
function IsShortcut(var Message: TLMKey): boolean; virtual;
procedure IntfDropFiles(const FileNames: Array of String);
procedure IntfHelp(AComponent: TComponent);
function GetFormImage: TBitmap;
public
// drag and dock
procedure Dock(NewDockSite: TWinControl; ARect: TRect); override;

17
lcl/include/customform.inc
View File

@ -1766,6 +1766,23 @@ begin
end;
end;
function TCustomForm.GetFormImage: TBitmap;
var
ARect: TRect;
begin
Result := TBitmap.Create;
try
Result.Width := ClientWidth;
Result.Height := ClientHeight;
LCLIntf.GetWindowRect(Handle, ARect);
with GetClientOrigin do
PaintTo(Result.Canvas, ARect.Left - X, ARect.Top - Y);
except
Result.Free;
raise;
end;
end;
{------------------------------------------------------------------------------
Method: TCustomForm.CreateWnd
Params: None