• 设为首页
  • 点击收藏
  • 手机版
    手机扫一扫访问
    迪恩网络手机版
  • 关注官方公众号
    微信扫一扫关注
    迪恩网络公众号

Delphi的RTTI机制浅探3(超长,很不错)

原作者: [db:作者] 来自: [db:来源] 收藏 邀请

转自:http://blog.sina.com.cn/s/blog_53d1e9210100uke4.html

 

目录
===============================================================================
⊙ RTTI 简介
⊙ 类(class) 和 VMT 的关系
⊙ 类(class)、类的类(class of class)、类变量(class variable) 的关系
⊙ TObject.ClassType 和 TObject.ClassInfo
⊙ is 和 as 运算符的原理
⊙ TTypeInfo – RTTI 信息的结构
⊙ 获取类(class)的属性(property)信息
⊙ 获取方法(method)的类型信息
⊙ 获取有序类型(ordinal)、集合(set)类型的 RTTI 信息
⊙ 获取其它数据类型的 RTTI 信息
===============================================================================

===============================================================================
⊙ RTTI 简介
===============================================================================

RTTI(Run-Time Type Information)翻译过来的名称是“运行期类型信息”,也就是说可以在运行期获得数据类型或类(class)的信息。这个 RTTI到底有什么用处,我现在也说不清楚。我是在阅读 Delphi 持续机制的代码中发现了很多 RTTI 的运用,只好先把 RTTI学习一遍。下面是我的学习笔记。如果你发现了错误请告诉我。谢谢!

Delphi 的 RTTI 主要分为类(class)的 RTTI和一般数据类型的 RTTI,下面从类(class)开始。

===============================================================================
⊙ 类(class) 和 VMT 的关系
===============================================================================

一个类(class),从编译器的角度来看就是一个指向 VMT 的指针(在后文用VMTptr 表示)。在类的 VMTptr 的负地址方向存储了一些类信息的指针,这些指针的值和指针所指的内容在编译后就确定了。比如VMTptr - 44 的内容是指向类名称(ClassName)的指针。不过一般不使用数值来访问这些类信息,而是通过System.pas 中定义的以 vmt 开头的常量,如 vtmClassName、vmtParent 等来访问。

类的方法有两种:对象级别的方法和类级别的方法。两者的 Self指针意义是不同的。在对象级别的方法中 Self 指向对象地址空间,因此可以用它来访问对象的成员函数;在类级别的方法中 Self指向类的 VMT,因此只能用它来访问 VMT 信息,而不能访问对象的成员字段。

===============================================================================
⊙ 类(class)、类的类(class of class)、类变量(class variable) 的关系
===============================================================================

上面说到类(class) 就是 VMTptr。在 Delphi 中还可以用class of关键字定义类的类,并且可以使用类的类定义类变量。从语法上理解这三者的关键并不难,把类当成普通的数据类型来考虑就可以了。在编译器级别上表现如何呢?

为了简化讨论,我们使用 TObject、TClass 和 TMyClass来代表上面说的三种类型:

type
 TClass = class of TObject;
var
 TMyClass: TClass;
 MyObject: TObject;
begin
 TMyClass := TObject;
 MyObject := TObject.Create;
 MyObject := TClass.Create;
 MyObject := TMyClass.Create;
end;
 
在上面的例子中,三个 TObject 对象都被成功地创建了。编译器的实现是:TObject 是一个 VMTPtr 常量。TClass也是一个 VMTptr 常量,它的值就是 TObject。TMyClass 是一个 VMTptr 变量,它被赋值为TObject。TObject.Create 与 TClass.Create 的汇编代码完全相同。但 TClass不仅缺省代表一个类,而且还(主要)代表了类的类型,可以用它来定义类变量,实现一些类级别的操作。

===============================================================================
⊙ TObject.ClassType 和 TObject.ClassInfo
===============================================================================

function TObject.ClassType:TClass;
begin
 Pointer(Result) := PPointer(Self)^;
end;

TObject.ClassType 是对象级别的方法,Self的值是指向对象内存空间的指针,对象内存空间的前 4 个字节是类的 VMTptr。因此这个函数的返回值就是类的 VMTptr。

class function TObject.ClassInfo:Pointer;
begin
 Result := PPointer(Integer(Self) +vmtTypeInfo)^;
end;

TObject.ClassInfo 使用 class关键字定义,因此是一个类级别的方法。该方法中的 Self 指针就是 VMTptr。所以这个函数的返回值是 VMTptr 负方向的vmtTypeInfo 的内容。

TObject.ClassInfo 返回的 Pointer指针,实际上是指向类的 RTTI 结构的指针。但是不能访问 TObject.ClassInfo指向的内容(TObject.ClassInfo 返回值是 0),因为 Delphi 只在 TPersistent 类及TPersistent 的后继类中产生 RTTI 信息。(从编译器的角度来看,这是在 TPersistent 类的声明之前使用{$M+} 指示字的结果。)

TObject 还定义了一些获取类 RTTI信息的函数,列举在下,就不一一分析了:

 TObject.ClassName:ShortString;   类的名称
 TObject.ClassParent:TClass;     对象的父类
 TObject.InheritsFrom:Boolean;   是否继承自某类
 TObject.InstanceSize:Longint;   对象实例的大小

===============================================================================
⊙ is 和 as 运算符的原理
===============================================================================

我们知道可以在运行期使用 is 关键字判断一个对象是否属于某个类,可以使用as 关键字把某个对象安全地转换为某个类。在编译器的层次上,is 和 as 的操作是由 System.pas中两个函数完成的。

{ System.pas }
function _IsClass(Child: TObject; Parent: TClass): Boolean;
begin
 Result := (Child <>nil) and Child.InheritsFrom(Parent);
end;

_IsClass 很简单,它使用 TObject 的 InheritsForm函数判断该对象是否是从某个类或它的父类中继承下来的。每个类的 VMT 中都有一项 vmtParent 指针,指向该类的父类的VMT。TObject.InheritsFrom 实际上是通过[递归]判断父类 VMT 指针是否等于自己的 VMT指针来判断是否是从该类继承的。

{ System.pas }
class function TObject.InheritsFrom(AClass: TClass): Boolean;
var
 ClassPtr: TClass;
begin
 ClassPtr := Self;
 while (ClassPtr <>nil) and (ClassPtr <> AClass)do
   ClassPtr :=PPointer(Integer(ClassPtr) + vmtParent)^;
 Result := ClassPtr = AClass;
end;

as 操作符实际上是由 System.pas 中的 _AsClass函数完成的。它简单地调用 is 操作符判断对象是否属于某个类,如果不是就触发异常。虽然 _AsClass 返回值为 TObject类型,但编译器会自动把返回的对象改变为 Parent 类,否则返回的对象没有办法使用 TObject 之外的方法和数据。

{ System.pas }
function _AsClass(Child: TObject; Parent: TClass): TObject;
begin
 Result := Child;
 if not (Child is Parent) then
  Error(reInvalidCast);   // losesreturn address
end;

===============================================================================
⊙ TTypeInfo – RTTI 信息的结构
===============================================================================

RTTI 信息的结构定义在 TypInfo.pas 中:

 TTypeInfo =record       // TTypeInfo 是 RTTI 信息的结构
   Kind:TTypeKind;       // RTTI 信息的数据类型
   Name:ShortString;     // 数据类型的名称
  {TypeData:TTypeData}    //RTTI 的内容
 end;

TTypeInfo 就是 RTTI信息的结构。TObject.ClassInfo 返回指向存放 class TTypeInfo 信息的指针。Kind 是枚举类型,它表示RTTI 结构中所包含数据类型。Name 是数据类型的名称。注意,最后一个字段 TypeData被注释掉了,这说明该处的结构内容根据不同的数据类型有所不同。

