简单测试运行时类信息（RTTI），附详细例子

新建一个单元文件，填写如下代码，然后保存为 ClassInfoUnit.pas，这里定义了一个结构，用来读取指定类的信息。

1. unit ClassInfoUnit;
2. interface
3. uses
4. Classes, TypInfo;
5. type
6. { 存放类属性的动态数组 }
7. PropInfoArray = array of PPropInfo;
8. { 用法：首先声明该结构的变量，然后通过 Create 函数或 Target 属性指定要获取 }
9. { 信息的类，然后就可以通过 public 中的属性或方法来获取该类的各种信息了 }
10. TClassInfo = record      { use TypInfo }
11. private
12. { 属性：要获取其运行时信息（RTTI）的类 }
13. FTarget: TClass;
14. { 属性：指向存放类信息的指针 }
15. FTypeInfo: PTypeInfo;
16. { 属性：指向存放类数据的指针 }
17. FDataInfo: PTypeData;
18. { 类属性（property）的个数 }
19. FPropertyCount: Cardinal;
20. { 类属性列表（数组） }
21. FPropertyList: PropInfoArray;
22. { 设置 FTarget }
23. procedure SetTarget(aClass: TClass);
24. { 读取 PropertyTypes[Index] }
25. function GetPropTypes(Index: Integer): PTypeInfo;
26. public
27. { 构造函数，用来设置要获取其信息的对象 }
28. procedure Create(aObj: TObject); overload;
29. { 构造函数，用来设置要获取其信息的类 }
30. procedure Create(aClass: TClass); overload;
31. { 获取类的所有属性和事件 }
32. function GetAllProperties: string;
33. { 获取类的所有属性 }
34. function GetPropList: string;
35. { 获取类的所有事件 }
36. function GetMethodList: string;
37. { 指向类信息的指针 }
38. property TypeInfo: PTypeInfo read FTypeInfo;
39. { 指向类数据的指针 }
40. property DataInfo: PTypeData read FDataInfo;
41. { 属性：要获取其运行时信息（RTTI）的类 }
42. property Target: TClass read FTarget write SetTarget;
43. { 类的所有属性信息列表 }
44. property PropertyList: PropInfoArray read FPropertyList;
45. { 类的所有属性类型列表 }
46. property PropertyTypes[Index: Integer]: PTypeInfo read GetPropTypes;
47. { 类的属性总个数 }
48. property PropertyCount: Cardinal read FPropertyCount;
49. end;
50. implementation
51. { 构造函数 }
52. procedure TClassInfo.Create(aObj: TObject);
53. begin
54. if aObj = nil then
55. Create(nil)
56. else
57. Create(aObj.ClassType);
58. end;
59. { 构造函数 }
60. procedure TClassInfo.Create(aClass: TClass);
61. begin
62. Target := aClass;
63. end;
64. { 私有：更改要操作的类 }
65. procedure TClassInfo.SetTarget(aClass: TClass);
66. begin
67. if FTarget = aClass then
68. Exit;
69. FTarget := aClass;
70. if Assigned(FTarget) then
71. begin
72. FTypeInfo := aClass.ClassInfo;
73. FDataInfo := GetTypeData(FTypeInfo);
74. FPropertyCount := FDataInfo.PropCount;
75. SetLength(FPropertyList, FPropertyCount);
76. GetPropInfos(FTypeInfo, PPropList(FPropertyList));
77. end
78. else
79. begin
80. FTypeInfo := nil;
81. FDataInfo := nil;
82. FPropertyCount := 0;
83. SetLength(FPropertyList,0);
84. end;
85. end;
86. { 私有：获取属性的类型信息 }
87. function TClassInfo.GetPropTypes(Index: Integer): PTypeInfo;
88. begin
89. Result := nil;
90. if FPropertyCount = 0 then
91. Exit;
92. Result := FPropertyList[Index].PropType^;
93. end;
94. { 获取所有属性和事件列表 }
95. function TClassInfo.GetAllProperties: string;
96. var
97. I: Integer;
98. Strs: TStringList;
99. begin
100. if FPropertyCount = 0 then
101. Exit;
102. Strs := TStringList.Create;
103. try
104. for I := 0 to PropertyCount - 1 do
105. Strs.Add(PropertyList[I].Name);
106. Result := Strs.Text;
107. finally
108. Strs.Free;
109. end;
110. end;
111. { 获取属性列表 }
112. function TClassInfo.GetPropList: string;
113. var
114. I: Integer;
115. Strs: TStringList;
116. begin
117. if FPropertyCount = 0 then
118. Exit;
119. Strs := TStringList.Create;
120. try
121. for I := 0 to PropertyCount - 1 do
122. begin
123. if PropertyTypes[I].Kind <> tkMethod then
124. Strs.Add(PropertyList[I].Name);
125. end;
126. Result := Strs.Text;
127. finally
128. Strs.Free;
129. end;
130. end;
131. { 获取事件列表 }
132. function TClassInfo.GetMethodList: string;
133. var
134. I: Integer;
135. Strs: TStringList;
136. begin
137. if FPropertyCount = 0 then
138. Exit;
139. Strs := TStringList.Create;
140. try
141. for I := 0 to PropertyCount - 1 do
142. begin
143. if PropertyTypes[I].Kind = tkMethod then
144. Strs.Add(PropertyList[I].Name)
145. end;
146. Result := Strs.Text;
147. finally
148. Strs.Free;
149. end;
150. end;
151. end.

然后创建一个空白窗体，窗体上创建两个 TMemo（mmo1、mmo2）和两个 TButton（btn1、btn2），双击 btn1 和 btn2 ，使用如下代码进行测试（测试在程序运行时 TControl 和 TButton 的 published 属性和方法）：

1. unit Form1Unit;
2. interface
3. uses
4. Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
5. Dialogs, StdCtrls, ExtCtrls;
6. type
7. TForm1 = class(TForm)
8. mmo1: TMemo;
9. mmo2: TMemo;
10. btn1: TButton;
11. btn2: TButton;
12. procedure btn1Click(Sender: TObject);
13. procedure btn2Click(Sender: TObject);
14. private
15. { Private declarations }
16. public
17. { Public declarations }
18. end;
19. var
20. Form1: TForm1;
21. implementation
22. {$R *.dfm}
23. uses
24. ClassInfoUnit;
25. { 获取 TControl 的运行时信息 }
26. procedure TForm1.btn1Click(Sender: TObject);
27. var
28. CI: TClassInfo;
29. begin
30. Caption := 'TControl';
31. CI.Create(TControl);
32. mmo1.Text := CI.GetPropList;
33. mmo2.Text := CI.GetMethodList;
34. end;
35. { 获取 TButton 的运行时信息 }
36. procedure TForm1.btn2Click(Sender: TObject);
37. var
38. CI: TClassInfo;
39. begin
40. Caption := 'TButton';
41. CI.Create(TButton);
42. mmo1.Text := CI.GetPropList;
43. mmo2.Text := CI.GetMethodList;
44. end;
45. end.

http://blog.csdn.net/stevenldj/article/details/7166455