delphi RTTI 反射技术(转自朝闻道博客)

  1. unit Unit_main;  
  2.   
  3. interface  
  4.   
  5. uses  
  6.   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,  
  7.   Dialogs, StdCtrls, TypInfo;  
  8.   
  9. type  
  10.   TForm_main = class(TForm)  
  11.     Button1: TButton;  
  12.     Memo1: TMemo;  
  13.     Memo2: TMemo;  
  14.     Button2: TButton;  
  15.     Button3: TButton;  
  16.     Button4: TButton;  
  17.     Button5: TButton;  
  18.     Button6: TButton;  
  19.     Button7: TButton;  
  20.     Button8: TButton;  
  21.     Button9: TButton;  
  22.     Button10: TButton;  
  23.     Button11: TButton;  
  24.     Button12: TButton;  
  25.     Button13: TButton;  
  26.     procedure Button1Click(Sender: TObject);  
  27.     procedure Button2Click(Sender: TObject);  
  28.     procedure Button3Click(Sender: TObject);  
  29.     procedure Button4Click(Sender: TObject);  
  30.     procedure Button5Click(Sender: TObject);  
  31.     procedure Button6Click(Sender: TObject);  
  32.     procedure Button7Click(Sender: TObject);  
  33.     procedure Button8Click(Sender: TObject);  
  34.     procedure Button9Click(Sender: TObject);  
  35.     procedure Button10Click(Sender: TObject);  
  36.     procedure Button11Click(Sender: TObject);  
  37.     procedure Button12Click(Sender: TObject);  
  38.     procedure Button13Click(Sender: TObject);  
  39.   private  
  40.     { Private declarations }  
  41.   public  
  42.     { Public declarations }  
  43.   end;  
  44.   
  45.   PTKeyDog = ^TKeyDog;  
  46.   
  47.   TKeyDog = record  
  48.     id: Integer;  
  49.     projectname: string;  
  50.     city: string;  
  51.     letter: string;  
  52.     hash: string;  
  53.     code: string;  
  54.     note: string;  
  55.     filepath: string;  
  56.     userid: Integer;  
  57.   end;  
  58.   
  59.   { 自定义的类 }  
  60.   TMyClass = class(TComponent)  
  61.   public  
  62.     procedure msg(const str: string);  
  63.     function Add(const a, b: Integer): Integer;  
  64.   end;  
  65.   
  66.   
  67.   // 编译指令 Methodinfo 是 Delphi 2009 新增的, 只有它打开了, ObjAuto 才可以获取 public 区的信息.  
  68.   // 这样, ObjAuto 可以获取 TClass3 的 public、published 和默认区域的信息.  
  69. {$M+}  
  70. {$METHODINFO ON}  
  71.   
  72.   TClass3 = class  
  73.     function Fun3: string;  
  74.   private  
  75.     function Fun3Private: string;  
  76.   protected  
  77.     function Fun3Protected: string;  
  78.   public  
  79.     function Fun3Public: string;  
  80.   published  
  81.     function Fun3Published: string;  
  82.   end;  
  83. {$METHODINFO OFF}  
  84. {$M-}  
  85.   
  86. var  
  87.   Form_main: TForm_main;  
  88.   
  89. implementation  
  90.   
  91. uses  
  92.   Rtti, ObjAuto;  
  93. {$R *.dfm}  
  94.   
  95. // 获取对象的 RTTI 属性与事件的函数  
  96. function GetPropertyAndEventList(obj: TObject;  
  97.   pList, eList: TStringList): Boolean;  
  98. var  
  99.   ClassTypeInfo: PTypeInfo; { 类的信息结构指针 }  
  100.   ClassDataInfo: PTypeData; { 类的数据结构指针 }  
  101.   propertyList: PPropList; { TPropInfo 是属性的数据结构; 
  102.     PPropList 是其指针; 
  103.     TPropList 是属性结构指针的列表数组; 
  104.     PPropList 是指向这个数组的指针 }  
  105.   
  106.   num: Integer; { 记录属性的总数 }  
  107.   size: Integer; { 记录属性结构的大小 }  
  108.   i: Integer;  
  109. begin  
  110.   ClassTypeInfo := obj.ClassInfo; { 先获取: 类的信息结构指针 }  
  111.   ClassDataInfo := GetTypeData(ClassTypeInfo); { 再获取: 类的数据结构指针 }  
  112.   num := ClassDataInfo.PropCount; { 属性总数 }  
  113.   size := SizeOf(TPropInfo); { 属性结构大小 }  
  114.   
  115.   GetMem(propertyList, size * num); { 给属性数组分配内存 }  
  116.   
  117.   GetPropInfos(ClassTypeInfo, propertyList); { 获取属性列表 }  
  118.   
  119.   for i := 0 to num - 1 do  
  120.   begin  
  121.     if propertyList[i].PropType^.Kind = tkMethod then { 如果是事件; 事件也是属性吗, 给分出来 }  
  122.       eList.Add(propertyList[i].Name)  
  123.     else  
  124.       pList.Add(propertyList[i].Name);  
  125.   end;  
  126.   
  127.   pList.Sort;  
  128.   eList.Sort; { 排序 }  
  129.   
  130.   FreeMem(propertyList); { 释放属性数组的内存 }  
  131.   
  132.   Result := True;  
  133. end;  
  134.   
  135. procedure TForm_main.Button10Click(Sender: TObject);  
  136. var  
  137.   obj: TMyClass;  
  138.   t: TRttiType;  
  139.   m1, m2: TRttiMethod;  
  140.   r: TValue; // TRttiMethod.Invoke 的返回类型  
  141. begin  
  142.   t := TRttiContext.Create.GetType(TMyClass);  
  143.   { 获取 TMyClass 类的两个方法 }  
  144.   m1 := t.GetMethod('msg'); { procedure }  
  145.   m2 := t.GetMethod('Add'); { function }  
  146.   
  147.   obj := TMyClass.Create(Self); { 调用需要依赖一个已存在的对象 }  
  148.   
  149.   { 调用 msg 过程 }  
  150.   m1.Invoke(obj, ['Delphi 2010']); { 将弹出信息框 }  
  151.   
  152.   { 调用 Add 函数 }  
  153.   r := m2.Invoke(obj, [1, 2]); { 其返回值是个 TValue 类型的结构 }  
  154.   ShowMessage(IntToStr(r.AsInteger)); { 3 }  
  155.   
  156.   obj.Free;  
  157. end;  
  158.   
  159. procedure TForm_main.Button11Click(Sender: TObject);  
  160. var  
  161.   obj: TMyClass;  
  162.   t: TRttiType;  
  163.   p: TRttiProperty;  
  164.   r: TValue;  
  165. begin  
  166.   obj := TMyClass.Create(Self);  
  167.   t := TRttiContext.Create.GetType(TMyClass);  
  168.   
  169.   p := t.GetProperty('Name'); // 继承自TComponent的name  
  170.   
  171.   r := p.GetValue(obj);  
  172.   ShowMessage(r.AsString); { 原来的 }  
  173.   
  174.   p.SetValue(obj, 'NewName');  
  175.   r := p.GetValue(obj);  
  176.   ShowMessage(r.AsString); { NewName }  
  177.   
  178.   obj.Free;  
  179. end;  
  180.   
  181. procedure TForm_main.Button12Click(Sender: TObject);  
  182. var  
  183.   t: TRttiType;  
  184.   p: TRttiProperty;  
  185.   r: TValue;  
  186. begin  
  187.   t := TRttiContext.Create.GetType(TButton);  
  188.   
  189.   p := t.GetProperty('Align');  
  190.   p.SetValue(Button1, TValue.FromOrdinal(TypeInfo(TAlign), Ord(alLeft)));  
  191.   
  192.   r := p.GetValue(Button1);  
  193.   ShowMessage(IntToStr(r.AsOrdinal)); { 3 }  
  194. end;  
  195.   
  196. procedure TForm_main.Button13Click(Sender: TObject);  
  197. var  
  198.   MiArr: TMethodInfoArray;  
  199.   Mi: PMethodInfoHeader;  
  200.   obj: TClass3;  
  201. begin  
  202.   obj := TClass3.Create;  
  203.   MiArr := GetMethods(obj.ClassType);  
  204.   
  205.   Memo1.Clear;  
  206.   for Mi in MiArr do  
  207.     Memo1.Lines.Add(string(Mi.Name));  
  208.   
  209.   obj.Free;  
  210. end;  
  211.   
  212. procedure TForm_main.Button1Click(Sender: TObject);  
  213. var  
  214.   propertyL, EventL: TStringList;  
  215. begin  
  216.   // 属性  
  217.   propertyL := TStringList.Create;  
  218.   // 事件  
  219.   EventL := TStringList.Create;  
  220.   
  221.   Memo1.Clear;  
  222.   Memo2.Clear;  
  223.   
  224.   GetPropertyAndEventList(Self, propertyL, EventL); { 调用函数, 第一个参数是对象名 }  
  225.   Memo1.Lines := propertyL;  
  226.   Memo2.Lines := EventL;  
  227.   
  228.   propertyL.Free;  
  229.   EventL.Free;  
  230. end;  
  231.   
  232. procedure TForm_main.Button2Click(Sender: TObject);  
  233. var  
  234.   ctx: TRttiContext;  
  235.   t: TRttiType;  
  236. begin  
  237.   Memo1.Clear;  
  238.   for t in ctx.GetTypes do  
  239.     Memo1.Lines.Add(t.Name);  
  240. end;  
  241.   
  242. procedure TForm_main.Button3Click(Sender: TObject);  
  243. var  
  244.   ctx: TRttiContext;  
  245.   t: TRttiType;  
  246.   m: TRttiMethod;  
  247. begin  
  248.   Memo1.Clear;  
  249.   t := ctx.GetType(TButton);  
  250.   // for m in t.GetMethods do Memo1.Lines.Add(m.Name);  
  251.   for m in t.GetMethods do  
  252.     Memo1.Lines.Add(m.ToString);  
  253. end;  
  254.   
  255. procedure TForm_main.Button4Click(Sender: TObject);  
  256. var  
  257.   ctx: TRttiContext;  
  258.   t: TRttiType;  
  259.   p: TRttiProperty;  
  260. begin  
  261.   Memo1.Clear;  
  262.   t := ctx.GetType(TButton);  
  263.   // for p in t.GetProperties do Memo1.Lines.Add(p.Name);  
  264.   for p in t.GetProperties do  
  265.     Memo1.Lines.Add(p.ToString);  
  266. end;  
  267.   
  268. procedure TForm_main.Button5Click(Sender: TObject);  
  269. var  
  270.   ctx: TRttiContext;  
  271.   t: TRttiType;  
  272.   f: TRttiField;  
  273. begin  
  274.   Memo1.Clear;  
  275.   t := ctx.GetType(TButton);  
  276.   // for f in t.GetFields do Memo1.Lines.Add(f.Name);  
  277.   for f in t.GetFields do  
  278.     Memo1.Lines.Add(f.ToString);  
  279. end;  
  280.   
  281. // http://my.oschina.net/hermer/blog/320075  
  282. procedure TForm_main.Button6Click(Sender: TObject);  
  283. var  
  284.   ctx: TRttiContext;  
  285.   t: TRttiType;  
  286.   ms: TArray<TRttiMethod>;  
  287.   ps: TArray<TRttiProperty>;  
  288.   fs: TArray<TRttiField>;  
  289. begin  
  290.   Memo1.Clear;  
  291.   t := ctx.GetType(TButton);  
  292.   
  293.   ms := t.GetMethods;  
  294.   ps := t.GetProperties;  
  295.   fs := t.GetFields;  
  296.   
  297.   Memo1.Lines.Add(Format('%s 类共有 %d 个方法', [t.Name, Length(ms)]));  
  298.   Memo1.Lines.Add(Format('%s 类共有 %d 个属性', [t.Name, Length(ps)]));  
  299.   Memo1.Lines.Add(Format('%s 类共有 %d 个字段', [t.Name, Length(fs)]));  
  300. end;  
  301.   
  302. procedure TForm_main.Button7Click(Sender: TObject);  
  303. var  
  304.   t: TRttiRecordType;  
  305.   f: TRttiField;  
  306. begin  
  307.   Memo1.Clear;  
  308.   t := TRttiContext.Create.GetType(TypeInfo(TPoint)).AsRecord;  
  309.   Memo1.Lines.Add(t.QualifiedName);  
  310.   Memo1.Lines.Add(Format('Size: %d', [t.TypeSize]));  
  311.   Memo1.Lines.Add(EmptyStr);  
  312.   
  313.   Memo1.Lines.Add(Format('字段数: %d', [Length(t.GetFields)]));  
  314.   Memo1.Lines.Add(Format('方法数: %d', [Length(t.GetMethods)]));  
  315.   Memo1.Lines.Add(Format('属性数: %d', [Length(t.GetProperties)]));  
  316.   Memo1.Lines.Add(EmptyStr);  
  317.   
  318.   Memo1.Lines.Add('全部字段:');  
  319.   for f in t.GetFields do  
  320.     Memo1.Lines.Add(f.ToString);  
  321. end;  
  322.   
  323. procedure TForm_main.Button8Click(Sender: TObject);  
  324. var  
  325.   t: TRttiRecordType;  
  326.   f: TRttiField;  
  327. begin  
  328.   Memo1.Clear;  
  329.   t := TRttiContext.Create.GetType(TypeInfo(TKeyDog)).AsRecord;  
  330.   Memo1.Lines.Add(t.QualifiedName);  
  331.   Memo1.Lines.Add(Format('Size: %d', [t.TypeSize]));  
  332.   Memo1.Lines.Add(EmptyStr);  
  333.   
  334.   Memo1.Lines.Add(Format('字段数: %d', [Length(t.GetFields)]));  
  335.   Memo1.Lines.Add(Format('方法数: %d', [Length(t.GetMethods)]));  
  336.   Memo1.Lines.Add(Format('属性数: %d', [Length(t.GetProperties)]));  
  337.   Memo1.Lines.Add(EmptyStr);  
  338.   
  339.   Memo1.Lines.Add('全部字段:');  
  340.   for f in t.GetFields do  
  341.     Memo1.Lines.Add(f.ToString);  
  342. end;  
  343.   
  344. procedure TForm_main.Button9Click(Sender: TObject);  
  345. var  
  346.   t: TRttiOrdinalType;  
  347. begin  
  348.   Memo1.Clear;  
  349.   
  350.   // 先从类型名获取类型信息对象  
  351.   t := TRttiContext.Create.GetType(TypeInfo(Byte)) as TRttiOrdinalType;  
  352.   Memo1.Lines.Add(Format('%s - %s', [t.Name, t.QualifiedName]));  
  353.   Memo1.Lines.Add(Format('Size: %d', [t.TypeSize]));  
  354.   Memo1.Lines.Add('QualifiedName: ' + t.QualifiedName);  
  355.   Memo1.Lines.Add(Format('Min,Max: %d , %d', [t.MinValue, t.MaxValue]));  
  356.   Memo1.Lines.Add(EmptyStr); // 空字串  
  357.   
  358.   // 可以用 AsOrdinal 方法代替前面的 as TRttiOrdinalType  
  359.   t := TRttiContext.Create.GetType(TypeInfo(Word)).AsOrdinal;  
  360.   Memo1.Lines.Add(Format('%s: %s', [t.Name, t.QualifiedName]));  
  361.   Memo1.Lines.Add(Format('Size: %d', [t.TypeSize]));  
  362.   Memo1.Lines.Add(Format('Min,Max: %d , %d', [t.MinValue, t.MaxValue]));  
  363.   Memo1.Lines.Add(EmptyStr);  
  364.   
  365.   // 也可以直接强制转换  
  366.   t := TRttiOrdinalType(TRttiContext.Create.GetType(TypeInfo(Integer)));  
  367.   Memo1.Lines.Add(Format('%s: %s', [t.Name, t.QualifiedName]));  
  368.   Memo1.Lines.Add(Format('Size: %d', [t.TypeSize]));  
  369.   Memo1.Lines.Add(Format('Min,Max: %d , %d', [t.MinValue, t.MaxValue]));  
  370.   Memo1.Lines.Add(EmptyStr);  
  371. end;  
  372.   
  373. { TMyClass }  
  374.   
  375. function TMyClass.Add(const a, b: Integer): Integer;  
  376. begin  
  377.   Result := a + b;  
  378. end;  
  379.   
  380. procedure TMyClass.msg(const str: string);  
  381. begin  
  382.   MessageDlg(str, mtInformation, [mbYes], 0);  
  383. end;  
  384.   
  385. { TClass3 }  
  386.   
  387. function TClass3.Fun3: string;  
  388. begin  
  389.   Result := 'Fun3';  
  390. end;  
  391.   
  392. function TClass3.Fun3Private: string;  
  393. begin  
  394.   Result := 'Fun3Private';  
  395. end;  
  396.   
  397. function TClass3.Fun3Protected: string;  
  398. begin  
  399.   Result := 'Fun3Protected';  
  400. end;  
  401.   
  402. function TClass3.Fun3Public: string;  
  403. begin  
  404.   Result := 'Fun3Public';  
  405. end;  
  406.   
  407. function TClass3.Fun3Published: string;  
  408. begin  
  409.   Result := 'Fun3Published';  
  410. end;  
  411.   
  412. end.  
posted @ 2020-05-15 15:55  绿水青山777  阅读(345)  评论(0)  编辑  收藏  举报