Autor Téma: Class reference z RTTI  (Přečteno 311 krát)

Offline PetrB0

  • Mladík
  • **
  • Příspěvků: 91
  • Karma: 1
    • Verze Delphi: Delphi XE2, Delphi 10.2 Tokyo, Delphi 10.41
Class reference z RTTI
« kdy: 20-10-2020, 01:02:06 »
Ahoj,
pokud vytvářím objekty, které jsou ze společného předka a jejich typ se určuje např z parametrů načtených ze souboru/databáze/... tak to dělám přibližně takto:
Kód: Delphi [Vybrat]
  1. Type
  2.     TBasicClass = Class
  3.                    public
  4.                     class function JsemJa(Const VParam : Integer) : Boolean;virtual;
  5.                   End;
  6.  
  7.     TCBasicClass = Class Of TBasicClass;
  8.  
  9.     TClass2 = Class(TBasicClass)
  10.                public
  11.                  class function JsemJa(Const VParam : Integer) : Boolean;override;
  12.               End;
  13.  
  14.     TClass3 = Class(TBasicClass)
  15.                public
  16.                  class function JsemJa(Const VParam : Integer) : Boolean;override;
  17.               End;
  18.  
  19.     TClass4 = Class(TBasicClass)
  20.                public
  21.                  class function JsemJa(Const VParam : Integer) : Boolean;override;
  22.               End;
  23.  
  24.     TClassOwner = Class
  25.                    private
  26.                     pObsah : TList<TBasicClass>;
  27.                    public
  28.                     procedure AddClass(Const VParam : Integer);
  29.                     procedure AddClassVer2(Const VParam : Integer);
  30.                   End;
  31.  
  32.  
  33. { TBasicClass }
  34.  
  35. class function TBasicClass.JsemJa(const VParam: Integer): Boolean;
  36. begin
  37.  Result:=VParam=1;
  38. end;
  39.  
  40. { TClass2 }
  41.  
  42. class function TClass2.JsemJa(const VParam: Integer): Boolean;
  43. begin
  44.  Result:=VParam=2;
  45. end;
  46.  
  47. { TClass3 }
  48.  
  49. class function TClass3.JsemJa(const VParam: Integer): Boolean;
  50. begin
  51.  Result:=VParam=3;
  52. end;
  53.  
  54. { TClass4 }
  55.  
  56. class function TClass4.JsemJa(const VParam: Integer): Boolean;
  57. begin
  58.  Result:=VParam=4;
  59. end;
  60.  
  61. { TClassOwner }
  62.  
  63. procedure TClassOwner.AddClass(const VParam: Integer);
  64. Type TAClass = Array[0..3] Of TCBasicClass;
  65. Const
  66.      cAClass : TAClass = (TBasicClass,TClass2,TClass3,TClass4);
  67. Var
  68.    __I : Integer;
  69. begin
  70.  for __I := Low(cAClass) to High(cAClass) do
  71.   if cAClass[__I].JsemJa(VParam) then
  72.    begin
  73.     pObsah.Add(cAClass[__I].Create);
  74.     Break;
  75.    end;
  76. end;
  77.  
  78. procedure TClassOwner.AddClassVer2(const VParam: Integer);
  79. Var
  80.    __RC      : TRTTIContext;
  81.    __Type    : TRttiType;
  82.    __C       : TCBasicClass;
  83. begin
  84.  __RC := TRTTIContext.Create;
  85.  Try
  86.   for __Type in __RC.GetTypes do
  87.    if (__Type.TypeKind=tkClass) and __Type.IsInstance and __Type.AsInstance.MetaclassType.InheritsFrom(TBasicClass) then
  88.     begin
  89.      __C:=Získej se z __Type;  //Tohle neumím napsat.
  90.      if __C.JsemJa(VParam) then
  91.       begin
  92.        pObsah.Add(__C.Create);
  93.        Break;
  94.       end;
  95.     End;
  96.  Finally
  97.   __RC.Free;
  98.  End;
  99. end;
  100.  