TTypeKind 枚举定义了可以使用 RTTI信息的数据类型,它几乎包含了所有的 Delphi 数据类型,其中包括 tkClass。

 TTypeKind =(tkUnknown, tkInteger, tkChar, tkEnumeration, tkFloat,
   tkString, tkSet, tkClass,tkMethod, tkWChar, tkLString, tkWString,
   tkVariant, tkArray, tkRecord,tkInterface, tkInt64, tkDynArray);

TTypeData是个巨大的记录类型,在此不再列出,后文会根据需要列出该记录的内容。

===============================================================================
⊙ 获取类(class)的属性(property)信息
===============================================================================

这一段是 RTTI中最复杂的部分,努力把本段吃透,后面的内容都是非常简单的。

下面是一个获取类的属性的例子:

procedure GetClassProperties(AClass:TClass; AStrings: TStrings);
var
 PropCount, I: SmallInt;
 PropList: PPropList;
 PropStr: string;
begin
 PropCount :=GetTypeData(AClass.ClassInfo).PropCount;
 GetPropList(AClass.ClassInfo, PropList);
 for I := 0 to PropCount - 1 do
 begin
   casePropList[I]^.PropType^.Kind of
    tkClass     : PropStr := '[Class] ';
    tkMethod    : PropStr := '[Method]';
    tkSet       : PropStr := '[Set]   ';
    tkEnumeration: PropStr := '[Enum]  ';
   else
    PropStr := '[Field] ';
   end;
   PropStr := PropStr +PropList[I]^.Name;
   PropStr := PropStr + ': ' +PropList[I]^.PropType^.Name;
   AStrings.Add(PropStr);
 end;
 FreeMem(PropList);
end;

你可以在表单上放置一个 TListBox,然后执行以下语句观察执行结果:

 GetClassProperties(TForm1, ListBox1.Items);

该函数先使用 GetTypeData函数获得类的属性数量。GetTypeData 是 TypInfo.pas 中的一个函数,它的功能是返回 TTypeInfo 的TypeData 数据的指针:

{ TypInfo.pas }
function GetTypeData(TypeInfo: PTypeInfo): PTypeData;assembler;

class 的 TTypeData 结构如下:

 TTypeData = packedrecord
   case TTypeKind of
    tkClass: (
      ClassType:TClass;        // 类 (VMTptr)
      ParentInfo:PPTypeInfo;   // 父类的 RTTI 指针
      PropCount:SmallInt;      // 属性数量
      UnitName: ShortStringBase; // 单元的名称
     {PropData:TPropData});    // 属性的详细信息
 end;

其中的 PropData 又是一个大小可变的字段。TPropData的定义如下:

 TPropData = packedrecord
   PropCount:Word;      // 属性数量
   PropList: recordend;  // 占位符,真正的意义在下一行
   {PropList: array[1..PropCount]of TPropInfo}
 end;

每个属性信息在内存中的结构就是 TPropInfo,它的定义如下:

 PPropInfo =^TPropInfo;
 TPropInfo = packed record
   PropType:PPTypeInfo;   // 属性类型信息指针的指针
   GetProc:Pointer;       // 属性的 Get 方法指针
   SetProc:Pointer;       // 属性的 Set 方法指针
   StoredProc:Pointer;    // 属性的 StoredProc 指针
   Index:Integer;         // 属性的 Index 值
   Default:Longint;       // 属性的 Default 值
   NameIndex:SmallInt;    // 属性的名称索引(以 0 开始计数)
   Name:ShortString;      // 属性的名称
 end;

为了方便访问属性信息,TypInfo.pas 中还定义了指向TPropInfo 数组的指针:

 PPropList =^TPropList;
 TPropList = array[0..16379] of PPropInfo;

我们可以使用 GetPropList获得所有属性信息的指针数组,数组用完以后要记得用 FreeMem 把数组的内存清除。

{ TypInfo.pas }
function GetPropList(TypeInfo: PTypeInfo; out PropList: PPropList):Integer;

GetPropList 传入类的 TTypeInfo 指针和TPropList 的指针,它为 PropList 分配一块内存后把该内存填充为指向 TPropInfo的指针数组,最后返回属性的数量。

上面的例子演示了如何获得类的所有属性信息,也可以根据属性的名称单独获得属性信息:

{ TypInfo.pas }
function GetPropInfo(TypeInfo: PTypeInfo; const PropName: string):PPropInfo;

GetPropInfo 根据类的 RTTI指针和属性的名称字符串,返回属性的信息 TPropInfo 的指针。如果没有找到该属性,则返回 nil。GetPropInfo很容易使用,举个例子:

 ShowMessage(GetPropInfo(TForm,'Name')^.PropType^.Name);

这句调用显示了 TForm 类的 Name属性的类型名称:TComponentName。

===============================================================================
⊙ 获取方法(method)的类型信息
===============================================================================

所谓方法就是以 of object关键字声明的函数指针,下面的函数可以显示一个方法的类型信息:

procedure GetMethodTypeInfo(ATypeInfo:PTypeInfo; AStrings: TStrings);
type
 PParamData = ^TParamData;
 TParamData =record      // 函数参数的数据结构
   Flags:TParamFlags;    // 参数传递规则
   ParamName: ShortString; //参数的名称
   TypeName:ShortString;  // 参数的类型名称
 end;
 function GetParamFlagsName(AParamFlags:TParamFlags): string;
 var
   I: Integer;
 begin
   Result := '';
   for I := Integer(pfVar) toInteger(pfOut) do begin
    if I = Integer(pfAddress) then Continue;
    if TParamFlag(I) in AParamFlags then
      Result := Result + ' ' + GetEnumName(TypeInfo(TParamFlag),I);
   end;
 end;
var
 MethodTypeData: PTypeData;
 ParamData: PParamData;
 TypeStr: PShortString;
 I: Integer;
begin
 MethodTypeData := GetTypeData(ATypeInfo);
 AStrings.Add('---------------------------------');
 AStrings.Add('Method Name: ' +ATypeInfo^.Name);
 AStrings.Add('Method Kind: ' +GetEnumName(TypeInfo(TMethodKind),
  Integer(MethodTypeData^.MethodKind)));
 AStrings.Add('Params Count: '+IntToStr(MethodTypeData^.ParamCount));
 AStrings.Add('Params List:');
 ParamData :=PParamData(@MethodTypeData^.ParamList);
 for I := 1 to MethodTypeData^.ParamCount do
 begin
   TypeStr :=Pointer(Integer(@ParamData^.ParamName) +
    Length(ParamData^.ParamName) + 1);
  AStrings.Add(Format('  [%s] %s:%s',[GetParamFlagsName(ParamData^.Flags),
    ParamData^.ParamName, TypeStr^]));
   ParamData :=PParamData(Integer(ParamData) + SizeOf(TParamFlags) +
    Length(ParamData^.ParamName) + Length(TypeStr^) + 2);
 end;
 if MethodTypeData^.MethodKind = mkFunctionthen
   AStrings.Add('Result Value: '+ PShortString(ParamData)^);
end;

作为实验,在表单上放置一个TListBox,然后执行以下代码,观察执行结果:

type
 TMyMethod = function(A: array of Char; var B:TObject): Integer of object;
procedure TForm1.FormCreate(Sender: TObject);
begin
 GetMethodTypeInfo(TypeInfo(TMyMethod),ListBox1.Items);
 GetMethodTypeInfo(TypeInfo(TMouseEvent),ListBox1.Items);
 GetMethodTypeInfo(TypeInfo(TKeyPressEvent),ListBox1.Items);
 GetMethodTypeInfo(TypeInfo(TMouseWheelEvent),ListBox1.Items);
