delphi RTTI 反射技术

[delphi]view plaincopy

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

http://blog.csdn.net/earbao/article/details/46729785