首页 > 其他 > 详细

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

时间：2015-12-10 23:24:03      阅读：169      评论：0      收藏：0      [点我收藏+]

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

 

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

 

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

 

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

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

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

原文：http://www.cnblogs.com/findumars/p/5037450.html
踩
(0)
赞
(0)
   
举报
评论 一句话评论（0）
分享档案
更多>
2021年09月23日 (328)
2021年09月24日 (313)
2021年09月17日 (191)
2021年09月15日 (369)
2021年09月16日 (411)
2021年09月13日 (439)
2021年09月11日 (398)
2021年09月12日 (393)
2021年09月10日 (160)
2021年09月08日 (222)
最新文章
更多>
教程昨日排行
更多>
友情链接
汇智网   PHP教程   插件网  
关于我们 - 联系我们 - 留言反馈 - 联系我们:wmxa8@hotmail.com
© 2014 bubuko.com 版权所有
打开技术之扣，分享程序人生！