end;

由于获取方法的类型信息比较复杂,我尽量压缩代码也还是有这么长,让我们看看它的实现原理。GetMethodTypeInfo的第一个参数是 PTypeInfo 类型,表示方法的类型信息地址。第二个参数是一个字符串列表,可以使用任何实现 TStrings操作的对象。我们可以使用 System.pas 中的 TypeInfo 函数获得任何类型的 RTTI 信息指针。TypeInfo函数像 SizeOf 一样,是内置于编译器中的。

GetMethodTypeInfo 还用到了 TypInfo.pas 中的GetEnumName 函数。这个函数通过枚举类型的整数值得到枚举类型的名称。

function GetEnumName(TypeInfo:PTypeInfo; Value: Integer): string;

与获取类(class)的属性信息类似,方法的类型信息也在 TTypeData结构中

 TTypeData = packedrecord
   case TTypeKind of
    tkMethod: (
      MethodKind:TMethodKind;           // 方法指针的类型
      ParamCount:Byte;                  // 参数数量
      ParamList: array[0..1023] ofChar   // 参数详细信息,见下行注释
     {ParamList: array[1..ParamCount] of
        record
          Flags:TParamFlags;            // 参数传递规则 
          ParamName:ShortString;        // 参数的名称
          TypeName:ShortString;         // 参数的类型
        end;
      ResultType:ShortString});         // 返回值的名称
 end;

TMethodKind 是方法的类型,定义如下:

 TMethodKind =(mkProcedure, mkFunction, mkConstructor, mkDestructor,
   mkClassProcedure,mkClassFunction,
   { Obsolete }
   mkSafeProcedure,mkSafeFunction);

TParamsFlags 是参数传递的规则,定义如下:

 TParamFlag = (pfVar,pfConst, pfArray, pfAddress, pfReference, pfOut);
 TParamFlags = set of TParamFlag;

由于 ParamName 和 TypeName是变长字符串,不能直接取用该字段的值,而应该使用指针步进的方法,取出参数信息,所以上面的代码显得比较长。

===============================================================================
⊙ 获取有序类型(ordinal)、集合(set)类型的 RTTI 信息
===============================================================================

讨论完了属性和方法的 RTTI 信息之后再来看其它数据类型的 RTTI就简单多了。所有获取 RTTI 的原理都是通过 GetTypeData 函数得到 TTypeData 的指针,再通过TTypeInfo.TypeKind 来解析 TTypeData。任何数据类型的 TTypeInfo 指针可以通过 TypeInfo函数获得。

有序类型的 TTypeData 定义如下:

TTypeData = packed record
 tkInteger, tkChar, tkEnumeration, tkSet, tkWChar:(
   OrdType:TOrdType;        // 有序数值类型
   case TTypeKind of
    case TTypeKind of
      tkInteger, tkChar, tkEnumeration, tkWChar: (
        MinValue: Longint;   //类型的最小值
        MaxValue: Longint;   //类型的最大值
        case TTypeKind of
          tkInteger, tkChar, tkWChar: ();
          tkEnumeration: (
            BaseType:PPTypeInfo;     // 指针的指针,它指向枚举的 PTypeInfo
            NameList:ShortStringBase;    // 枚举的名称字符串(不能直接取用)
            EnumUnitName: ShortStringBase)); // 所在的单元名称(不能直接取用)
        tkSet: (
          CompType:PPTypeInfo));           // 指向集合基类 RTTI 指针的指针
end;

下面是一个获取有序类型和集合类型的 RTTI 信息的函数:

procedure GetOrdTypeInfo(ATypeInfo:PTypeInfo; AStrings: TStrings);
var
 OrdTypeData: PTypeData;
 I: Integer;
begin
 OrdTypeData := GetTypeData(ATypeInfo);
 AStrings.Add('------------------------------------');
 AStrings.Add('Type Name: ' +ATypeInfo^.Name);
 AStrings.Add('Type Kind: ' +GetEnumName(TypeInfo(TTypeKind),
  Integer(ATypeInfo^.Kind)));
 AStrings.Add('Data Type: ' +GetEnumName(TypeInfo(TOrdType),
  Integer(OrdTypeData^.OrdType)));
 if ATypeInfo^.Kind<> tkSet then begin
   AStrings.Add('Min Value: ' +IntToStr(OrdTypeData^.MinValue));
   AStrings.Add('Max Value: ' +IntToStr(OrdTypeData^.MaxValue));
 end;
 if ATypeInfo^.Kind = tkSet then
  GetOrdTypeInfo(OrdTypeData^.CompType^, AStrings);
 if ATypeInfo^.Kind = tkEnumeration then
   for I := OrdTypeData^.MinValueto OrdTypeData^.MaxValue do
    AStrings.Add(Format('  Value %d: %s', [I,GetEnumName(ATypeInfo, I)]));
end;

在表单上放置一个 TListBox,运行以下代码查看结果:

type TMyEnum = (EnumA, EnumB,EnumC);
procedure TForm1.FormCreate(Sender: TObject);
begin
 GetOrdTypeInfo(TypeInfo(Char),ListBox1.Items);
 GetOrdTypeInfo(TypeInfo(Integer),ListBox1.Items);
 GetOrdTypeInfo(TypeInfo(TFormBorderStyle),ListBox1.Items);
 GetOrdTypeInfo(TypeInfo(TBorderIcons),ListBox1.Items);
 GetOrdTypeInfo(TypeInfo(TMyEnum),ListBox1.Items);
end;

(如果枚举元素没有按缺省的 0 基准定义,那么将不能产生 RTTI信息,为什么?)

===============================================================================
⊙ 获取其它数据类型的 RTTI 信息
===============================================================================

上面讨论了几个典型的 RTTI 信息的运行,其它的数据类型的 RTTI信息的获取方法与上面类似。由于这些操作更加简单,就不一一讨论。下面概述其它类型的 RTTI 信息的情况:

LongString、WideString 和 Variant 没有 RTTI信息;
ShortString 只有 MaxLength 信息;
浮点数类型只有 FloatType: TFloatType 信息;
 TFloatType = (ftSingle, ftDouble, ftExtended,ftComp, ftCurr);
Int64 只有最大值和最小值信息(也是 64 位整数表示);
Interface 和动态数组不太熟悉,就不作介绍了。

===============================================================================
⊙ 结束
===============================================================================

 


目 录
===============================================================================
⊙ GetTypeData 函数
⊙ GetPropInfo 函数
⊙ FindPropInfo 函数
⊙ GetPropInfos 函数
⊙ SortPropList 函数
⊙ GetPropList 函数
------------------------------------------------------
⊙ GetObjectPropClass 函数
⊙ PropType / PropIsType 函数
⊙ IsPublishedProp 函数
⊙ IsStoredProp 函数
⊙ FreeAndNilProperties 函数
⊙ SetToString / StringToSet 函数
⊙ GetEnumName / GetEnumValue / GetEnumNameValue 函数
------------------------------------------------------
⊙ GetOrdProp 函数详解
⊙ SetOrdProp 函数
⊙ GetEnumProp / SetEnumProp 函数
⊙ GetSetProp / SetSetProp 函数
⊙ GetObjectProp / SetObjectProp 函数
⊙ GetStrProp / SetStrProp 函数
⊙ GetFloatProp / SetFloatProp 函数
⊙ GetPropValue / SetPropValue 函数
⊙ TPublishableVariantType class
------------------------------------------------------
⊙ RegisterClass / FindClass 系列函数 (Classes.pas)
⊙ IdentToInt / IntToIdent 系列函数 (Classes.pas)
===============================================================================


