How to create an object by its "string" class name ?

[izd]

Hi everybody ! 

I would like to found out an easy way to create an object by its class name from a string.

It should look like :

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

1. var
2.   obj: TObject;
3.  
4.   obj := BuildObject( 'TButton', Self );

Of course, the NOT easy way is to cast the class name...

nb: For now, my interest is about controls (cf. Self)

Thank you in advance 

[Thaddy]

This is not a scripting language but probably the RTTI lovers  will give you an elaborate  answer on how exactly you can do that.   (And it's a bad idea)

[marcov]

Afaik VCL classes are registered, so something like

getclass('TButton').create(selfl);

[izd]

Thank you mates 

@marcov: Unfortunately, its not works...

[Thaddy]

They are only registered when used somewhere. Otherwise you have to register them by hand. (code reduction)

[izd]

This is what I thought after searching the web... 

[sky_khan]

Notice that, this is not thread-safe but it provides you a way to use classes you want, without interfering streaming of components

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

1. unit ControlReg;
2.  
3. {$mode objfpc}{$H+}
4.  
5. interface
6.  
7. uses
8.   Classes, SysUtils, Controls, fgl;
9.  
10. type
11.   TClassMap = specialize TFPGMap<string,TControlClass>;
12.  
13.   { TControlRegistry }
14.  
15.   TControlRegistry = class(TClassMap)
16.   public
17.     procedure RegisterControl(aClass:TControlClass);
18.     procedure RegisterControls(aClassArr : array of TControlClass);
19.     function CreateControl(const aClassName:string;aOwner:TComponent):TControl;
20.   end;
21.  
22.  
23.   function ControlRegistry : TControlRegistry;
24.  
25. implementation
26. uses
27.   rtlconsts;
28.  
29. var
30.   FReg : TControlRegistry;
31.  
32. function ControlRegistry : TControlRegistry;
33. begin
34.   if FReg=nil then
35.     FReg :=TControlRegistry.Create;
36.   Result:=FReg;
37. end;
38.  
39. { TControlRegistry }
40.  
41. procedure TControlRegistry.RegisterControl(aClass: TControlClass);
42. begin
43.   Add(aClass.ClassName,aClass);
44. end;
45.  
46. procedure TControlRegistry.RegisterControls(aClassArr: array of TControlClass);
47. var
48.   aClass : TControlClass;
49. begin
50.   for aClass in aClassArr do
51.     RegisterControl(aClass);
52. end;
53.  
54. function TControlRegistry.CreateControl(const aClassName: string;
55.   aOwner: TComponent): TControl;
56. var
57.   Ndx : Integer;
58. begin
59.   Ndx:=IndexOf(aClassName);
60.   if Ndx>=0 then
61.     Result:=Data[Ndx].Create(aOwner)
62.   else
63.     raise EClassNotFound.CreateFmt(SClassNotFound, [AClassName]);
64. end;
65.  
66. initialization
67. finalization
68.   FReg.Free;
69. end.
70.  

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

1. uses ControlReg;
2.  
3. procedure TForm1.Button1Click(Sender: TObject);
4. begin
5.   with ControlRegistry.CreateControl('TEdit',Self) do
6.     Parent:=Panel1;
7. end;
8.  
9. constructor TForm1.Create(aOwner: TComponent);
10. begin
11.   inherited Create(aOwner);
12.   ControlRegistry.RegisterControls([TMemo,TButton,TEdit,TLabel]);
13. end;                                  
14.  

[Remy Lebeau]

Afaik VCL classes are registered, so something like

getclass('TButton').create(selfl);

GetClass() returns a general purpose TPersistentClass (aka 'class of TPersistent').  You have to type-cast it in order to call the virtual TComponent.Create() constructor:

Code: [Select]

var
  Btn: TButton;
begin
  Btn := TButton(TComponentClass(GetClass('TButton')).Create(Self));
end;

Alternatively:

Code: [Select]

type
  TButtonClass = class of TButton;

var
  Btn: TButton;
begin
  Btn := TButtonClass(GetClass('TButton')).Create(Self);
end;

Just make sure the desired classes are registered at runtime, either by the RTL itself when initializing packages, or explicitly in code:

Code: [Select]

RegisterClass(TDesiredControlHere);


[bylaardt]

No magic:

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

1. function BuildControl(Const ObjectClass:String;ObjectOwner:TComponent):TwinControl
2. begin
3.   case LowerCase(ObjectClass) of
4.     'tbutton' : result:=TButton.create(ObjectOwner);
5.     'tlabel'  : result:=TLabel.create(ObjectOwner);
6.     'tedit'   : result:=TEdit.create(ObjectOwner);
7.     'tmemo'   : result:=TMemo.create(ObjectOwner);
8.     // and so on
9.   else
10.      raise Exception.create(ObjectClass+' not allowed in BuilControl');
11.   end;
12. end;
13.  

[izd]

So.....no magic....(sic)

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

1. function BuildControl( const pClassName: String ): TObject;
2. begin
3.   case pClassName of
4.     'TButton'  : Result := TButton.Create( nil );
5.     .../... and so on .../...
6.   end;
7. end;

Thank you all friends 

ps: if someone found out the way to do so, I'll take it 

[Ñuño_Martínez]

May be you can use an array of a record to store the classes.  Something like:

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

1.   TYPE
2.   { Any component. }
3.     ClassType = CLASS OF TComponent;
4.  
5.   { Stores class information. }
6.     TClassListItem = RECORD
7.       Name: STRING;
8.       TheClass: ClassType;
9.     END;
10.  
11.   VAR
12.     ClassList: ARRAY [...] OF TClassListItem;
13.  
14.   BEGIN
15.   { Add class information. }
16.     ClassList[0].Name := 'TButton';
17.     ClassList[0].TheClass := TButton;
18. ...
19.   { Searchs "ClassName" and creates "TheObject" }
20.     FOR Ndx := LOW (ClassList) TO HIGH (ClassList) DO
21.       IF ClassName = ClassList[Ndx].ClassName THEN
22.         TheObject := ClassList[Ndx].TheClass.Create (SELF)
23.   END;
24.  

I didn't test actually so may be it doesn't work at all.

[marcov]

If you use LCL you might as well use the fact that such array/tlist already exist, see Remy's answer.

[Ñuño_Martínez]

If you use LCL you might as well use the fact that such array/tlist already exist, see Remy's answer.

I see.  Didn't knew that.