[solved] Iteration of class fields

[gidesa]

Hello, next code works in Delphi, not tested on FPC.
It dynamically set all properties of type TAnObject, of a TSomeclass class, with
an existing TAnObject instance, without knowing anything of TSomeclass.
It uses RTTI and generics.

Code: Pascal  [Select][+][-]

1. type
2.   TRTTIHelpers = class
3.  
4. ...............
5.  
6. class function TRTTIHelpers.GetPropertiesByClass<T>(const aClass: TClass): TList<TRttiProperty>;
7. var
8.   lstOut: TList<TRttiProperty>;
9.   C: TRttiContext;
10.   rttiType: TRttiType;
11.   LProp: TRttiProperty;
12.   attribute: TCustomAttribute;
13.  
14. begin
15.   lstOut:=TList<TRttiProperty>.Create;
16. //maybe for FPC:   c:=TRttiContext.Create;
17.   rttiType := C.GetType(aClass);
18.   for LProp in rttiType.GetProperties do
19.     begin
20.       if LProp.PropertyType.Name = T.ClassName then
21.             lstOut.Add(LProp);
22.     end;
23.   if lstOut.Count=0 then
24.   begin
25.     lstOut.Free;
26.     lstOut:=nil;
27.   end;
28. //  c.Free;
29.   Result:=lstOut;
30.  
31. end;
32.  
33.  
34. class function TRTTIHelpers.SetPropertyValue(const aProp: TRttiProperty; const obj: TObject;
35.                                               const aValue: TValue): Boolean;
36. begin
37.   Result:=False;
38.   aprop.SetValue(obj, aValue);
39.   Result:=True;
40. end;
41.  
42. //=============================================================================================
43.  
44.       procedure setHandler(tsk: TSomeclass; proplist: TList<TRttiProperty>; v:TValue);
45.       var
46.         objprop:  TRttiProperty;
47.       begin
48.         if proplist<>nil  then
49.         begin
50.           for objprop in proplist do
51.           begin
52.             TRTTIHelpers.SetPropertyValue(objprop, tsk, v)
53.           end;
54.         end;
55.       end;
56.  
57.       procedure initProp(tsk: TSomeclass; anObject: TAnObject);
58.       var
59.         proplist: TList<TRttiProperty>;
60.         v: TValue;
61.       begin
62.         proplist:=TRTTIHelpers.GetPropertiesByClass<TAnObject>(tsk.ClassType);
63.         v:=anObject ;  // existing object of type TAnObject
64.         setHandler(tsk, proplist, v);  
65.         proplist.Free;
66.       end;
67.  
68.  
69.  

[paweld]

for FPC stable/fixes, this will only work for published properties (as @marcov mentioned), i.e. the example from @GetMem should look like this:

Code: Pascal  [Select][+][-]

1. uses
2.   rtti;
3.  
4. type
5.  
6.   { TMyClass }
7.  
8.   TMyClass = class
9.   private
10.     FLbl: TLabel;
11.     FButton: TButton;
12.     FEdit: tedit;
13.   published
14.     property Lbl: TLabel read FLbl write FLbl;
15.     property Edit: tedit read FEdit write FEdit;
16.     property Button: TButton read FButton write FButton;
17.   end;
18.  
19. procedure TForm1.FormCreate(Sender: TObject);
20. var
21.   i, c: Integer;
22.   context: TRttiContext;
23.   rType: TRttiType;
24. begin
25.   Memo1.Lines.Clear;
26.   context := TRttiContext.Create;
27.   rType := context.GetType(TMyClass.ClassInfo);
28.   for i := 0 to High(rtype.GetProperties) do
29.     Memo1.Lines.Add(rtype.GetProperties[i].Name);
30. end;                    
31.  

[gidesa]

The Rtti/generics part compile under FPC 3.3.1 (that I installed with Fpcupdeluxe), with {$Mode Delphi}, but there is an error on:

      procedure setHandler(tsk: TSomeclass; proplist: TList<TRttiProperty>; v:TValue);

I don't know the right FPC syntax.

Hello, next code works in Delphi, not tested on FPC.
It dynamically set all properties of type TAnObject, of a TSomeclass class, with
an existing TAnObject instance, without knowing anything of TSomeclass.
It uses RTTI and generics.

Code: Pascal  [Select][+][-]