正 文
===============================================================================
⊙ GetTypeData 函数
===============================================================================
GetTypeData 函数根据 TTypeInfo 指针获得 TTypeData 的地址。

function GetTypeData(TypeInfo:PTypeInfo): PTypeData;
asm
       XOR    EDX,EDX                          ; EDX 清零
       MOV    DL,[EAX].TTypeInfo.Name.Byte[0]  ; 获得 Name 字符串长度
       LEA    EAX,[EAX].TTypeInfo.Name[EDX+1]  ; 获得 TTypeData 的地址
end;

===============================================================================
⊙ GetPropInfo 函数
===============================================================================
GetPropInfo 函数用于获得属性的 RTTI 指针PPropInfo。它有四种重载形式,后面三种重载的实现都是调用第一种形式。AKinds 参数用于限制属性的类型,如果得到的PPropInfo 不属于指定的类型,则返回 nil。

  functionGetPropInfo(TypeInfo: PTypeInfo; const PropName: string):PPropInfo;

  functionGetPropInfo(Instance: TObject; const PropName: string;
    AKinds:TTypeKinds = []): PPropInfo;
  function GetPropInfo(AClass: TClass; constPropName: string;
    AKinds:TTypeKinds = []): PPropInfo;
  function GetPropInfo(TypeInfo: PTypeInfo; constPropName: string;
    AKinds:TTypeKinds): PPropInfo;

===============================================================================
⊙ FindPropInfo 函数
===============================================================================
FindPropInfo 函数根据属性名称获得属性的 RTTI 指针,它只是在 GetPropInfo函数的基础上加上了错误检查功能,如果没有属性 RTTI 信息,则触发 EPropertyError 异常。

function FindPropInfo(Instance:TObject; const PropName: string): PPropInfo;
function FindPropInfo(AClass: TClass; const PropName: string):PPropInfo;

===============================================================================
⊙ GetPropInfos 函数
===============================================================================
GetPropInfos 函数的功能是把一个类(class)所有属性 RTTI 指针 PPropInfo 填充至传入的参数PPropList 数组中。

注意:这个函数不负责分配该数组的内容,使用前必须根据属性的数量分配足够的空间。该数组结束后必须清除分配的内容。

  procedureGetPropInfos(TypeInfo: PTypeInfo; PropList: PPropList);

注:使用 GetPropList 实现相同的功能更方便。

===============================================================================
⊙ SortPropList 函数
===============================================================================
SortPropList 可以对 GetPropInfos 函数填充的属性信息指针数组按属性名称排序。

  procedureSortPropList(PropList: PPropList; PropCount: Integer);

在 VCL 中 SortPropList 只被 GetPropList函数使用。

===============================================================================
⊙ GetPropList 函数
===============================================================================
GetPropList 函数同 GetPropInfos 一样,填充 PPropList 数组。GetPropList 实际上是调用GetPropInfos 进行填充工作,最后返回已填充的属性的数量。

  functionGetPropList(TypeInfo: PTypeInfo; TypeKinds: TTypeKinds;
    PropList:PPropList; SortList: Boolean): Integer;

  functionGetPropList(TypeInfo: PTypeInfo; out PropList: PPropList):Integer;
  function GetPropList(AObject: TObject; outPropList: PPropList): Integer;

注意:GetPropList 的内存分配有点混乱,上面第一个GetPropList 必须自己分配 PPrpList 数组的内存,后面二个 GetPropList 会自动分配 PPropList数组的内存。造成这种情况的原因是:第一个 GetPropList 可以设置 TypeKinds参数限制只返回指定类型的属性,这样就不能直接得到可能返回的属性数量。TypeKinds 参数可以设置为tkAny,表示返回所有数据类型的属性。

第一个 GetPropList 函数可以设置 SortList参数对属性名称进行排序。它实际上是调用第二个 GetPropList 并调用 SortPropList 函数执行排序。

注意:PPropList 不再使用的时候,要记得使用 FreeMem函数清除数组内存(根据返回值是否大于1)。

===============================================================================
⊙ GetObjectPropClass 函数
===============================================================================
GetObjectPropClass 函数用于返回对象类型的属性所属的类(class)。

  functionGetObjectPropClass(Instance: TObject; PropInfo: PPropInfo):TClass;
  function GetObjectPropClass(Instance: TObject;const PropName: string): TClass;
  function GetObjectPropClass(PropInfo:PPropInfo): TClass;

这个函数被 SetObjectProp 函数使用,用于参数检验。

===============================================================================
⊙ PropType / PropIsType 函数
===============================================================================
PropType 函数用于获得属性的数据类型。

  functionPropType(Instance: TObject; const PropName: string):TTypeKind;
  function PropType(AClass: TClass; constPropName: string): TTypeKind;

PropIsType 判断属性是否属于某种数据类型。它调用 PropType实现功能。

  functionPropIsType(Instance: TObject; const PropName: string;
    TypeKind:TTypeKind): Boolean;
  function PropIsType(AClass: TClass; constPropName: string;
    TypeKind:TTypeKind): Boolean;

===============================================================================
⊙ IsPublishedProp 函数
===============================================================================
IsPublishedProp 函数用于判断属性是否是 published 属性,它通过检查该属性 RTTI 指针是否等于 nil来实现功能。

  functionIsPublishedProp(Instance: TObject; const PropName: string):Boolean;
  function IsPublishedProp(AClass: TClass; constPropName: string): Boolean;

IsPublishedProp 函数没有被 VCL 使用。

===============================================================================
⊙ IsStoredProp 函数
===============================================================================
IsStoredProp 函数使用属性信息中的 TPropInfo.StoredProp 函数指针来调用属性定义时用 stored关键字定义的函数的结果。

这个函数被用于 Delphi持续机制,TWriter.WriteProperties 方法调用 IsStoredProp判断是否需要把该属性的值写入流中。

  functionIsStoredProp(Instance: TObject; PropInfo: PPropInfo):Boolean;
  function IsStoredProp(Instance: TObject; constPropName: string): Boolean;

===============================================================================
⊙ FreeAndNilProperties 函数
===============================================================================
FreeAndNilProperties 函数用于清除一个对象的所有 published 的对象类型的属性的对象。这个函数调用GetObjectProp 执行获得对象属性的对象句柄,并调用对象的 Free 方法清除这个对象,然后调用 SetObjectProp设置该属性为 nil。

  procedureFreeAndNilProperties(AObject: TObject);

我不知道这个函数能用在哪里,至少 VCL 中没有使用这个函数。

===============================================================================
⊙ SetToString / StringToSet 函数
===============================================================================
SetToString 和 StringToSet 是两个 RTTI辅助函数,它们把集合值转换为字符串,或者把字符串转换为集合值。

  functionSetToString(PropInfo: PPropInfo; Value: Integer;
    Brackets:Boolean = False): string;

  functionStringToSet(PropInfo: PPropInfo; const Value: string): Integer;

注意:这里的集合值最多只能包含 32 个元素(4 bytes),这是集合RTTI 的限制。

===============================================================================
⊙ GetEnumName / GetEnumValue / GetEnumNameValue 函数
===============================================================================
GetEnumName 函数根据枚举整数值返回枚举字符串。它可以返回以下三种枚举名称:

  Integer:直接返回IntToStr(Integer)
  Boolean:返回 True/False
  Enum   :返回TTypeData^.NameList 中存储的枚举名称

  functionGetEnumName(TypeInfo: PTypeInfo; Value: Integer): string;

