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

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

 

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.