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.
由于对象都是从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属性
var
i : integer;
begin
for i:= 0 toAcontrl.ControlCount-1 do
begin
if Acontrl.Controls[i] is TEditthen
((Acontrl.Controls[i]) as TEdit).Text:= '' ;
if Acontrl.Controls[i] is TCustomControlthen
ClearEdit((Acontrl.Controls[i] as TCustomControl))
end;
end;
第二部分:RTTI
上文中已经多次提到了RTTI,但好像并没有看到RTTI出现。那么RTTI是如何表现自己的呢?你将发现,RTTI至少在两个地方对你有用。第一个地方是DELPHI的IDE,这在前面已提到过。通过RTTI,IDE就会知道你正在使用的对象和组件的任何事情。实际上,不只是RTTI,但为了这个讨论,我们只谈RTTI方面。其实上面的as,is操作都间接的使用了RTTI。
还是用个例子来演示吧。在观看此例子之时,建议你看看typinfo.pas中的内容(DELPHI安装目录下\source\rtl\common\TypInfo.pas);
下面的例子主要分为两部分,界面上半部分,主要演示通过rtti来显示用户选择类型的信息。(有3个TListBox)。
下面的部分主要通过RTTI来完成通过配置信息对控件进行属性的赋值操作,这里将演示文本类型和事件类型的赋值。
窗体文件如下:代码如下:
{
作者:wudi_1982
联系方式:wudi_1982@hotmail.com
转载请注明出处
}
unit main;
interface
uses
Windows, Messages, SysUtils,Variants, Classes, Graphics,Controls,
Forms,
Dialogs,typinfo, StdCtrls,ExtCtrls, Buttons;
type
InsertCom = record
Name : string; //要修改属性的组件名
PproName : string;//要修改控件的属性名
MethodName :string;//要修改or添加给控件的事件名
text : string; //属性值,这里修改的是string类型的数值
end;
TForm1 = class(TForm)
Panel1: TPanel;
GroupBox1: TGroupBox;
ListBox1: TListBox;
GroupBox2: TGroupBox;
GroupBox3: TGroupBox;
ListBox2: TListBox;
ListBox3: TListBox;
Panel2: TPanel;
edComName: TEdit;
Label2: TLabel;
Label3: TLabel;
edPproName: TEdit;
Label4: TLabel;
edValue: TEdit;
Panel3: TPanel;
btnInit: TButton;
btnModify: TButton;
GroupBox4: TGroupBox;
Label1: TLabel;
BitBtn1: TBitBtn;
procedure FormCreate(Sender: TObject);
procedure ListBox1Click(Sender: TObject);
procedure btnInitClick(Sender: TObject);
procedure btnModifyClick(Sender: TObject);
private
TestCom : InsertCom;
procedure MyClick(Sender :TObject); //给控件添加onclick事件
public
{Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
function CreateClass(const AClassName: string):TObject;//根据名字生成
var
tm : TObject;
t : TFormClass;
begin
t:= TFormClass(FindClass(AClassName));
tm:= t.Create(nil);
Result:= tm;
end;
procedure GetBaseClassInfo(AClass : TObject;AStrings :TStrings); //获
得类型的基本信息
var
classTypeInfo :PTypeInfo;
ClassDataInfo :PTypeData;
begin
classTypeInfo := AClass.ClassInfo;
ClassDataInfo := GetTypeData(classTypeInfo);
withAStrings do
begin
Add(Format('name is:%s',[classTypeInfo.Name]));
Add(format('type kind is:%s',[GetEnumName(TypeInfo
(TTypeKind),integer(classTypeInfo.Kind))]));
Add(Format('in : %s',[ClassDataInfo.UnitName]));
end;
end;
procedure GetBaseClassPro(AClass : TObject;Astrings :TStrings); //获
得属性信息
var
NumPro :integer; //用来记录事件属性的个数
Pplst :PPropList; //存放属性列表
Classtypeinfo : PTypeInfo;
classDataInfo:PTypeData;
i : integer;
begin
Classtypeinfo:= AClass.ClassInfo;
classDataInfo:= GetTypeData(Classtypeinfo);
if classDataInfo.PropCount <> 0 then
begin
//分配空间
GetMem(Pplst,sizeof(PpropInfo)*classDataInfo.PropCount);
try
//获得属性信息到pplst
GetPropInfos(AClass.ClassInfo,Pplst);
for I:= 0 toclassDataInfo.PropCount - 1 do
begin
if Pplst[i]^.PropType^.Kind <> tkMethodthen
//这里过滤掉了事件属性
Astrings.Add(Format('%s:%s',[Pplst[i]^.Name,Pplst[i]
^.PropType^.Name]));
end;
//获得事件属性
NumPro := GetPropList(AClass.ClassInfo,[tkMethod],Pplst);
if NumPro <> 0 then
begin
//给列表添加一些标志
Astrings.Add('');
Astrings.Add('-----------EVENT-----------');
Astrings.Add('');
for i:= 0 toNumPro - 1 do //获得事件属性的列表
Astrings.Add(Format('%s:%s',[Pplst[i]^.Name,Pplst[i]
^.PropType^.Name]));
end;
finally
FreeMem(Pplst,sizeof(PpropInfo)*classDataInfo.PropCount);
end;
end;
end;
procedure TForm1.btnInitClick(Sender: TObject);
begin
//修改label1的caption属性为12345
TestCom.Name := edComName.Text;
TestCom.PproName := edPproName.Text;
TestCom.text:= edValue.Text;
TestCom.MethodName := 'OnClick';
btnModify.Enabled := true;
end;
procedure TForm1.btnModifyClick(Sender: TObject);
var
pp : PPropInfo;
obj : TComponent;
a : TMethod;
tm : TNotifyEvent;
begin
obj := FindComponent(TestCom.Name);//通过名字查找此控件
if notAssigned(obj) thenexit; //如果没有则退出
//通过getPropInfo获得指定控件的属性信息,注意,这里只能获得那些公开
了的属性
pp := GetPropInfo(obj.ClassInfo,TestCom.PproName);
if Assigned(pp)then
begin
//根据kind判断类型是否为string类型
case pp^.PropType^.Kind of
//这里使用setStrProp来为string类型的属性赋值,对起来类型的赋值
,请参考TypInfo.pas
tkString,tkLString,tkWString : SetStrProp
(obj,TestCom.PproName,TestCom.text);
end;
//给要修改的控件添加onClick事件,
pp := GetPropInfo(obj.ClassInfo,TestCom.MethodName);
if Assigned(pp)then
begin
if pp^.PropType^.Kind = tkMethodthen
begin
tm := MyClick;
//Tmethod的code为函数地址,你也可以通过MethodAddress方法获得
a.Code := @tm;
a.Data := Self;
//对时间赋值
SetMethodProp(obj,TestCom.MethodName,a);
end;
end;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
btnModify.Enabled := false;
//给listbox1添加一些类型的类名
withListBox1.Items do
begin
Add('TApplication');
Add('TEdit');
Add('TButton');
Add('Tmemo');
Add('TForm');
end;
end;
procedure TForm1.ListBox1Click(Sender: TObject);
var
t : TObject;
begin
//当在类型列表中选择一个类型并用鼠标单击后,分别得到它的属性信息和
基本信息
ListBox2.Clear;
ListBox3.Clear;
t := CreateClass(ListBox1.Items[ListBox1.ItemIndex]);
try
GetBaseClassInfo(t,ListBox2.Items);
GetBaseClassPro(t,ListBox3.Items);
finally
t.Free;
end;
end;
procedure TForm1.MyClick(Sender: TObject);
begin
//给指定控件添加的一个方法
ShowMessage('wudi_1982');
end;
initialization
//初始化的时候注册
RegisterClasses([TApplication,TButton,TEdit,TMemo,TForm]);
end.
注:示例程序在winxp+D7以及turbodelphi+winxp下测试通过。Borland文档中不包含将来也许会有版本变化的功能。当使用如RTTI等无文档说明的功能时,就不能保证你的程序可以完全移植到Delphi的未来版本。转载请注明出处!
程序效果图如下:
编译、运行程序,你可以通过点击左上角列表框中的类型,获得他们的信息。而在窗体的下部,主要演示了通过读取配置信息来对控件的属性赋值(例程中的配置信息是通过edit输入的,可以在实际运用中改成从配置文件读取)。当使用下半部分功能时,在默认情况下,点击初始化按钮,然后点击修改,你会发现label1的caption变成了12345,并在在鼠标点击的时候会弹出一个对话框,你可以尝试把第一个edit的内容改成bitbtn1试试。
http://www.voidcn.com/blog/panpanxj/article/p-2753044.html
Delphi 的RTTI机制浅探3(超长,很不错)的更多相关文章
- mongoengine中collection名称自动生成机制浅探
项目碰到要使用mongodb的场景,以前只听过这一强大的文档数据库,但一直没有真正使用过,参考一下项目中已有的使用代码,是通过import mongoengine这一模块实现python服务对db中c ...
- [置顶] C++中RTTI机制剖析
C++中要想在运行时获取类型信息,可没有Java中那么方便,Java中任何一个类都可以通过反射机制来获取类的基本信息(接口.父类.方法.属性.Annotation等),而且Java中还提供了一个关键字 ...
- font and face, 浅探Emacs字体选择机制及部分记录
缘起 最近因为仰慕org-mode,从vim迁移到了Emacs.偶然发现org-mode中调出的calendar第一行居然没有对齐,排查一下发现是字体的问题.刚好也想改改Emacs的字体,于是我就开始 ...
- C++中的RTTI机制解析
RTTI RTTI概念 RTTI(Run Time Type Identification)即通过运行时类型识别,程序能够使用基类的指针或引用来检查着这些指针或引用所指的对象的实际派生类型. RTTI ...
- java反射机制浅谈
一.Java的反射机制浅谈 最近研究java研究得很给力,主要以看博文为学习方式.以下是我对java的反射机制所产生的一些感悟,希望各位童鞋看到失误之处不吝指出.受到各位指教之处,如若让小生好好感动, ...
- 深入Delphi -- Windows 消息机制
http://www.txsz.net/xs/delphi/3/Windows%20%E6%B6%88%E6%81%AF%E6%9C%BA%E5%88%B6.htm Windows 消息机制 by m ...
- 用DELPHI的RTTI实现数据集的简单对象化
在<强大的DELPHI RTTI--兼谈需要了解多种开发语言>一文中,我说了一下我用DELPHI的RTTI实现了数据集的简单对象化.本文将详细介绍一下我的实现方法. 首先从一个简单 ...
- 用DELPHI的RTTI实现对象的XML持久化
去年我花了很多时间尝试用DELPHI进行基于XML的WEB应用开发.起初的设想是很美好的,但结果做出来的东西很简陋.一部分原因就在于XML到Object之间的数据绑定实现太麻烦(另一部分是因为对XSL ...
- OCR技术浅探:基于深度学习和语言模型的印刷文字OCR系统
作者: 苏剑林 系列博文: 科学空间 OCR技术浅探:1. 全文简述 OCR技术浅探:2. 背景与假设 OCR技术浅探:3. 特征提取(1) OCR技术浅探:3. 特征提取(2) OCR技术浅探:4. ...
随机推荐
- Android开发之assets目录下资源使用总结
预前知识: Android资源文件分类: Android资源文件大致可以分为两种: 第一种是res目录下存放的可编译的资源文件: 这种资源文件系统会在R.Java里面自动生成该资源文件的ID,所以访问 ...
- Neo4j集群环境建设
简介: Neo4j它是目前的主流地图数据库.它本身提供了高可用性集群解决方案.本文将试图建立一个高可用性neo4j周围环境. 1. 这是一个地图数据库? 图形库(graphic database)问题 ...
- 相关web 片段记录安全性研究(不时更新)
一.有关html/css, js, php, cgi 的一些认识 当我们浏览器訪问一个网站的静态文件.会把文件内容都下载下来(一般压缩).当然假设遇到外联的css/js,会再发起请求得 到.假设我们右 ...
- AVL 树的插入、删除、旋转归纳
参考链接: http://blog.csdn.net/gabriel1026/article/details/6311339 1126号注:先前有一个概念搞混了: 节点的深度 Depth 是指从根 ...
- 超平面(hyperplane)的定义
Hyperplane - Wikipedia Hyperplane – from Wolfram MathWorld a1,a2,-,an 为一组不全为 0 的纯量,如下定义的集合 S 由这样的向量构 ...
- js调查server
<script type="text/javascript"> function showUnreadNews() { $(document).ready(functi ...
- 在Docker中创建Mongo容器的后续设置
后续设置包括设置数据库管理员账号密码.创建业务数据库以及设置账户密码 需要注意的是,在创建Mongo容器后,需要映射到本机 以管理员身份打开powershell 先切换到mongdo bash # ` ...
- ubuntu 16.04快速安装ceph集群
准备工作 假设集群: 选一台作管理机 注意: ceph集群引用hostname,而非ip. 172.17.4.16 test16 #hostname必须是test16 172.17.4.17 test ...
- WPF编游戏系列 之九 物品清单再优化
原文:WPF编游戏系列 之九 物品清单再优化 在"第三篇"和"第四篇"中通过用户控件和数据绑定功能对物品清单进行一些优化减少了部分C#代码,但感觉 ...
- WPF Button控件模板
<Window x:Class="ControlTemplateDemo.MainWindow" xmlns="http://schemas.m ...