GetEnumValue 函数根据枚举字符串返回枚举整数值。它与GetEnumName 类似,可以返回三种枚举的整数值,但对于 Enum 类型,它调用了 GetEnumNameValue函数。

  functionGetEnumValue(TypeInfo: PTypeInfo; const Name: string): Integer;

GetEnumNameValue 函数与 GetEnumValue函数功能差不多,但它是个汇编函数,只能返回纯枚举类型的值。其工作原理也是匹配 TTypeData^.NameList 值。

  functionGetEnumNameValue(TypeInfo: PTypeInfo; const Name: string):Integer;

注意:GetEnumNameValue 隐藏在 Implementation段,不能直接使用,它是为 GetEnumValue 函数服务的。

===============================================================================
⊙ GetOrdProp 函数详解
===============================================================================
GetOrdProp 是 Delphi RTTI 中使用频繁的函数。GetOrdProp 根据对象句柄和对象属性的 TPropInfo指针获得对象的属性值。它的返回值是 Longint,需要强制转换成相应的属性类型才能使用。

  functionGetOrdProp(Instance: TObject; PropInfo: PPropInfo): Longint;

GetOrdProp 调用 TPropInfo.GetProc函数指针得到属性的返回值。它的工作过程是:

  如果该属性的类型是 class类型,那么返回值是 4 个字节(对象句柄)。
    否则通过TTypeData.OrdType 得到返回值的类型,存储在 BL 中。
    { TOrdType =(otSByte, otUByte, otSWord, otUWord, otSLong, otULong); }
  检查 TPropInfo.GetProc 的第一个字节(注意是 GetProc指针的第一个字节):
    如果GetProc[0] = $FF,说明 GetProc 是 field offset;
    如果GetProc[0] = $FE,说明 GetProc 是 virtual method offset;
    如果GetProc[0] < $FE,说明 GetProc 是 static method;
  然后根据不同的 GetProc 类型解析后,调用 GetProc。
  根据 BL 中存储的类型符号信息修正返回值(EAX)的符号信息。
  根据 BL 中存储的类型的大小裁剪返回值 EAX 为 EAX/AX/AL。
  EAX(AX/AL) 即是返回的属性值。

GetOrdProp 的汇编代码及注释如下:

function GetOrdProp(Instance: TObject;PropInfo: PPropInfo): Longint;
asm
       PUSH   EBX
       PUSH   EDI
       MOV    EDI,[EDX].TPropInfo.PropType       ; EDI <- PPTypeInfo
       MOV    EDI,[EDI]                          ; EDI <- PTypeInfo
       MOV    BL,otSLong                         ; BL  <- otSLong
       CMP    [EDI].TTypeInfo.Kind,tkClass       ; if Prop is Class
       JE     @@isClass                          ; jmp @@isClass
       XOR    ECX,ECX                            ; ECX <- 0
       MOV    CL,[EDI].TTypeInfo.Name.Byte[0]    ; CL  <- Name StrLength
       MOV    BL,[EDI].TTypeInfo.Name[ECX+1].TTypeData.OrdType
                                                   ; BL  <- Prop OrdType
@@isClass:
       MOV    ECX,[EDX].TPropInfo.GetProc        ; ECX <- GetProc Addr
       CMP    [EDX].TPropInfo.GetProc.Byte[3],$FE ; cmp HiByte(GetProc),$FE
       MOV    EDX,[EDX].TPropInfo.Index          ; EDX <- Prop Index
       JB     @@isStaticMethod                   ; if below $FE
       JA     @@isField                          ; if is $FF

       {      the GetProc is a virtual method}   ; if is $FE
       MOVSX  ECX,CX                 { sign extend slot offs }
       ADD    ECX,[EAX]              { vmt   +slotoffs     }
       CALL    dwordptr[ECX]        { callvmt[slot]       }
       JMP    @@final
@@isStaticMethod:
       CALL   ECX                 ; call GetProc directly
       JMP    @@final
@@isField:
       AND    ECX,$00FFFFFF       ; clear HiByte(GetProc)
       ADD    ECX,EAX             ; ECX <- Field Addr
       MOV    AL,[ECX]            ; AL  <- Field Addr[0]
       CMP    BL,otSWord          ; if OrdType < otSWord
       JB     @@final             ; Exit
       MOV    AX,[ECX]            ; else AX <- Field[0..1]
       CMP    BL,otSLong          ; if OrdType < otSLong
       JB     @@final             ; Exit
       MOV    EAX,[ECX]           ; else EAX <- Field[0..3]
@@final:
       CMP    BL,otSLong          ; if OrdType >= otSLong
       JAE    @@exit              ; Exit
       CMP    BL,otSWord          ; if OrdType >= otSWord
       JAE    @@word              ; jmp @@word
       CMP    BL,otSByte          ; if OrdType = otSByte
       MOVSX  EAX,AL              ; AL <- Sign(EAX)
       JE     @@exit              ; Exit
       AND    EAX,$FF             ; clear HiWord(EAX)
       JMP    @@exit              ; Exit
@@word:
       MOVSX  EAX,AX              ; AX <= Sign(EAX)
       JE     @@exit              ; if OrdType = otSWord then Exit
       AND    EAX,$FFFF           ; clear HiWord(EAX)
@@exit:
       POP    EDI
       POP    EBX
end;

TypInfo.pas 中重载了 GetOrdProp 函数,将PPropInfo 参数替换为 PropName,方便程序员调用,它其实也是调用了上面介绍的 GetOrdProp 函数。

function GetOrdProp(Instance: TObject;const PropName: string): Longint;
begin
  Result := GetOrdProp(Instance,FindPropInfo(Instance, PropName));
end;

下面是使用 GetOrdProp 的例子:

  Self.Width :=Self.Width - GetOrdProp(Self, 'Height');

上面的语句相当于:

  Self.Width :=Self.Width - Self.Height;

* 后文介绍的 Get___Prop系列函数或者调用本函数,或者它的实现方法与本函数类似。

===============================================================================
⊙ SetOrdProp 函数
===============================================================================
SetOrdProp 函数是 GetOrdProp 的逆过程,它调用 TPropInfo.SetProc函数指针设置对象的属性值。SetProc 指针的第一个字节的意义同 GetProc 一样,也是表示该 SetProc是字段偏移、虚方法偏移和静态方法。

  procedureSetOrdProp(Instance: TObject; PropInfo: PPropInfo; Value:Longint);

SetOrdProc 也根据属性名称重载了:

  procedureSetOrdProp(Instance: TObject; const PropName: string; Value:Longint);

由于 SetOrdProp 的汇编代码与 GetOrdProp的几乎一样,在此就不再列出。作为练习,试用一下:

  SetOrdProp(Self,'Height', Self.Height + 10);

该语句的功能相当于:

  Self.Height :=Self.Height + 10;

* 后文介绍的 Set___Prop系列函数或者调用本函数,或者它的实现方法与本函数类似。

===============================================================================
⊙ GetEnumProp / SetEnumProp 函数
===============================================================================
GetEnumProp 函数获取枚举类型属性的枚举字符串,它调用 GetEnumName 转换 GetOrdProp的返回值。

  functionGetEnumProp(Instance: TObject; PropInfo: PPropInfo): string;
  function GetEnumProp(Instance: TObject; constPropName: string): string;

SetEnumProp 函数使用枚举字符串设置枚举类型属性值,它调用GetEnumValue 转换枚举字符串后再调用 SetOrdProp 设置属性值。

  procedureSetEnumProp(Instance: TObject; PropInfo: PPropInfo;
    const Value:string);
  procedure SetEnumProp(Instance: TObject; constPropName: string;
    const Value:string);

