View Issue Details

IDProjectCategoryView StatusLast Update
0026594LazarusPatchpublic2014-08-17 14:56
Reporterocean Assigned ToBart Broersma  
PrioritynormalSeverityminorReproducibilityhave not tried
Status closedResolutionfixed 
Product Version1.2.5 (SVN) 
Target Version1.2.6 
Summary0026594: ValidParentForm
Descriptionin Delphi this compile

var e: TEdit;
    t: TCustomForm;
begin
 e := TEdit.Create(Form1);
 e.Name := 'Test';
 //e.Parent := Form1;
 t := ValidParentForm(e);
end;
TagsNo tags attached.
Fixed in Revisionr46048
LazTarget1.2.6
WidgetsetWin32/Win64
Attached Files

Activities

ocean

2014-08-14 17:04

reporter  

validparentform.patch (1,504 bytes)   
Index: lcl/forms.pp
===================================================================
--- lcl/forms.pp	(revision 46043)
+++ lcl/forms.pp	(working copy)
@@ -1725,6 +1725,7 @@
   OnGetDesignerForm: TGetDesignerFormEvent = nil;
 
 function GetParentForm(Control:TControl): TCustomForm;
+function ValidParentForm(Control:TControl): TCustomForm;
 function GetFirstParentForm(Control:TControl): TCustomForm;
 function GetDesignerForm(APersistent: TPersistent): TCustomForm;
 function FindRootDesigner(APersistent: TPersistent): TIDesigner;
@@ -1909,6 +1910,13 @@
   else Result := nil;
 end;
 
+function ValidParentForm(Control: TControl): TCustomForm;
+begin
+  Result := GetParentForm(Control);
+  if Result = nil then
+    raise EInvalidOperation.CreateFmt(sParentRequired, [Control.Name]);
+end;
+
 //------------------------------------------------------------------------------
 function IsAccel(VK: word; const Str: string): Boolean;
 const
Index: lcl/lclstrconsts.pas
===================================================================
--- lcl/lclstrconsts.pas	(revision 46043)
+++ lcl/lclstrconsts.pas	(working copy)
@@ -217,6 +217,7 @@
   sInvalidImageSize = 'Invalid image size';
   sDuplicateMenus = 'Duplicate menus';
   sCannotFocus = 'Cannot focus a disabled or invisible window';
+  sParentRequired = 'Control "%s" has no parent window';
   sInvalidCharSet = 'The char set in mask "%s" is not valid!';
   SMaskEditNoMatch = 'The current text does not match the specified mask.';
 
validparentform.patch (1,504 bytes)   

Bart Broersma

2014-08-14 20:04

developer   ~0076601

How did you write that code? BlackBox testing or did you copy it from somewhere?

ocean

2014-08-15 07:26

reporter   ~0076606

function is same as GetParentForm, except error if there was no parent. Resource variable name was "googled" and error message checked with code posted above.

Delphi GetParentForm has additional boolean parameter "TopForm", not implemented in Lazarus

Bart Broersma

2014-08-15 11:42

developer   ~0076607

Thanks for the reply.

See the description in http://docwiki.embarcadero.com/VCL/2010/en/Forms.ValidParentForm

It should not be so hard to implement the TopForm parameter as well.
Can you have a go at that as well?

Bart Broersma

2014-08-16 14:16

developer   ~0076613

Last edited: 2014-08-16 14:24

View 3 revisions

B.t.w. it seems like GetParentForm in recent Delphi now also has this TopForm parameter: http://docwiki.embarcadero.com/VCL/2010/en/Forms.GetParentForm

Maybe we should implement that first.

ocean

2014-08-16 15:33

reporter  

validparentformv2.patch (2,305 bytes)   
Index: lcl/forms.pp
===================================================================
--- lcl/forms.pp	(revision 46043)
+++ lcl/forms.pp	(working copy)
@@ -1724,7 +1724,8 @@
 var
   OnGetDesignerForm: TGetDesignerFormEvent = nil;
 
-function GetParentForm(Control:TControl): TCustomForm;
+function GetParentForm(Control: TControl; TopForm: Boolean = True): TCustomForm;
+function ValidParentForm(Control: TControl; TopForm: Boolean = True): TCustomForm;
 function GetFirstParentForm(Control:TControl): TCustomForm;
 function GetDesignerForm(APersistent: TPersistent): TCustomForm;
 function FindRootDesigner(APersistent: TPersistent): TIDesigner;
