Advertisement
sglienke

AutoRegisterAttribute

Dec 15th, 2016
216
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. program Project1;
  2.  
  3. {$APPTYPE CONSOLE}
  4.  
  5. uses
  6.   Classes, Rtti,
  7.   SysUtils;
  8.  
  9. type
  10.   AutoRegisterAttribute = class(TCustomAttribute);
  11.  
  12.   TMyStuff = class(TPersistent)
  13.     procedure DoStuff; virtual;
  14.   end;
  15.  
  16.   [AutoRegister]
  17.   TMyAwesomeStuff = class(TMyStuff)
  18.     procedure DoStuff; override;
  19.   end;
  20.  
  21. procedure ProcessAutoRegisterAttributes;
  22. var
  23.   ctx: TRttiContext;
  24.   typ: TRttiType;
  25.   attr: TCustomAttribute;
  26.   cls: TClass;
  27. begin
  28.   for typ in ctx.GetTypes do
  29.     if typ.IsInstance then
  30.       for attr in typ.GetAttributes do
  31.         if attr is AutoRegisterAttribute then
  32.         begin
  33.           cls := TRttiInstanceType(typ).MetaclassType;
  34.           if cls.InheritsFrom(TPersistent) then
  35.             RegisterClass(TPersistentClass(cls));
  36.           Break;
  37.         end;
  38. end;
  39.  
  40. { TMyStuff }
  41.  
  42. procedure TMyStuff.DoStuff;
  43. begin
  44. end;
  45.  
  46. { TMyAwesomeStuff }
  47.  
  48. procedure TMyAwesomeStuff.DoStuff;
  49. begin
  50.   inherited;
  51. end;
  52.  
  53. procedure UseStuff(stuff: TMyStuff);
  54. begin
  55.   stuff.DoStuff;
  56. end;
  57.  
  58. var
  59.   cls: TPersistentClass;
  60. begin
  61.   ProcessAutoRegisterAttributes;
  62.   cls := FindClass('TMyAwesomeStuff');
  63. end.
Advertisement
RAW Paste Data Copied
Advertisement