===============================================================================
⊙ GetSetProp / SetSetProp 函数
===============================================================================
GetSetProp 函数用于获取集合类型属性的字符串值,它也是调用 GetOrdProp 获得属性值,然后调用SetToString 函数把数值转换成字符串。

注意:GetOrdProp 函数返回值是Integer,那么它是如何表示可以存储 256 个元素的集合类型呢?答案是:如果是 published集合属性,那么该集合最大只能是 4 个字节,也就是最多只能存储 32 个元素。

  functionGetSetProp(Instance: TObject; PropInfo: PPropInfo;
    Brackets:Boolean): string;
  function GetSetProp(Instance: TObject; constPropName: string;
    Brackets:Boolean = False): string;

SetSetProp 函数用于通过字符串设置集合类型属性的值。它先调用StringToSet 函数把字符串转换为整数值,然后使用 SetOrdProp 函数设置属性值。

  procedureSetSetProp(Instance: TObject; PropInfo: PPropInfo;
    const Value:string);
  procedure SetSetProp(Instance: TObject; constPropName: string;
    const Value:string);

试验:  SetSetProp(Self,'BorderIcons', '[biSystemMenu]');


===============================================================================
⊙ GetObjectProp / SetObjectProp 函数
===============================================================================
对象实际上是指针,也就是整数值,所以 GetObjectProp 直接调用 GetOrdProp 就可以了。

MinClass 参数指定得到的 Object 必须属于某个 class,如果不是则返回 nil 。

  functionGetObjectProp(Instance: TObject; PropInfo: PPropInfo;
    MinClass:TClass = nil): TObject;
  function GetObjectProp(Instance: TObject; constPropName: string;
    MinClass:TClass = nil): TObject;

SetObjectProp 用于设置属性的对象句柄。ValidateClass参数表示是否需要检查传入的对象类型与属性信息的类信息是否兼容。

  procedureSetObjectProp(Instance: TObject; PropInfo: PPropInfo;
    Value:TObject; ValidateClass: Boolean = True);
  procedure SetObjectProp(Instance: TObject; constPropName: string;
    Value:TObject);

例子:
  var
    MyFont:TFont;
  begin
    MyFont :=TFont.Create;
   MyFont.Height :=  20;
   SetObjectProp(Self, 'Font', MyFont);
  end;

===============================================================================
⊙ GetStrProp / SetStrProp 函数
===============================================================================
GetStrProp 函数用于获得字符串类型的属性值。

  functionGetStrProp(Instance: TObject; PropInfo: PPropInfo): string;
  function GetStrProp(Instance: TObject; constPropName: string): string;

由于 Delphi 支持三种类型的字符串,GetStrProp根据字符串的类型,分别调用三个获得字符串属性值的函数:

  casePropInfo^.PropType^.Kind of
    tkString:GetShortStrPropAsLongStr(Instance, PropInfo, Result);
    tkLString:GetLongStrProp(Instance, PropInfo, Result);
    tkWString:GetWideStrPropAsLongStr(Instance, PropInfo, Result);
  end;

其中 GetShortStrPropAsLongStr 又调用了GetShortStrProp;GetWideStrPropAsLongStr 又调用了GetWideStrProp,进行字符串间的类型转换。

SetStrProp 函数用于设置字符串类型的属性值。它的实现方法与GetStrProp 类似。

  procedureSetStrProp(Instance: TObject; PropInfo: PPropInfo;
    const Value:string);
  procedure SetStrProp(Instance: TObject; constPropName: string;
    const Value:string);

===============================================================================
⊙ GetFloatProp / SetFloatProp 函数
===============================================================================
GetFloatProp 用于获得浮点型属性值。它将 Single(4 bytes)、Double(8 bytes)、Comp(8bytes)、Currency(8 bytes) 类型的浮点数属性转换为 Extented(10 bytes) 类型返回。

  functionGetFloatProp(Instance: TObject; PropInfo: PPropInfo):Extended;
  function GetFloatProp(Instance: TObject; constPropName: string): Extended;

SetFloatProp 用于设置浮点型属性值。它的实现方法与GetFloatProp 类似。

  procedureSetFloatProp(Instance: TObject; PropInfo: PPropInfo;
    const Value:Extended);
  procedure SetFloatProp(Instance: TObject; constPropName: string;
    const Value:Extended);

===============================================================================
⊙ GetVariantProp / SetVariantProp
===============================================================================
GetVariantProp 函数用于获得 Variant 类型的属性值。

  functionGetVariantProp(Instance: TObject; PropInfo: PPropInfo):Variant;
  function GetVariantProp(Instance: TObject; constPropName: string): Variant;

SetVariantProp 函数用于设置 Variant类型的属性值。

  procedureSetVariantProp(Instance: TObject; PropInfo: PPropInfo;
    const Value:Variant);
  procedure SetVariantProp(Instance: TObject;const PropName: string;
    const Value:Variant);

===============================================================================
⊙ GetMethodProp / SetMethodProp
===============================================================================
GetMethodProp 函数用于获得 Method 类型的属性值。

  functionGetMethodProp(Instance: TObject; PropInfo: PPropInfo):TMethod; 
  function GetMethodProp(Instance: TObject; constPropName: string): TMethod;

SetMethodProp 函数用于设置 Method 类型的属性值。

  procedureSetMethodProp(Instance: TObject; const PropName: string;
    const Value:TMethod);
  procedure SetMethodProp(Instance: TObject;PropInfo: PPropInfo;
    const Value:TMethod);

===============================================================================
⊙ GetInt64Prop / SetInt64Prop
===============================================================================
SetInt64Prop 函数用于设置 Int64 类型的属性值。不同于一般整数用 EAX 返回,Int64 类型的返回值由EDX:EAX 返回,所以有必要单独定义 Int64 的获取和设置方法。

  functionGetInt64Prop(Instance: TObject; PropInfo: PPropInfo): Int64;
  function GetInt64Prop(Instance: TObject; constPropName: string): Int64;

SetInt64Prop 函数用于设置 Int64 类型的属性值。

  procedureSetInt64Prop(Instance: TObject; PropInfo: PPropInfo;
    const Value:Int64);
  procedure SetInt64Prop(Instance: TObject; constPropName: string;
    const Value:Int64);

===============================================================================
⊙ GetInterfaceProp / SetInterfaceProp 函数
===============================================================================
GetInterfaceProp 函数用于获得 Interface 类型的属性值。

  functionGetInterfaceProp(Instance: TObject; PropInfo: PPropInfo):IInterface;
  function GetInterfaceProp(Instance: TObject;const PropName: string): IInterface;

SetInterfaceProp 函数用于设置 Interface类型的属性值。

  procedureSetInterfaceProp(Instance: TObject; PropInfo: PPropInfo;
    const Value:IInterface); 
  procedure SetInterfaceProp(Instance: TObject;const PropName: string;
    const Value:IInterface);

* 不太熟悉 Interface,以后再看实现过程。

===============================================================================
⊙ GetPropValue / SetPropValue 函数
===============================================================================
GetPropValue 函数用于获得任何类型的属性值,它返回 Variant 类型。

注意,这个函数没有重载函数,只能使用属性名称字符串为参数。

GetPropValue 先调用 GetPropInfo函数获得属性的类型,然后根据属性的数据类型选择调用以上介绍的GetOrdProp、GetEnumProp、GetSetProp、GetStrProp 等函数实现具体的功能。

GetPropValue 的参数 PreferStrings 如果设置为True,那么对于枚举、集合类型,将返回字符串值,否则返回整数值。GetPropValue还可以返回动态数组类型的属性值。(目前对动态数组不太熟悉,先记下来。)

  functionGetPropValue(Instance: TObject; const PropName: string;
   PreferStrings: Boolean): Variant;

