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

时间：2021-06-17 13:49:01

新建一个单元文件，填写如下代码，然后保存为 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

相关文章