fork download
copy 
  1. program Project1;
  2. {$MODE OBJFPC}
  3. uses fgl;
  4.  
  5. type
  6.  
  7.   { TBase }
  8.  
  9.   TBase = class
  10.     class function FromData(data: string): TBase;virtual;
  11.     class procedure RegisterSelf;
  12.   end;
  13.  
  14.   TBaseClass = class of TBase;
  15.   TClassesList = specialize TFPGMap<string, TBaseClass>;
  16.  
  17.   { TChild1 }
  18.  
  19.   TChild1 = class(TBase)
  20.     class function FromData(data: string): TBase;override;
  21.   end;
  22.  
  23.   TSomeList = specialize TFPGMap<string, TChild1>;
  24.  
  25. var
  26.   aClasses: TClassesList;
  27.   SomeList: TSomeList;
  28.  
  29. { TChild1 }
  30.  
  31. class function TChild1.FromData(data: string): TBase;
  32. begin
  33.   if data = '' then
  34.     Result:=inherited FromData('default')
  35.   else
  36.   begin
  37.     writeln('Finding '+ClassName+' by name: '+data);
  38.     Result := SomeList.KeyData[data];
  39.   end;
  40. end;
  41.  
  42.  
  43. class function TBase.FromData(data: string): TBase;
  44. begin
  45.   writeln('created new '+ClassName+' with params: '+data);
  46.   Result := self.Create;
  47. end;
  48.  
  49. class procedure TBase.RegisterSelf;
  50. begin
  51.   if not Assigned(aClasses) then aClasses := TClassesList.Create;
  52.   aClasses.Add(ClassName,TBaseClass(ClassType));
  53. end;
  54.  
  55.  
  56. const
  57.  
  58.   SavedFile: array[1..4, 1..2] of string =
  59.     (
  60.     ('TBase','123'),
  61.     ('TBase','test'),
  62.     ('TChild1',''),
  63.     ('TChild1','test')
  64.     );
  65.  
  66. function StrToClass(s: string): TBaseClass;
  67. begin
  68.   Result := aClasses.KeyData[s];
  69. end;
  70.  
  71.  
  72. var
  73.   i: integer;
  74. begin
  75.   TBase.RegisterSelf;
  76.   TChild1.RegisterSelf;
  77.  
  78.   SomeList := TSomeList.Create;
  79.   SomeList.Add('test', TChild1.Create);
  80.  
  81.   for i := 1 to 4 do
  82.       StrToClass(SavedFile[i, 1]).FromData(SavedFile[i, 2]);
  83.  
  84.   readln;
  85. end.
  86.  
Success #stdin #stdout 0s 804KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
created new TBase with params: 123
created new TBase with params: test
created new TChild1 with params: default
Finding TChild1 by name: test
https://ideone.com/1CU08E
language:
Pascal (fpc 3.0.4)
created:
12 years ago
visibility:
public

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!