SetPropValue函数用于设置任何类型的属性值。SetPropValue 的实现与 GetPropValue 类似。并且 SetPropValue内部分析 Value 参数是否是字符串来设置枚举和集合类型的属性,所以不需要 PreferStrings参数。SetPropValue 也可以设置动态数组属性,它使用了 SetOrdProp函数实现这一功能,看来动态数组在内存中的表现是一个指针。

  procedureSetPropValue(Instance: TObject; const PropName: string;
    const Value:Variant);

===============================================================================
⊙ TPublishableVariantType class
===============================================================================
在 TypInfo.pas 的代码注释中说 TPublishableVariantType 是用来代替TCustomVariantType 以便更容易在 RTTI 中使用自定义的 Variant 类型。

* 现在对这两个类型都不太了解,先记在这里以后再学。

===============================================================================
⊙ RegisterClass / FindClass 系列函数 (Classes.pas)
===============================================================================
Delphi 提供了一种机制,可以使用类(class)的名称获得类(class VMTptr)。缺省情况下这些类必须是从TPersistent 类继承下来的。使用这项功能之前必须在先把类信息注册到全局对象 RegGroup 中。

RegisterClass 函数用于注册类信息至 RegGroup中,注意该函数名称和 Win32 API 中注册窗口类的函数同名。如果类已经被注册过了,RegisterClass将直接返回。如果有一个不同的类以相同的名称注册了,RegisterClass 将触发异常(EFilerError)。

  procedureRegisterClass(AClass: TPersistentClass);

RegisterClasses 函数可以方便地注册一批类:

  procedureRegisterClasses(AClasses: array of TPersistentClass);

RegisterClassAlias函数可以为类以其它的名称注册,以避免名称冲突。

  procedureRegisterClassAlias(AClass: TPersistentClass; const Alias:string);

GetClass 函数根据类名称字符串获得类(class),如果没找到,将返回nil:

  functionGetClass(const AClassName: string): TPersistentClass;

FindClass 函数包装了GetClass,不同的是如果没找到该类,则触发异常(EClassNotFound):

  functionFindClass(const ClassName: string): TPersistentClass;

UnRegisterClass 系列函数执行 RegisterClass相反的工作:

  procedureUnRegisterClass(AClass: TPersistentClass);
  procedure UnRegisterClasses(AClasses: array ofTPersistentClass);
  procedure UnRegisterModuleClasses(Module:HMODULE);

缺省的 RegGroup 用于组织从 TPersistent继承下来的类,下面五个函数可以设置自己的 RegGroup:

  procedureStartClassGroup(AClass: TPersistentClass);
  procedure GroupDescendentsWith(AClass,AClassGroup: TPersistentClass);
  function ActivateClassGroup(AClass:TPersistentClass): TPersistentClass;
  function ClassGroupOf(AClass: TPersistentClass):TPersistentClass; overload;
  function ClassGroupOf(Instance: TPersistent):TPersistentClass; overload;

===============================================================================
⊙ IdentToInt / IntToIdent 系列函数 (Classes.pas)
===============================================================================
IdentToInt 和 IntToIdent函数用于实现字符串值和数值之间的转换。它的原理很简单,就是通过数组一一映射查找。不过一般不用直接使用这两个函数,而是使用 Delphi中已经包装好的函数。这些函数的返回值都是 Boolean,表示转换是否成功。

  functionIdentToInt(const Ident: string; var Int: Longint;
    const Map:array of TIdentMapEntry): Boolean;
  function IntToIdent(Int: Longint; var Ident:string;
    const Map:array of TIdentMapEntry): Boolean;

  { Graphics.pas}
  function CharsetToIdent(Charset: Longint; varIdent: string): Boolean;
  function IdentToCharset(const Ident: string; varCharset: Longint): Boolean;

  functionColorToIdent(Color: Longint; var Ident: string): Boolean;
  function IdentToColor(const Ident: string; varColor: Longint): Boolean;

  { Controls.pas}
  function CursorToIdent(Cursor: Longint; varIdent: string): Boolean;
  function IdentToCursor(const Ident: string; varCursor: Longint): Boolean;

例子:
  var
    NewColor:Integer;
  begin
    ifIdentToColor('clWindow', NewColor) then
     Self.Color := NewColor;
  end;
  
===============================================================================
⊙ 结束
===============================================================================

 


通过 Rtti 单元的 TRttiContext(是个 record),可以方便地获取类的方法、属性、字段的列表.


unit Unit1; 
 
interface 
 
uses 
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 
 Dialogs, StdCtrls; 
 
type 
 TForm1 = class(TForm) 
  Memo1: TMemo; 
  Button1: TButton; 
  Button2: TButton; 
  Button3: TButton; 
  Button4: TButton; 
  Button5: TButton; 
  procedure Button1Click(Sender: TObject); 
  procedure Button2Click(Sender: TObject); 
  procedure Button3Click(Sender: TObject); 
  procedure Button4Click(Sender: TObject); 
  procedure Button5Click(Sender: TObject); 
 end; 
 
var 
 Form1: TForm1; 
 
implementation 
 
{$R *.dfm}  
 
uses Rtti; 
 
//TRttiContext.GetTypes 
procedure TForm1.Button1Click(Sender: TObject); 
var 
 ctx: TRttiContext; 
 t: TRttiType; 
begin 
 Memo1.Clear; 
 for t in ctx.GetTypes do Memo1.Lines.Add(t.Name); 
end; 
 
//获取 TButton 类的方法 
procedure TForm1.Button2Click(Sender: TObject); 
var 
 ctx: TRttiContext; 
 t: TRttiType; 
 m: TRttiMethod; 
begin 
 Memo1.Clear; 
 t := ctx.GetType(TButton); 
 //for m in t.GetMethods do Memo1.Lines.Add(m.Name); 
 for m in t.GetMethods do Memo1.Lines.Add(m.ToString); 
end; 
 
//获取 TButton 类的属性 
procedure TForm1.Button3Click(Sender: TObject); 
var 
 ctx: TRttiContext; 
 t: TRttiType; 
 p: TRttiProperty; 
begin 
 Memo1.Clear; 
 t := ctx.GetType(TButton); 
 //for p in t.GetProperties do Memo1.Lines.Add(p.Name); 
 for p in t.GetProperties do Memo1.Lines.Add(p.ToString); 
end; 
 
//获取 TButton 类的字段 
procedure TForm1.Button4Click(Sender: TObject); 
var 
 ctx: TRttiContext; 
 t: TRttiType; 
 f: TRttiField; 
begin 
 Memo1.Clear; 
 t := ctx.GetType(TButton); 
 //for f in t.GetFields do Memo1.Lines.Add(f.Name); 
 for f in t.GetFields do Memo1.Lines.Add(f.ToString); 
end; 
 
//获取获取 TButton 类的方法集合、属性集合、字段集合 
procedure TForm1.Button5Click(Sender: TObject); 
var 
 ctx: TRttiContext; 
 t: TRttiType; 
 ms: TArray<TRttiMethod>; 
 ps: TArray<TRttiProperty>; 
 fs: TArray<TRttiField>; 
begin 
 Memo1.Clear; 
 t := ctx.GetType(TButton); 
 
 ms := t.GetMethods; 
 ps := t.GetProperties; 
 fs := t.GetFields; 
 
 Memo1.Lines.Add(Format('%s 类共有 %d 个方法', [t.Name, Length(ms)])); 
 Memo1.Lines.Add(Format('%s 类共有 %d 个属性', [t.Name, Length(ps)])); 
 Memo1.Lines.Add(Format('%s 类共有 %d 个字段', [t.Name, Length(fs)])); 
