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


    转自: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; 
      Button1: TButton; 
      procedure Button1Click(Sender: TObject); 
     end; 
     
    var 
     Form1: TForm1; 
     
    implementation 
     
    {$R *.dfm}  
     
    uses Rtti,TypInfo; 
     
    procedure TForm1.Button1Click(Sender: TObject); 
    var 
     ms: TArray<TRttiMethod>; 
     m: TRttiMethod; 
     mps: TArray<TRttiParameter>; 
     mp: TRttiParameter; 
    begin 
     Memo1.Clear; 
     
     {先获取方法集合, 这里随便使用了 TButton 类} 
     ms := TRttiContext.Create.GetType(TButton).GetMethods; 
     for m in ms do 
     begin 
      {方法名称} 
      Memo1.Lines.Add('方法名称: ' + m.Name); 
     
      {方法类型: proceedure、function 等} 
      Memo1.Lines.Add('方法类型: ' + GetEnumName(TypeInfo(TMethodKind), Ord(m.MethodKind))); 
     
      {方法的返回值类型} 
      if Assigned(m.ReturnType) then 
       Memo1.Lines.Add('返回值: ' + GetEnumName(TypeInfo(TTypeKind), Ord(m.ReturnType.TypeKind))); 
     
      {方法的参数列表} 
      mps := m.GetParameters; 
      if Length(mps) > 0 then 
      begin 
       Memo1.Lines.Add('参数:'); 
       for mp in mps do Memo1.Lines.Add(mp.ToString); 
       //还可以通过 mp.ParamType 获取参数的数据类型 
       //还可以通过 mp.Flags 获取参数的修饰符(譬如 var、const 等) 
      end; 
     
      Memo1.Lines.Add(EmptyStr); 
     end; 
    end; 
     
    end. 


    运行期类型信息(RTTI)是一种语言特征,能使应用程序在运行时得到关于对象的信息。RTTI是Delphi的组件能够融合到IDE中的关键。它在IDE中不仅仅是一个纯学术的过程。
       由于对象都是从TObject继承下来的,因此,对象都包含一个指向它们的RTTI的指针以及几个内建的方法。下面的表列出了TObject的一些方法,用这些方法能获得某个对象实例的信息。
    函数   返回类型 返回值
    ClassName( )   string 对象的类名
    ClassType() boolean 对象的类型
    InheritsFrom boolean     判断对象是否继承于一个指定的类
    ClassParent() TClass 对象的祖先类型
    Instancesize() word 对象实例的长度(字节数)
    ClassInfo() Pointer 指向RTTI的指针


    第一部分:关于as 和 is


        ObjectPascal提供了两个运算符as和is,用它们通过RTTI能对对象进行比较和强制类型转换。
       关键字as是类型转换的一种新的形式。它能把一个基层的对象强制类型转换成它的派生类,如果转换不合法就产生一个异常。假定有一个过程,想让它能够传递任何类型的对象,它应该这样定义:
        ProcedureFoo(AnObject :Tobject);
       在这个过程如果要对AnObject进行操作,要把它转换为一个派生对象。假定把AnObject看成是一个TEdit派生类型,并想要改变它所包含的文本,用下列代码:(AnObject as Tedit).text := 'wudi_1982';
       能用比较运算符来判断两个对象是否是相兼容的类型,用is运算符把一个未知的对象和一个已知类型或实例进行比较,确定这个未知对象的属性和行为。例如,在对(AnObject进行强制类型转换前,确定(AnObject 和TEdit是否指针兼容:

        if (AnObjectis Tedit) then
        Tedit(AnObjject).text := 'wudi_1982';
       注意在这个例子中不要再使用as进行强制类型转换,这是因为它要大量使用RTTI,另外还因为,在第一行已经判断Foo就是TEdit,可以通过在第2行进行指针转换来优化。

       这两个操作符最典型的应用我想应该是在程序需要的部分清空窗体上所有edit的text属性

    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗procedureTForm1.ClearEdit(Acontrl: TWinControl);
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗var
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗i : integer;
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗begin
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗   for i:= 0 toAcontrl.ControlCount-1 do 
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗   begin
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗       if Acontrl.Controls[i] is  TEditthen
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗        ((Acontrl.Controls[i]) as TEdit).Text:= '' ;
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗      if Acontrl.Controls[i] is  TCustomControlthen
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗       ClearEdit((Acontrl.Controls[i] as  TCustomControl))
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗   end;
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗end;

    第二部分:RTTI


      上文中已经多次提到了RTTI,但好像并没有看到RTTI出现。那么RTTI是如何表现自己的呢?你将发现,RTTI至少在两个地方对你有用。第一个地方是DELPHI的IDE,这在前面已提到过。通过RTTI,IDE就会知道你正在使用的对象和组件的任何事情。实际上,不只是RTTI,但为了这个讨论,我们只谈RTTI方面。其实上面的as,is操作都间接的使用了RTTI。
       还是用个例子来演示吧。在观看此例子之时,建议你看看typinfo.pas中的内容(DELPHI安装目录下source tlcommonTypInfo.pas);
       下面的例子主要分为两部分,界面上半部分,主要演示通过rtti来显示用户选择类型的信息。(有3个TListBox)。
       下面的部分主要通过RTTI来完成通过配置信息对控件进行属性的赋值操作,这里将演示文本类型和事件类型的赋值。
        窗体文件如下:代码如下:

    {
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗   作者:wudi_1982
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗   联系方式:wudi_1982@hotmail.com
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗   转载请注明出处
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗}
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗unit main;
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗interface
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗uses
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗   Windows, Messages, SysUtils,Variants, Classes, Graphics,Controls, 
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗Forms,
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗   Dialogs,typinfo, StdCtrls,ExtCtrls, Buttons;
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗type
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗  InsertCom = record
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗    Name : string; //要修改属性的组件名
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗    PproName : string;//要修改控件的属性名
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗    MethodName :string;//要修改or添加给控件的事件名
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗    text : string; //属性值,这里修改的是string类型的数值
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗  end;
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗  TForm1 = class(TForm)
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗    Panel1: TPanel;
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗    GroupBox1: TGroupBox;
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗    ListBox1: TListBox;
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗    GroupBox2: TGroupBox;
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗    GroupBox3: TGroupBox;
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗    ListBox2: TListBox;
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗    ListBox3: TListBox;
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗    Panel2: TPanel;
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗    edComName: TEdit;
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗    Label2: TLabel;
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗    Label3: TLabel;
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗    edPproName: TEdit;
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗    Label4: TLabel;
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗    edValue: TEdit;
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗    Panel3: TPanel;
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗    btnInit: TButton;
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗    btnModify: TButton;
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗    GroupBox4: TGroupBox;
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗    Label1: TLabel;
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗    BitBtn1: TBitBtn;
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗    procedure FormCreate(Sender: TObject);
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗    procedure ListBox1Click(Sender: TObject);
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗    procedure btnInitClick(Sender: TObject);
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗    procedure btnModifyClick(Sender: TObject);
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗  private
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗    TestCom : InsertCom;
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗    procedure MyClick(Sender :TObject); //给控件添加onclick事件
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗  public
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗    {Public declarations }
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗   end;
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗var
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗   Form1: TForm1;
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗implementation
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗{$R *.dfm}
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗function CreateClass(const AClassName: string):TObject;//根据名字生成
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗var
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗   tm : TObject;
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗   t : TFormClass;
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗begin
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗    t:= TFormClass(FindClass(AClassName));
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗    tm:= t.Create(nil);
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗    Result:= tm;
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗end;
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗procedure GetBaseClassInfo(AClass : TObject;AStrings :TStrings); //获
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗得类型的基本信息
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗var
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗   classTypeInfo :PTypeInfo;
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗   ClassDataInfo :PTypeData;
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗begin
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗   classTypeInfo := AClass.ClassInfo;
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗   ClassDataInfo := GetTypeData(classTypeInfo);
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗    withAStrings do
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗   begin
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗     Add(Format('name is:%s',[classTypeInfo.Name]));
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗     Add(format('type kind is:%s',[GetEnumName(TypeInfo
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗(TTypeKind),integer(classTypeInfo.Kind))]));
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗     Add(Format('in : %s',[ClassDataInfo.UnitName]));
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗   end;
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗end;
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗procedure GetBaseClassPro(AClass : TObject;Astrings :TStrings); //获
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗得属性信息
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗var
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗   NumPro :integer; //用来记录事件属性的个数
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗  Pplst :PPropList; //存放属性列表
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗  Classtypeinfo : PTypeInfo;
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗   classDataInfo:PTypeData;
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗   i : integer;
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗begin
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗   Classtypeinfo:= AClass.ClassInfo;
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗   classDataInfo:= GetTypeData(Classtypeinfo);
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗  if classDataInfo.PropCount <> 0 then
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗   begin
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗    //分配空间
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗    GetMem(Pplst,sizeof(PpropInfo)*classDataInfo.PropCount);
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗    try
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗      //获得属性信息到pplst
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗      GetPropInfos(AClass.ClassInfo,Pplst);
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗      for I:= 0 toclassDataInfo.PropCount - 1 do
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗        begin
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗          if Pplst[i]^.PropType^.Kind <> tkMethodthen
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗          //这里过滤掉了事件属性
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗            Astrings.Add(Format('%s:%s',[Pplst[i]^.Name,Pplst[i]
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗^.PropType^.Name]));
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗        end;
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗        //获得事件属性
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗        NumPro := GetPropList(AClass.ClassInfo,[tkMethod],Pplst);
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗        if NumPro <> 0 then
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗        begin
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗          //给列表添加一些标志
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗          Astrings.Add('');
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗          Astrings.Add('-----------EVENT-----------');
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗          Astrings.Add('');
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗          for i:= 0 toNumPro - 1 do //获得事件属性的列表
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗            Astrings.Add(Format('%s:%s',[Pplst[i]^.Name,Pplst[i]
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗^.PropType^.Name]));
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗        end;
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗    finally
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗       FreeMem(Pplst,sizeof(PpropInfo)*classDataInfo.PropCount);
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗    end;
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗   end;
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗end;

    procedure TForm1.btnInitClick(Sender: TObject);
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗begin
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗   //修改label1的caption属性为12345
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗   TestCom.Name := edComName.Text;
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗   TestCom.PproName := edPproName.Text;
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗    TestCom.text:= edValue.Text;
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗   TestCom.MethodName := 'OnClick';
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗   btnModify.Enabled := true;
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗end;
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗procedure TForm1.btnModifyClick(Sender: TObject);
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗var
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗   pp : PPropInfo;
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗   obj : TComponent;
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗   a : TMethod;
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗   tm : TNotifyEvent;
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗begin
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗   obj := FindComponent(TestCom.Name);//通过名字查找此控件
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗  if notAssigned(obj) thenexit; //如果没有则退出
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗  //通过getPropInfo获得指定控件的属性信息,注意,这里只能获得那些公开
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗了的属性
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗   pp := GetPropInfo(obj.ClassInfo,TestCom.PproName);
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗  if Assigned(pp)then
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗   begin
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗     //根据kind判断类型是否为string类型
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗     case pp^.PropType^.Kind  of
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗       //这里使用setStrProp来为string类型的属性赋值,对起来类型的赋值
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗,请参考TypInfo.pas
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗       tkString,tkLString,tkWString : SetStrProp
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗(obj,TestCom.PproName,TestCom.text);
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗     end;
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗     //给要修改的控件添加onClick事件,
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗     pp := GetPropInfo(obj.ClassInfo,TestCom.MethodName);
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗     if Assigned(pp)then
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗     begin
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗       if pp^.PropType^.Kind = tkMethodthen
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗       begin
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗         tm := MyClick;
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗         //Tmethod的code为函数地址,你也可以通过MethodAddress方法获得
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗         a.Code := @tm;
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗         a.Data := Self;
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗         //对时间赋值
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗         SetMethodProp(obj,TestCom.MethodName,a);
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗       end;
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗     end;
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗   end;
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗end;
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗procedure TForm1.FormCreate(Sender: TObject);
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗begin
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗   btnModify.Enabled := false;
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗   //给listbox1添加一些类型的类名
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗   withListBox1.Items do
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗   begin
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗     Add('TApplication');
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗     Add('TEdit');
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗     Add('TButton');
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗     Add('Tmemo');
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗     Add('TForm');
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗   end;
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗end;
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗procedure TForm1.ListBox1Click(Sender: TObject);
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗var
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗   t : TObject;
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗begin
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗   //当在类型列表中选择一个类型并用鼠标单击后,分别得到它的属性信息和
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗基本信息
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗    ListBox2.Clear;
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗    ListBox3.Clear;
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗    t := CreateClass(ListBox1.Items[ListBox1.ItemIndex]);
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗    try
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗      GetBaseClassInfo(t,ListBox2.Items);
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗      GetBaseClassPro(t,ListBox3.Items);
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗    finally
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗       t.Free;
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗    end;
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗end;
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗procedure TForm1.MyClick(Sender: TObject);
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗begin
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗   //给指定控件添加的一个方法
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗   ShowMessage('wudi_1982');
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗end;
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗initialization
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗   //初始化的时候注册
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗   RegisterClasses([TApplication,TButton,TEdit,TMemo,TForm]);
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗end.
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗 
    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗

         注:示例程序在winxp+D7以及turbodelphi+winxp下测试通过。Borland文档中不包含将来也许会有版本变化的功能。当使用如RTTI等无文档说明的功能时,就不能保证你的程序可以完全移植到Delphi的未来版本。转载请注明出处!

    程序效果图如下:

    Delphi中使用Rtti - kaibosoft - 为了老婆和儿女而努力奋斗

            编译、运行程序,你可以通过点击左上角列表框中的类型,获得他们的信息。而在窗体的下部,主要演示了通过读取配置信息来对控件的属性赋值(例程中的配置信息是通过edit输入的,可以在实际运用中改成从配置文件读取)。当使用下半部分功能时,在默认情况下,点击初始化按钮,然后点击修改,你会发现label1的caption变成了12345,并在在鼠标点击的时候会弹出一个对话框,你可以尝试把第一个edit的内容改成bitbtn1试试。

    http://www.voidcn.com/blog/panpanxj/article/p-2753044.html

  • 相关阅读:
    每天进步一点点之查找
    每天进步一点点之堆栈思想
    每天进步一点点之大端存储和小端存储
    每天进步一点点之线性表的考察
    每天进步一点点之出栈顺序考点
    React Native 混合开发与实现
    谈谈JavaScript异步代码优化
    谈谈前端异常捕获与上报
    vue插件编写与实战
    vue项目构建与实战
  • 原文地址:https://www.cnblogs.com/findumars/p/6348011.html
Copyright © 2020-2023  润新知