@@ -1900,8 +1901,15 @@
 end;
 
 //------------------------------------------------------------------------------
-function GetParentForm(Control: TControl): TCustomForm;
+function GetParentForm(Control: TControl; TopForm: Boolean = True): TCustomForm;
 begin
+  if TopForm = False then
+  begin
+    Result := GetFirstParentForm(Control);
+    if not Assigned(Result) then
+      Result := nil;
+    Exit;
+  end;
   while Control.Parent <> nil do
     Control := Control.Parent;
   if Control is TCustomForm
@@ -1909,6 +1917,20 @@
   else Result := nil;
 end;
 
+function ValidParentForm(Control: TControl; TopForm: Boolean = True): TCustomForm;
+begin
+  if TopForm = False then
+  begin
+    Result := GetFirstParentForm(Control);
+    if not Assigned(Result) then
+      Result := nil;
+  end
+  else
+    Result := GetParentForm(Control);
+  if Result = nil then
+    raise EInvalidOperation.CreateFmt(sParentRequired, [Control.Name]);
+end;
+
 //------------------------------------------------------------------------------
 function IsAccel(VK: word; const Str: string): Boolean;
 const
Index: lcl/lclstrconsts.pas
===================================================================
--- lcl/lclstrconsts.pas	(revision 46043)
+++ lcl/lclstrconsts.pas	(working copy)
@@ -217,6 +217,7 @@
   sInvalidImageSize = 'Invalid image size';
   sDuplicateMenus = 'Duplicate menus';
   sCannotFocus = 'Cannot focus a disabled or invisible window';
+  sParentRequired = 'Control "%s" has no parent window';
   sInvalidCharSet = 'The char set in mask "%s" is not valid!';
   SMaskEditNoMatch = 'The current text does not match the specified mask.';
 
validparentformv2.patch (2,305 bytes)   

ocean

2014-08-16 15:35

reporter  

validparentform_test.txt (896 bytes)   
procedure TForm1.Button1Click(Sender: TObject);
const e: string = 'Failed!';
var c: TEdit;
    t1, t2: TCustomForm;
begin
 c := TEdit.Create(nil);
 c.Name := 'TestComponent';
 t1 := TCustomForm.Createnew(nil);
 t1.Name := 'TestForm';
 c.Parent := t1;
 t1.parent := Form1;
 t2 := GetParentForm(c);
 if t2.Name <> 'Form1' then showmessage(e);
 t2 := GetParentForm(c, false);
 if t2.Name <> 'TestForm' then showmessage(e);
 t2 := ValidParentForm(c);
 if t2.Name <> 'Form1' then showmessage(e);
 t2 := ValidParentForm(c, false);
 if t2.Name <> 'TestForm' then showmessage(e);
 c.Parent := nil;
 try
   t2 := GetParentForm(c);
 except showmessage(e); end;
 try
   t2 := GetParentForm(c, false);
 except showmessage(e); end;
 try
   t2 := ValidParentForm(c);
   showmessage(e);
 except end;
 try
   t2 := ValidParentForm(c, false);
   showmessage(e);
 except end;
end;
validparentform_test.txt (896 bytes)   

ocean

2014-08-16 15:36

reporter   ~0076615

In attached V2 wanted to make use of "GetFirstParentForm". (But maybe better just copy/paste that part, it would remove need to use "assigned")

Attached small test.

Bart Broersma

2014-08-16 16:40

developer   ~0076616

Personally I would rewrite GetFirstParentForm as GetParentForm(AControl, False) and inline that function.

ocean

2014-08-16 18:08

reporter  

validparentformv3.patch (2,771 bytes)   
Index: lcl/forms.pp
===================================================================
--- lcl/forms.pp	(revision 46044)
+++ lcl/forms.pp	(working copy)
@@ -1724,8 +1724,9 @@
 var
   OnGetDesignerForm: TGetDesignerFormEvent = nil;
 
-function GetParentForm(Control:TControl): TCustomForm;
-function GetFirstParentForm(Control:TControl): TCustomForm;
+function GetParentForm(Control: TControl; TopForm: Boolean = True): TCustomForm;
+function ValidParentForm(Control: TControl; TopForm: Boolean = True): TCustomForm;
+function GetFirstParentForm(Control: TControl): TCustomForm; inline;
 function GetDesignerForm(APersistent: TPersistent): TCustomForm;
 function FindRootDesigner(APersistent: TPersistent): TIDesigner;
 