1. type
2.   TRTTIHelpers = class
3.  
4. ...............
5.  
6. class function TRTTIHelpers.GetPropertiesByClass<T>(const aClass: TClass): TList<TRttiProperty>;
7. var
8.   lstOut: TList<TRttiProperty>;
9.   C: TRttiContext;
10.   rttiType: TRttiType;
11.   LProp: TRttiProperty;
12.   attribute: TCustomAttribute;
13.  
14. begin
15.   lstOut:=TList<TRttiProperty>.Create;
16. //maybe for FPC:   c:=TRttiContext.Create;
17.   rttiType := C.GetType(aClass);
18.   for LProp in rttiType.GetProperties do
19.     begin
20.       if LProp.PropertyType.Name = T.ClassName then
21.             lstOut.Add(LProp);
22.     end;
23.   if lstOut.Count=0 then
24.   begin
25.     lstOut.Free;
26.     lstOut:=nil;
27.   end;
28. //  c.Free;
29.   Result:=lstOut;
30.  
31. end;
32.  
33.  
34. class function TRTTIHelpers.SetPropertyValue(const aProp: TRttiProperty; const obj: TObject;
35.                                               const aValue: TValue): Boolean;
36. begin
37.   Result:=False;
38.   aprop.SetValue(obj, aValue);
39.   Result:=True;
40. end;
41.  
42. //=============================================================================================
43.  
44.       procedure setHandler(tsk: TSomeclass; proplist: TList<TRttiProperty>; v:TValue);
45.       var
46.         objprop:  TRttiProperty;
47.       begin
48.         if proplist<>nil  then
49.         begin
50.           for objprop in proplist do
51.           begin
52.             TRTTIHelpers.SetPropertyValue(objprop, tsk, v)
53.           end;
54.         end;
55.       end;
56.  
57.       procedure initProp(tsk: TSomeclass; anObject: TAnObject);
58.       var
59.         proplist: TList<TRttiProperty>;
60.         v: TValue;
61.       begin
62.         proplist:=TRTTIHelpers.GetPropertiesByClass<TAnObject>(tsk.ClassType);
63.         v:=anObject ;  // existing object of type TAnObject
64.         setHandler(tsk, proplist, v);  
65.         proplist.Free;
66.       end;
67.  
68.  
69.  

[Joanna from IRC]

I currently use a factory procedure for creating things
Thanks for all the interesting answers. I was unsure what to expect.
I was hoping for a syntax similar to iterating through fields of a dataset like

Code: Pascal  [Select][+][-]

1. for afield in fields do

I have another related question. Is there a way to determine the type from a nil variable pointer such as

Code: Pascal  [Select][+][-]

1.  var  b: tbutton;
2.  

How can I get tbutton type from b? I don’t think typeof(b) works does it?
I currently use tguicontrolclass = class of tcontrol as a type variable.

[rvk]

I have another related question. Is there a way to determine the type from a nil variable pointer such as

Code: Pascal  [Select][+][-]

1.  var  b: tbutton;
2.  

How can I get tbutton type from b? I don’t think typeof(b) works does it?
I currently use tguicontrolclass = class(tcontrol) as a type variable.

b should have a ClassName and ClassType property.

