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

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

标签：

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

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 plain copy

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

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

标签：

原文地址：http://www.cnblogs.com/findumars/p/5037450.html

踩

(0)

评论一句话评论（0）

分享档案

更多>

2021年07月29日 (22)
2021年07月28日 (40)
2021年07月27日 (32)
2021年07月26日 (79)
2021年07月23日 (29)
2021年07月22日 (30)
2021年07月21日 (42)
2021年07月20日 (16)
2021年07月19日 (90)
2021年07月16日 (35)

周排行