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

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

[delphi] view plaincopy

unit ClassInfoUnit;

interface

uses

Classes, TypInfo;

type

{ 存放类属性的动态数组 }

PropInfoArray = array of PPropInfo;

{ 用法：首先声明该结构的变量，然后通过 Create 函数或 Target 属性指定要获取 }

{ 信息的类，然后就可以通过 public 中的属性或方法来获取该类的各种信息了 }

TClassInfo = record { use TypInfo }

private

{ 属性：要获取其运行时信息（RTTI）的类 }

FTarget: TClass;

{ 属性：指向存放类信息的指针 }

FTypeInfo: PTypeInfo;

{ 属性：指向存放类数据的指针 }

FDataInfo: PTypeData;

{ 类属性（property）的个数 }

FPropertyCount: Cardinal;

{ 类属性列表（数组） }

FPropertyList: PropInfoArray;

{ 设置 FTarget }

procedure SetTarget(aClass: TClass);

{ 读取 PropertyTypes[Index] }

function GetPropTypes(Index: Integer): PTypeInfo;

public

{ 构造函数，用来设置要获取其信息的对象 }

procedure Create(aObj: TObject); overload;

{ 构造函数，用来设置要获取其信息的类 }

procedure Create(aClass: TClass); overload;

{ 获取类的所有属性和事件 }

function GetAllProperties: string;

{ 获取类的所有属性 }

function GetPropList: string;

{ 获取类的所有事件 }

function GetMethodList: string;

{ 指向类信息的指针 }

property TypeInfo: PTypeInfo read FTypeInfo;

{ 指向类数据的指针 }

property DataInfo: PTypeData read FDataInfo;

{ 属性：要获取其运行时信息（RTTI）的类 }

property Target: TClass read FTarget write SetTarget;

{ 类的所有属性信息列表 }

property PropertyList: PropInfoArray read FPropertyList;

{ 类的所有属性类型列表 }

property PropertyTypes[Index: Integer]: PTypeInfo read GetPropTypes;

{ 类的属性总个数 }

property PropertyCount: Cardinal read FPropertyCount;

end;

implementation

{ 构造函数 }

procedure TClassInfo.Create(aObj: TObject);

begin

if aObj = nil then

Create(nil)

else

Create(aObj.ClassType);

end;

{ 构造函数 }

procedure TClassInfo.Create(aClass: TClass);

begin

Target := aClass;

end;

{ 私有：更改要操作的类 }

procedure TClassInfo.SetTarget(aClass: TClass);

begin

if FTarget = aClass then

Exit;

FTarget := aClass;

if Assigned(FTarget) then

begin

FTypeInfo := aClass.ClassInfo;

FDataInfo := GetTypeData(FTypeInfo);

FPropertyCount := FDataInfo.PropCount;

SetLength(FPropertyList, FPropertyCount);

GetPropInfos(FTypeInfo, PPropList(FPropertyList));

end

else

begin

FTypeInfo := nil;

FDataInfo := nil;

FPropertyCount := 0;

SetLength(FPropertyList,0);

end;

end;

{ 私有：获取属性的类型信息 }

function TClassInfo.GetPropTypes(Index: Integer): PTypeInfo;

begin

Result := nil;

if FPropertyCount = 0 then

Exit;

Result := FPropertyList[Index].PropType^;

end;

{ 获取所有属性和事件列表 }

function TClassInfo.GetAllProperties: string;

var

I: Integer;

Strs: TStringList;

begin

if FPropertyCount = 0 then

Exit;

Strs := TStringList.Create;

try

for I := 0 to PropertyCount - 1 do

Strs.Add(PropertyList[I].Name);

Result := Strs.Text;

finally

Strs.Free;

end;

end;

{ 获取属性列表 }

function TClassInfo.GetPropList: string;

var

I: Integer;

Strs: TStringList;

begin

if FPropertyCount = 0 then

Exit;

Strs := TStringList.Create;

try

for I := 0 to PropertyCount - 1 do

begin

if PropertyTypes[I].Kind <> tkMethod then

Strs.Add(PropertyList[I].Name);

end;

Result := Strs.Text;

finally

Strs.Free;

end;

end;

{ 获取事件列表 }

function TClassInfo.GetMethodList: string;

var

I: Integer;

Strs: TStringList;

begin

if FPropertyCount = 0 then

Exit;

Strs := TStringList.Create;

try

for I := 0 to PropertyCount - 1 do

begin

if PropertyTypes[I].Kind = tkMethod then

Strs.Add(PropertyList[I].Name)

end;

Result := Strs.Text;

finally

Strs.Free;

end;

end;

end.

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

[html] view plaincopy

unit Form1Unit;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls, ExtCtrls;

type

TForm1 = class(TForm)

mmo1: TMemo;

mmo2: TMemo;

btn1: TButton;

btn2: TButton;

procedure btn1Click(Sender: TObject);

procedure btn2Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

{$R *.dfm}

uses

ClassInfoUnit;

{ 获取 TControl 的运行时信息 }

procedure TForm1.btn1Click(Sender: TObject);

var

CI: TClassInfo;

begin

Caption := 'TControl';

CI.Create(TControl);

mmo1.Text := CI.GetPropList;

mmo2.Text := CI.GetMethodList;

end;

{ 获取 TButton 的运行时信息 }

procedure TForm1.btn2Click(Sender: TObject);

var

CI: TClassInfo;

begin

Caption := 'TButton';

CI.Create(TButton);

mmo1.Text := CI.GetPropList;

mmo2.Text := CI.GetMethodList;

end;

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