So b.ClassName is 'TButton' and b.ClassType is TButton (where you could do (b.ClassType).Create.

From that last one... you don't even need to know what type b is.

For instance... you could do something like this:

Code: Pascal  [Select][+][-]

1. type
2.   dref = class of TComponent;
3.  
4. var
5.   d: dref;
6.   e: TComponent;
7. begin
8.   RegisterClass(TEdit);
9.   d := dref(FindClass('TEdit'));
10.   e := d.Create(Self);
11.   TControl(e).parent := self;

You do need the RegisterClass to fill the array for FindClass.
But after that you can get the ClassType and use the reference to create a component without the TEdit itself here.

[Thaddy]

Can be much simpler.
The control need not be instantiated, just declared.
Simple example;

Code: Pascal  [Select][+][-]

1. procedure TForm1.FormCreate(Sender: TObject);
2. var
3.   b:Tbutton;
4.   info:Ptypeinfo;
5. begin
6.   info:=typeinfo(b);
7.   showmessage(info^.name);// shows TButton
8. end;  

[Joanna from IRC]

i was trying to eliminate type_needed parameter

the classtype doesn't see to work with "this_control" which was typecast to control before being sent maybe its type was lost

Code: Pascal  [Select][+][-]

1. TGUI_CONTROL_CLASS = class of control;
2.  
3. PROCEDURE TCONTROL_HELPER.CREATE_THIS_CONTROL(CONST TYPE_NEEDED:TGUI_CONTROL_CLASS;
4.                           VAR THIS_CONTROL:TCONTROL;CONST THE_NAME:SHORTSTRING);
5. BEGIN
6. IF (THIS_CONTROL <> NIL) OR NOT (SELF IS TWinControl)
7.    THEN EXIT;
8. THIS_CONTROL:= TYPE_NEEDED.CREATE(SELF); // sometimes it declares name
9. WITH THIS_CONTROL DO // the new control created in self
10.      BEGIN
11.      Parent:= TWinControl(SELF);
12.      IF Name = ''  // it was not named in the process of being created
13.         THEN if THE_NAME <> ''
14.                 then Name := THE_NAME
15.                 else Name := TYPE_NEEDED.ClassName;
16.      END;
17.  END;    
18.  

[rvk]

Code: Pascal  [Select][+][-]

1. TGUI_CONTROL_CLASS = class of control;

Shouldn't that be class of TControl ??

In the TCONTROL_HELPER.CREATE_THIS_CONTROL you have the parameter for THIS_CONTROL as TControl.
So the reference to that class also needs to be TControl.

After that you should be able to create all descendants of that class.

[Joanna from IRC]

Shouldn't that be class of TControl ??

Yes class of tcontrol sorry for typo
I had type casted the THIS_CONTROL:TCONTROL to tcontrol in the calling procedure so it would work for everything. But that could be interfering with it having the correct type. The only other technique I know of is using and untyped parameter.
Any suggestions?

[rvk]

Shouldn't that be class of TControl ??

Yes class of tcontrol sorry for typo
I had type casted the THIS_CONTROL:TCONTROL to tcontrol in the calling procedure so it would work for everything. But that could be interfering with it having the correct type. The only other technique I know of is using and untyped parameter.
Any suggestions?

I'm not sure what goes wrong at your end... but try the following code...
It will create a component on a form (TEdit in this case) just from the text 'TEdit' and uses it.

Code: Pascal  [Select][+][-]

1. type
2.   ReferenceType = class of TControl;
3.  
4. procedure TForm1.Button1Click(Sender: TObject);
5. var
6.   AnUnknownComponent: TControl;
7.   RefType: ReferenceType;
8. begin
9.   RegisterClass(TEdit);
10.   RefType := ReferenceType(FindClass('TEdit'));
11.   AnUnknownComponent := RefType.Create(Self);
12.   AnUnknownComponent.Parent := Self;
13.   AnUnknownComponent.Top := 10;
14.   AnUnknownComponent.Left := 10;
15.   AnUnknownComponent.SetTextBuf('Hee there');
16.   Showmessage('TEdit.Text is ' + TEdit(AnUnknownComponent).Text);
17. end;

When you want to actually fill other properties and event, you can also do this via rtti.

[jamie]

The problem Joanna is having is the NAME property which does not get assigned when dynamically creating the control.

The IDE (Designer) will do this with incremental values.

In this case, the helper that is presented offers a name and if not, a name is generated from the class name but here is the kicker.

 the list of existing items owned should be scanned to generate a number to append to the name that does not already exist in the list! otherwise, you get a duplicated name or a possibility of that.
 

[Joanna from IRC]

Maybe I’m attempting the impossible. I’m aware of the duplicate name issue which is why I pass it as an optional parameter. However this code doesn’t have any error checking and that’s not good.
I was hoping to simply the helper to create the control like this.
 

Code: Pascal  [Select][+][-]

1.  
2. PROCEDURE TCONTROL_HELPER.CREATE_THIS_CONTROL(CONST VAR THIS_CONTROL:TCONTROL;CONST THE_NAME:SHORTSTRING);
3.  

But the tcontrol type doesn’t work well with different variables. Untyped variable parameter doesn’t work either nor does using this_control:= this_control.classtype.create (self );
Im trying to keep it simple, for the time being I will just send the type I’m creating as a parameter..
 Thanks for the help everyone.

[jamie]

maybe this can give you some ideas.

Code: Pascal  [Select][+][-]

1. unit Unit1;
2.  
3. {$mode objfpc}{$H+}
4.  
5. interface
6.  
7. uses
8.   Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls;
9.  
10. type
11.  
12.   { TForm1 }
13.  
14.   TForm1 = class(TForm)
15.     Button1: TButton;
16.     procedure Button1Click(Sender: TObject);
17.   private
18.  
19.   public
20.  
21.   end;
22.  
23. var
24.   Form1: TForm1;
25.  
26. implementation
27.  
28. {$R *.lfm}
29.  
30. { TForm1 }
31. Function CreateNewControlWithOwner(aOwner:TComponent;aClass:TClass;SuggestedName:String=''):TControl;
32. Var
33.   I:Integer;
34.   CN:String;
35. Begin
36.   If (AOwner = Nil)or(Aowner.FindComponent(SuggestedName)<>Nil) then
37.    Begin
38.      raise Exception.Create('oops, Sum Tig Went Wong');
39.      Exit;
40.    end;
41.   Result :=  Tcontrol(ACLass.NewInstance).Create(AOwner);
42.   Result.Name := SuggestedName;
43.   If SuggestedName <> '' Then exit;
44.   SuggestedName := Copy(Result.ClassName,2,50);
45.   I:= 1;
46.   While aowner.FindComponent(SuggestedName+IntTostr(I))<> Nil Do Inc(I);
47.   Result.Name := SuggestedName+IntToStr(I);
48. End;
49. procedure TForm1.Button1Click(Sender: TObject);
50. Var
51.   B:TButton;
52. begin
53.   B := CreateNewControlWithOwner(Self,TButton,'') as TButton;
54.   B.Parent := Self;
55.  // B.Free;
56. end;
57.  
58. end.
59.  

[Joanna from IRC]

I have rethought this a bit and realized that sometimes I need to use a descendant of the variable type instead of the actual variable type so for now I’m just going to pass the actual type I want to create to my factory procedure.

Thanks for the informative answers , the information could be useful atlater .