end; 
 
end. 

 


通过 Rtti 还能够调用一个类的方法, 也能读取或设置其属性值.


unit Unit1; 
 
interface 
 
uses 
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 
 Dialogs, StdCtrls; 
 
type 
 TForm1 = class(TForm) 
  Button1: TButton; 
  Button2: TButton; 
  procedure Button1Click(Sender: TObject); 
  procedure Button2Click(Sender: TObject); 
 end; 
 
 {自定义的类}  
 TMyClass = class(TComponent) 
 public 
  procedure msg(const str: string); 
  function Add(const a,b: Integer): Integer; 
 end; 
 
var 
 Form1: TForm1; 
 
implementation 
 
{$R *.dfm} 
 
uses Rtti; 
 
{ MyClass 类的实现 -----------------------------------------------------------} 
 
procedure TMyClass.msg(const str: string); 
begin 
 MessageDlg(str, mtInformation, [mbYes], 0); 
end; 
 
function TMyClass.Add(const a, b: Integer): Integer; 
begin 
 Result := a + b; 
end; 
 
//通过 Rtti 的手段使用 TMyClass 类的方法 -------------------------------------- 
procedure TForm1.Button1Click(Sender: TObject); 
var 
 obj: TMyClass; 
 t: TRttiType; 
 m1,m2: TRttiMethod; 
 r: TValue; //TRttiMethod.Invoke 的返回类型 
begin 
 t := TRttiContext.Create.GetType(TMyClass); 
 
 {获取 TMyClass 类的两个方法} 
 m1 := t.GetMethod('msg'); {procedure} 
 m2 := t.GetMethod('Add'); {function} 
 
 obj := TMyClass.Create(Self); {调用需要依赖一个已存在的对象} 
 
 {调用 msg 过程} 
 m1.Invoke(obj, ['Delphi 2010']); {将弹出信息框} 
 
 {调用 Add 函数} 
 r := m2.Invoke(obj, [1, 2]); {其返回值是个 TValue 类型的结构} 
 ShowMessage(IntToStr(r.AsInteger)); {3} 
 
 obj.Free; 
end; 
 
//通过 Rtti 的手段修改并获取 TMyClass 类的属性 -------------------------------- 
procedure TForm1.Button2Click(Sender: TObject); 
var 
 obj: TMyClass; 
 t: TRttiType; 
 p: TRttiProperty; 
 r: TValue; 
begin 
 obj := TMyClass.Create(Self); 
 
 t := TRttiContext.Create.GetType(TMyClass); 
 
 p := t.GetProperty('Name'); 
 p.SetValue(obj, 'NewName'); 
 
 r := p.GetValue(obj); 
 ShowMessage(r.AsString); {NewName} 
 
 obj.Free; 
end; 
 
end. 

 


任何数据类型中 Rtti 中都有对应的获取信息的类, 有序类型对应的是TRttiOrdinalType.


unit Unit1; 
 
interface 
 
uses 
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 
 Dialogs, StdCtrls; 
 
type 
 TForm1 = class(TForm) 
  Memo1: TMemo; 
  Button1: TButton; 
  procedure Button1Click(Sender: TObject); 
 end; 
 
var 
 Form1: TForm1; 
 
implementation 
 
{$R *.dfm}  
 
uses Rtti; 
 
procedure TForm1.Button1Click(Sender: TObject); 
var 
 t: TRttiOrdinalType; 
begin 
 Memo1.Clear; 
 
 //先从类型名获取类型信息对象 
 t := TRttiContext.Create.GetType(TypeInfo(Byte)) as TRttiOrdinalType; 
 Memo1.Lines.Add(Format('%s - %s', [t.Name, t.QualifiedName])); 
 Memo1.Lines.Add(Format('Size: %d', [t.TypeSize])); 
 Memo1.Lines.Add('QualifiedName: ' + t.QualifiedName); 
 Memo1.Lines.Add(Format('Min,Max: %d , %d', [t.MinValue, t.MaxValue])); 
 Memo1.Lines.Add(EmptyStr); //空字串 
 
 //可以用 AsOrdinal 方法代替前面的 as TRttiOrdinalType 
 t := TRttiContext.Create.GetType(TypeInfo(Word)).AsOrdinal; 
 Memo1.Lines.Add(Format('%s: %s', [t.Name, t.QualifiedName])); 
 Memo1.Lines.Add(Format('Size: %d', [t.TypeSize])); 
 Memo1.Lines.Add(Format('Min,Max: %d , %d', [t.MinValue, t.MaxValue])); 
 Memo1.Lines.Add(EmptyStr); 
 
 //也可以直接强制转换 
 t := TRttiOrdinalType(TRttiContext.Create.GetType(TypeInfo(Integer))); 
 Memo1.Lines.Add(Format('%s: %s', [t.Name, t.QualifiedName])); 
 Memo1.Lines.Add(Format('Size: %d', [t.TypeSize])); 
 Memo1.Lines.Add(Format('Min,Max: %d , %d', [t.MinValue, t.MaxValue])); 
 Memo1.Lines.Add(EmptyStr); 
end; 
 
end. 

 


下面以 TPoint 为例, 用 TRttiRecordType读取了结构的信息.


unit Unit1; 
 
interface 
 
uses 
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 
 Dialogs, StdCtrls; 
 
type 
 TForm1 = class(TForm) 
  Memo1: TMemo; 
  Button1: TButton; 
  procedure Button1Click(Sender: TObject); 
 end; 
 
var 
 Form1: TForm1; 
 
implementation 
 
{$R *.dfm}  
 
uses Rtti; 
 
procedure TForm1.Button1Click(Sender: TObject); 
var 
 t: TRttiRecordType; 
 f: TRttiField; 
begin 
 Memo1.Clear; 
 t := TRttiContext.Create.GetType(TypeInfo(TPoint)).AsRecord; 
 Memo1.Lines.Add(t.QualifiedName); 
 Memo1.Lines.Add(Format('Size: %d', [t.TypeSize])); 
 Memo1.Lines.Add(EmptyStr); 
 
 Memo1.Lines.Add(Format('字段数: %d', [Length(t.GetFields)])); 
 Memo1.Lines.Add(Format('方法数: %d', [Length(t.GetMethods)])); 
 Memo1.Lines.Add(Format('属性数: %d', [Length(t.GetProperties)])); 
 Memo1.Lines.Add(EmptyStr); 
 
 Memo1.Lines.Add('全部字段:'); 
 for f in t.GetFields do Memo1.Lines.Add(f.ToString); 
end; 
 
end. 

 


方法的更多信息是指: 方法类型、返回值、参数等.


unit Unit1; 
 
interface 
 
uses 
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 
 Dialogs, StdCtrls; 
 
type 
 TForm1 = class(TForm) 
  Memo1: TMemo; 
 


鲜花

握手

雷人

路过

鸡蛋
该文章已有0人参与评论

请发表评论

全部评论

专题导读
上一篇:
DelphiXE6原生解析json发布时间:2022-07-18
下一篇:
delphi进度条发布时间:2022-07-18
热门推荐
阅读排行榜

扫描微信二维码

查看手机版网站

随时了解更新最新资讯

139-2527-9053

在线客服(服务时间 9:00~18:00)

在线QQ客服
地址:深圳市南山区西丽大学城创智工业园
电邮:jeky_zhao#qq.com
移动电话:139-2527-9053

Powered by 互联科技 X3.4© 2001-2213 极客世界.|Sitemap