zoukankan      html  css  js  c++  java
  • 简单测试运行时类信息(RTTI),附详细例子

    新建一个单元文件,填写如下代码,然后保存为 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 = 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 = then  
    115.     Exit;  
    116.   
    117.   Strs := TStringList.Create;  
    118.   try  
    119.     for I := to PropertyCount - 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 = then  
    134.     Exit;  
    135.   
    136.   Strs := TStringList.Create;  
    137.   try  
    138.     for I := to PropertyCount - 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 = then  
    156.     Exit;  
    157.   Strs := TStringList.Create;  
    158.   try  
    159.     for I := to PropertyCount - 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

  • 相关阅读:
    Linux(CentOS)下squid代理服务器配置-五岳之巅
    用类实现二叉树
    django--02 模板的使用
    django --01 helloworld样例入门
    微指数爬虫
    celery_01 _celery安装启动
    python多线程几种方法实现
    crontab问题处理
    python可视化--matplotlib
    python网页爬虫--京东家电版块
  • 原文地址:https://www.cnblogs.com/findumars/p/5037450.html
Copyright © 2011-2022 走看看