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

LCL/Forms: Overload function TCustomForm.GetFormImage with procedure requiring the bitmap as argument. Issue #41140.

Browse Source
This commit is contained in:
wp_xyz 2024-09-14 12:51:05 +02:00
parent f7293e2477
commit 55ac08a505
2 changed files with 12 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
lcl/forms.pp
View File

@ -708,6 +708,7 @@ type
procedure EnsureVisible(AMoveToTop: Boolean = True); procedure EnsureVisible(AMoveToTop: Boolean = True);
procedure FocusControl(WinControl: TWinControl); procedure FocusControl(WinControl: TWinControl);
function FormIsUpdating: Boolean; override; function FormIsUpdating: Boolean; override;
procedure GetFormImage(ABitmap: TCustomBitmap);
function GetFormImage: TBitmap; function GetFormImage: TBitmap;
function GetRolesForControl(AControl: TControl): TControlRolesForForm; function GetRolesForControl(AControl: TControl): TControlRolesForForm;
function GetRealPopupParent: TCustomForm; function GetRealPopupParent: TCustomForm;

17
lcl/include/customform.inc
View File

@ -2709,16 +2709,21 @@ begin
end; end;
end; end;
function TCustomForm.GetFormImage: TBitmap; procedure TCustomForm.GetFormImage(ABitmap: TCustomBitmap);
var var
ARect: TRect; ARect: TRect = (Left:0; Top:0; Right:0; Bottom:0);
begin
ABitmap.SetSize(ClientWidth, ClientHeight);
LCLIntf.GetWindowRect(Handle, ARect);
with GetClientOrigin do
PaintTo(ABitmap.Canvas, ARect.Left - X, ARect.Top - Y);
end;
function TCustomForm.GetFormImage: TBitmap;
begin begin
Result := TBitmap.Create; Result := TBitmap.Create;
try try
Result.SetSize(ClientWidth, ClientHeight); GetFormImage(Result);
LCLIntf.GetWindowRect(Handle, ARect);
with GetClientOrigin do
PaintTo(Result.Canvas, ARect.Left - X, ARect.Top - Y);
except except
Result.Free; Result.Free;
raise; raise;