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

LCL: Implement optional parameter TopForm: Boolean, for GetParentForm (Delphi compatibility)

Browse Source 
git-svn-id: trunk@46047 -
This commit is contained in:
bart 2014-08-17 10:03:28 +00:00
parent 8e528bec4e
commit f3e358caff
1 changed files with 15 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
lcl/forms.pp
View File

@ -1724,7 +1724,7 @@ type
var
OnGetDesignerForm: TGetDesignerFormEvent = nil;
function GetParentForm(Control:TControl): TCustomForm;
function GetParentForm(Control: TControl; TopForm: Boolean = True): TCustomForm;
function GetFirstParentForm(Control:TControl): TCustomForm;
function GetDesignerForm(APersistent: TPersistent): TCustomForm;
function FindRootDesigner(APersistent: TPersistent): TIDesigner;
@ -1900,13 +1900,19 @@ begin
end;
//------------------------------------------------------------------------------
function GetParentForm(Control: TControl): TCustomForm;
function GetParentForm(Control: TControl; TopForm: Boolean): TCustomForm;
begin
//For Delphi compatibility if Control is a TCustomForm with no parent, the function returns the TCustomForm itself
while Control.Parent <> nil do
begin
if (not TopForm) and (Control is TCustomForm) then
Break;
Control := Control.Parent;
if Control is TCustomForm
then Result := TCustomForm(Control)
else Result := nil;
end;
if Control is TCustomForm then
Result := TCustomForm(Control)
else
Result := nil;
end;
//------------------------------------------------------------------------------
@ -1950,9 +1956,10 @@ end;
function GetFirstParentForm(Control: TControl): TCustomForm;
begin
while (Control<>nil) and (not (Control is TCustomForm)) do
Control:=Control.Parent;
Result:=TCustomForm(Control);
if (Control = nil) then
Result:= nil
else
Result := GetParentForm(Control, False);
end;
function GetDesignerForm(APersistent: TPersistent): TCustomForm;