@@ -1900,15 +1901,29 @@
 end;
 
 //------------------------------------------------------------------------------
-function GetParentForm(Control: TControl): TCustomForm;
+function GetParentForm(Control: TControl; TopForm: Boolean = True): TCustomForm;
 begin
-  while Control.Parent <> nil do
-    Control := Control.Parent;
+  if TopForm = False then
+  begin
+    while (Control <> nil) and (not (Control is TCustomForm)) do
+      Control := Control.Parent;
+  end else
+  begin
+    while Control.Parent <> nil do
+      Control := Control.Parent;
+  end;
   if Control is TCustomForm
   then Result := TCustomForm(Control)
   else Result := nil;
 end;
 
+function ValidParentForm(Control: TControl; TopForm: Boolean = True): TCustomForm;
+begin
+  Result := GetParentForm(Control, TopForm);
+  if Result = nil then
+    raise EInvalidOperation.CreateFmt(sParentRequired, [Control.Name]);
+end;
+
 //------------------------------------------------------------------------------
 function IsAccel(VK: word; const Str: string): Boolean;
 const
@@ -1948,11 +1963,9 @@
     Result:=Form.Designer;
 end;
 
-function GetFirstParentForm(Control: TControl): TCustomForm;
+function GetFirstParentForm(Control: TControl): TCustomForm; inline;
 begin
-  while (Control<>nil) and (not (Control is TCustomForm)) do
-    Control:=Control.Parent;
-  Result:=TCustomForm(Control);
+  Result := GetParentForm(Control, False);
 end;
 
 function GetDesignerForm(APersistent: TPersistent): TCustomForm;
Index: lcl/lclstrconsts.pas
===================================================================
--- lcl/lclstrconsts.pas	(revision 46044)
+++ lcl/lclstrconsts.pas	(working copy)
@@ -217,6 +217,7 @@
   sInvalidImageSize = 'Invalid image size';
   sDuplicateMenus = 'Duplicate menus';
   sCannotFocus = 'Cannot focus a disabled or invisible window';
+  sParentRequired = 'Control "%s" has no parent window';
   sInvalidCharSet = 'The char set in mask "%s" is not valid!';
   SMaskEditNoMatch = 'The current text does not match the specified mask.';
 
validparentformv3.patch (2,771 bytes)   

Bart Broersma

2014-08-17 12:14

developer   ~0076628

Please test and close if OK.

Issue History

Date Modified Username Field Change
2014-08-14 17:04 ocean New Issue
2014-08-14 17:04 ocean File Added: validparentform.patch
2014-08-14 20:04 Bart Broersma Note Added: 0076601
2014-08-14 20:05 Bart Broersma LazTarget => -
2014-08-14 20:05 Bart Broersma Status new => feedback
2014-08-15 07:26 ocean Note Added: 0076606
2014-08-15 07:26 ocean Status feedback => new
2014-08-15 11:42 Bart Broersma Note Added: 0076607
2014-08-16 14:16 Bart Broersma Note Added: 0076613
2014-08-16 14:23 Bart Broersma Note Edited: 0076613 View Revisions
2014-08-16 14:23 Bart Broersma Assigned To => Bart Broersma
2014-08-16 14:23 Bart Broersma Status new => assigned
2014-08-16 14:24 Bart Broersma Note Edited: 0076613 View Revisions
2014-08-16 15:33 ocean File Added: validparentformv2.patch
2014-08-16 15:35 ocean File Added: validparentform_test.txt
2014-08-16 15:36 ocean Note Added: 0076615
2014-08-16 16:40 Bart Broersma Note Added: 0076616
2014-08-16 18:08 ocean File Added: validparentformv3.patch
2014-08-17 12:14 Bart Broersma Fixed in Revision => r46048
2014-08-17 12:14 Bart Broersma LazTarget - => 1.2.6
2014-08-17 12:14 Bart Broersma Note Added: 0076628
2014-08-17 12:14 Bart Broersma Status assigned => resolved
2014-08-17 12:14 Bart Broersma Resolution open => fixed
2014-08-17 12:14 Bart Broersma Target Version => 1.2.6
2014-08-17 14:56 ocean Status resolved => closed