码迷，mamicode.com
首页 > Windows程序 > 详细

delphi RTTI 反射技术

时间：2016-03-30 22:24:47      阅读：437      评论：0      收藏：0      [点我收藏+]

标签：

 

[delphi] view plain copy
 
  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.  
 
http://blog.csdn.net/earbao/article/details/46729785

delphi RTTI 反射技术

标签：

原文地址：http://www.cnblogs.com/findumars/p/5338856.html
踩
(0)
赞
(0)
   
举报
评论 一句话评论（0）
登录后才能评论！
分享档案
更多>
2021年07月29日 (22)
2021年07月28日 (40)
2021年07月27日 (32)
2021年07月26日 (79)
2021年07月23日 (29)
2021年07月22日 (30)
2021年07月21日 (42)
2021年07月20日 (16)
2021年07月19日 (90)
2021年07月16日 (35)
周排行
mamicode.com排行更多图片
更多
友情链接
兰亭集智   国之画   百度统计   站长统计   阿里云   chrome插件   新版天听网
关于我们 - 联系我们 - 留言反馈
© 2014 mamicode.com 版权所有  联系我们:gaon5@hotmail.com
迷上了代码！