Rutinou AddClass to řeším normálně. To funguje dle očekávání, ale při přidávání dalších tříd musím samozřejmě rozšířit ten seznam referencí na třídu v konstantě.
Rutina AddClassVer2 by to měla vyřešit, ale neumím ji napsat. Zkoušel jsem různá přetypování (jako třeba __C:=TCBasicClass(__Type.AsInstance.MetaClassType), ale buď to překladač nesežral, nebo to padlo na hlášku "too many external exceptions" nebo tak nějak. Prostě jsem zabloudil.

Nevíte, jak se to dá přepsat?
Je mi jasné, že nemůžu použít klasické přiřazení (něco jako __C:=__Type.DejClassReference), ale budu to muset přetypovat. Ovšem co, to fakt netuším.

Díky

Offline starous

  • Mladík
  • **
  • Příspěvků: 94
  • Karma: 2
    • Verze Delphi: Delphi 7, Delphi 10.4
Re:Class reference z RTTI
« Odpověď #1 kdy: 21-10-2020, 03:20:30 »
Možná mi něco uniká, ale nestačí použít tovární třída? Už na to moc nevidím, tak zkusím jen naznačit.

Kód: Delphi [Vybrat]
  1.   FSlovnikTrid : TDictionary<Integer, TCBasicClass>;
  2.  
  3.  
  4.   FSlovnikTrid.Add(1, TClass1);
  5.   FSlovnikTrid.Add(2, TClass2);
  6.   ...
  7.  
  8.   var HledanaTrida : TCBasicClass;
  9.   var NovyObjekt : TBasicClass;
  10.  
  11.   if FSlovnikTrid.TryGetValue(VstupniParametr, HledanaTrida)
  12.    then NovyObjekt := HledanaTrida.Create
  13.    else vyvolani vyjimky
  14.  
  15.  

Offline pf1957

  • Padawan
  • ******
  • Příspěvků: 3119
  • Karma: 136
    • Verze Delphi: D2007, XE3, DX10
Re:Class reference z RTTI
« Odpověď #2 kdy: 21-10-2020, 08:17:27 »
Nebo tu factory zalozit na introspekci, at uz pres enum nebo primo jmenem tridy:
Kód: Delphi [Vybrat]
  1. type
  2.   TAClass = (eBasicClass,eClass2,eClass3,eClass4);
  3. const
  4.   CAClassNames : array[TAClass] of string = ('TBasicClass','TClass2','TClass3','TClass4');
  5. var
  6.   cls: TPersistentClass;
  7.   inst: TBasicClass;
  8.  
  9.   cls := FindClass(CAClassName[eClass2]);
  10.   Assert(Assigned(cls), ...);
  11.   inst := TBasicClass(cls).Create;
  12.  
  13.   RegisterClass(TBasicClass, TClass2, TClass3, TClass4);
  14.  

Offline raul

  • Hrdina
  • ****
  • Příspěvků: 383
  • Karma: 15
    • Verze Delphi: FPC :D
Re:Class reference z RTTI
« Odpověď #3 kdy: 21-10-2020, 11:14:28 »
Neco jako :

__C:= __Type.ClassType;

?
Lazarus 1.6.3:), FPC, Intel/Arm, Windows/Linux

Offline PetrB0

  • Mladík
  • **
  • Příspěvků: 91
  • Karma: 1
    • Verze Delphi: Delphi XE2, Delphi 10.2 Tokyo, Delphi 10.41
Re:Class reference z RTTI
« Odpověď #4 kdy: 22-10-2020, 11:45:17 »
@Raul: díky za tip. Tento už jsem zkoušel před napsáním emailu. Nebyl jsem schopný správně vyvolat Constructor při použití ClassType, házelo to Exception
@pf1957: to vypadá zajímavě, zkusím to trochu modifikovat a použít pro svůj účel.

Offline raul

  • Hrdina
  • ****
  • Příspěvků: 383
  • Karma: 15
    • Verze Delphi: FPC :D
Re:Class reference z RTTI
« Odpověď #5 kdy: 22-10-2020, 11:59:54 »
Safr, mam pocit, ze jsem to nejak takhle pred lety pouzival, ale KDE sakra.

Nevim co delas kolem, ale tohle funguje spravne.
Kód: Delphi [Vybrat]
  1. program Project1;
  2.  
  3. {$APPTYPE CONSOLE}
  4.  
  5. {$R *.res}
  6.  
  7. uses
  8.   System.SysUtils;
  9.  
  10. type
  11.   tA = class
  12.     constructor Create; virtual;
  13.   end;
  14.  
  15.   tD1 = class(tA)
  16.     constructor Create; override;
  17.   end;
  18.  
  19.   tD2 = class(tA)
  20.     constructor Create; override;
  21.   end;
  22.  
  23.   tC = class of tA;
  24.  
  25. { tA }
  26.  
  27. constructor tA.Create;
  28. begin
  29.    Writeln('tA');
  30. end;
  31.  
  32. { tD2 }
  33.  
  34. constructor tD2.Create;
  35. begin
  36.    Writeln('tD2');
  37. end;
  38.  
  39. { tD1 }
  40.  
  41. constructor tD1.Create;
  42. begin
  43.    Writeln('tD1');
  44. end;
  45.  
  46. var c : tC;
  47.     a : tA;
  48.  
  49. begin
  50.   try
  51.  
  52.  
  53.     c := tD1;
  54.     a := c.Create;
  55.  
  56.  
  57.     { TODO -oUser -cConsole Main : Insert code here }
  58.   except
  59.     on E: Exception do
  60.       Writeln(E.ClassName, ': ', E.Message);
  61.   end;
  62. end.

Pokud spravne RTTI vraci typy, pak by to melo chodit stejne s tim ze do meho C si vlozis ClassType (coz je class of tObject).

Jakou exception ? Na kterem radku apod.
Lazarus 1.6.3:), FPC, Intel/Arm, Windows/Linux

Offline PetrB0

  • Mladík
  • **
  • Příspěvků: 91
  • Karma: 1
    • Verze Delphi: Delphi XE2, Delphi 10.2 Tokyo, Delphi 10.41
Re:Class reference z RTTI
« Odpověď #6 kdy: 22-10-2020, 12:57:18 »
Ahoj,
samozřejmě konstrukci class off v pohodě používám už dlouho.
Teď ten kód nemám před sebou, ale měl jsem proměnnou  typu class off mé třídy a snažil jsem se jí přiřadit ten classType. Na to mi řval překladač. (tuším, že mám nesprávné typy). Přetypování ve stylu TMyClass(..) nebo (... as TMyClass) nepomohlo, to jsem nasadil větší kalibr přes absolute. To už chudák sežral, ale vyvolání toho constructoru TMyClass skončilo na "too many external exceptions", prostě úplně blbě. O té TBaseClass jsem četl až tady, tak to ještě vyzkouším.
Díky