|
目 录
===============================================================================
⊙ DFM 文件与持续机制(persistent)
⊙ ReadComponentResFile / WriteComponentResFile 函数
⊙ Delphi 持续机制框架简述
⊙ 一个 TForm 对象的创建过程
⊙ TStream Class 和 TStream.ReadComponent 方法
⊙ TReader Class 和 TReader.ReadRootComponent 方法
⊙ TReader.ReadPrefix 方法
⊙ TComponent.ReadState 虚方法
⊙ TReader.ReadData 方法
⊙ TReader.ReadDataInner 方法
⊙ TReader.ReadProperty 方法
⊙ TPersistent.DefineProperties 虚方法
⊙ TReader.ReadComponent 方法
⊙ TReader.ReadValue / TReader.NextValue 系列方法
⊙ TReader.ReadStr 方法
⊙ TReader.ReadInteger / ReadString / ReadBoolean 系列方法
⊙ TReader.Read 方法
⊙ ObjectBinaryToText / ObjectTextToBinary 函数
===============================================================================
本文排版格式为：
正文由窗口自动换行；所有代码以 80 字符为边界；中英文字符以空格符分隔。
(作者保留对本文的所有权利，未经作者同意请勿在在任何公共媒体转载。)
正 文
===============================================================================
⊙ DFM 文件与持续机制(persistent)
===============================================================================
我们在使用 Delphi 的 IDE 进行快速开发的时候，可以方便地从元件面板上拖放元件(component)至表单，完成表单的界面和事件设计。Delphi 将这些界面的设计期信息保存在表单相应的 DFM 文件中，方便程序员随时读取和修改。
DFM 文件根据元件在表单上的嵌套层次存放元件属性，以下是一个 DFM 文件的示例：
object Form1: TForm1
...
Left = 192
Top = 107
Width = 544
Caption = 'Form1'
object Button1: TButton
Left = 24
Top = 16
Caption = 'Button1'
onClick = Button1Click
end
...
end
应用程序编译之后，DFM 文件的信息被二进制化了，这些二进制信息存储在应用程序的资源(resource)段中。每个表单(也就是 class)及表单上的元件在资源段中存储为与表单同名的资源，可以使用 FindResource API 获得。应用程序在运行期创建表单实例的时候，会从资源段中读取表单的属性，还原设计期的设置。这种将类型信息保存在文件中，并且可以在运行期恢复类型的操作，在本文中被称之为持续(persistent)机制。持续机制是 Delphi 成为 RAD 工具的原因之一。
持续机制和 RTTI 是紧密结合的，但本文不讨论 RTTI(关于 RTTI 可参考我前几天写的两篇笔记)，只讨论实现持续机制的总体框架及相关类(class)。这些类包括 TStream、TFiler、TReader、TWriter、TParser、TPersisetent、TComponent、TCustomForm 等。
===============================================================================
⊙ ReadComponentResFile / WriteComponentResFile 函数
===============================================================================
让我们从一个比较直观的例子开始。
Classes.pas 中定义了两个函数 ReadComponentResFile 和 WriteComponentResFile，它们的功能是“把元件的属性信息保存到文件”和“从文件中恢复元件属性信息”。
先做个试验。新建一个项目，在 Form1 上放置两个 Button 和一个 Memo。Button 的 Click 事件代码如下。按 F9 运行该项目，先在 Memo1 中输入一些字符，然后按下 Button1，再按下 Button2，你会看一个新建的 Form。它的属性几乎和 Form1 一样，甚至连 Memo1 中的字符都保存下来了，唯一的不同只是它的 Name 属性变成了“Form1_1”。你可以查看 FORM1.RES 文件的内容看看 Delphi 是如何存储元件信息的。
procedure TForm1.Button1Click(Sender: TObject);
begin
WriteComponentResFile('C:\FORM1.RES', Form1);
end;
procedure TForm1.Button2Click(Sender: TObject);
var
NewForm: TForm1;
begin
NewForm := TForm1.CreateNew(Application);
ReadComponentResFile('C:\FORM1.RES', NewForm);
NewForm.Left := NewForm.Left + 100;
end;
WriteComponentResFile 函数的代码如下，它只是调用 Stream 对象的 WriteComponentRes 方法将对象属性保存到资源文件中的：
procedure WriteComponentResFile(const FileName: string; Instance: TComponent);
begin
Stream := TFileStream.Create(FileName, fmCreate);
Stream.WriteComponentRes(Instance.ClassName, Instance);
Stream.Free;
end;
ReadComponentResFile 函数也是调用 Stream 的方法实现从文件中读取对属信息：
function ReadComponentResFile(const FileName: string; Instance: TComponent):
TComponent;
begin
Stream := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
Result := Stream.ReadComponentRes(Instance);
Stream.Free;
end;
ReadComponentResFile 函数可以通过 Instance 参数传入对象句柄，也可以通过返回值获得对象句柄。Instance 参数只能是已实例化的对象或 nil。如果是 nil，那么 ReadComponentResFile 会自动根据文件信息创建对象实例，但必须使用 RegisterClass 函数注册将要被载入的类，否则会触发异常。
有个类似的函数 ReadComponentRes，它从应用程序的资源段中恢复对象的属性信息。它的 ResName 参数就是表单类的名称：
function ReadComponentRes(const ResName: string; Instance: TComponent):
TComponent;
===============================================================================
⊙ Delphi 持续机制框架简述
===============================================================================
持续机制的实现必须由 IDE、编译器、表单类、元件类和辅助类合作完成。
这里的表单类不是指一般所指的 TForm class，在 Delphi 的帮助文件中，称之为“root class”。root class 是指能在设计期被 Form Designer 作为最上层编辑表单的类(如 TCustomForm、TFrame、TDataModule 等)。Delphi 在设计期将元件的 published 属性的值保存在 .DFM 文件中，也只有 published 的属性才能被 Object Insepector 设置赋值。
Form Designer 设计的 root class 对象在编译时，Delphi 将对象的属性以及其所包含的元件的属性保存在应用程序的资源段(RT_RCDATA)中。
辅助类包括 TStream、TReader、TWriter、TParser 等。这些类起着中间层的作用，用于存储和读取对象属性的信息。虽然我称它们为辅助类，但是保存和恢复对象信息的实际操作是由它们完成的。
===============================================================================
⊙ 一个 TForm 对象的创建过程
===============================================================================
下面是一个典型的表单 Form1 的创建过程，缩进代表调用关系(Form1.ReadState 例外，防止缩进太多)，带“?”的函数表示我尚未仔细考察的部分，带“*”表示元件编写者需要注意的函数。
Application.CreateForm(TForm1, Form1);
|-Form1.NewInstance;
|-Form1.Create(Application);
|-Form1.CreateNew(Application);
|-InitInheritedComponent(Form1, TForm);
|-InternalReadComponentRes(Form1.ClassName, Form1ResHInst, Form1);
|-TResourceStream.Create(Form1ResHInst, Form1.ClassName, RT_RCDATA);
|-TResourceStream.ReadComponent(Form1);
|-TReader.Create(ResourceStream, 4096);
|-TReader.ReadRootComponent(Form1);
|-TReader.ReadSignature;
*|-TReader.ReadPrefix(Flags, ChildPos);
|-IF Form1 = nil THEN Form1 := FindClass(ReadStr).Create;
|-Include(Form1.FComponentState, csLoading);
|-Include(Form1.FComponentState, csReading);
|-Form1.Name := FindUniqueName(ReadStr);
?|-FFinder := TClassFinder.Create;
*|-Form1.ReadState(Reader);
|-TCustomForm.ReadState(Reader);
{ DisableAlign; }
|-TWinControl.ReadState(Reader);
{ DisableAlign; }
*|-TControl.ReadState(Reader);
{ Include(FControlState, csReadingState); }
{ Parent := TWinControl(Reader.Parent); }
*|-TComponent.ReadState(Reader);
|-Reader.ReadData(Form1);
|-Reader.ReadDataInner(Form1);
|-WHILE NOT EndOfList DO Reader.ReadProperty(Form1);
|-IF PropInfo <> nil THEN ReadPropValue(Form1, PropInfo);
*|-ELSE Form1.DefineProperties(Reader);
|-WHILE NOT EndOfList DO ReadComponent(nil);
|-ReadPrefix(Flags, Position);
|-IF ffInherited THEN FindExistingComponent
|-ELSE CreateComponent;
*|-SubComponent.ReadState(Reader); (Like Form1.ReadState)
?|-DoFixupReferences;
过程简述：
TCustomForm.Create 函数中先调用 CreateNew 设置缺省的表单属性，然后调用Classes.InitInheritedComponent 函数。
InitInheritedComponent 用于初始化一个 root class 对象。该函数的功能就是从应用程序的资源中恢复设计期的表单信息。InitInheritedComponent 的声明如下：
{ Classes.pas }
function InitInheritedComponent(Instance: TComponent;
RootAncestor: TClass): Boolean;
InitInheritedComponent 传入两个参数：Instance 参数代表将要从资源段中恢复信息的对象，RootAncestor 表示该对象的祖先类。如果从资源中恢复信息成功，则返回 True，否则返回 False。InitInheritedComponent 通常只在 root class 的构造函数中调用。
constructor TCustomForm.Create(AOwner: TComponent);
begin
...
CreateNew(AOwner); // 初始化缺省的 Form 属性
Include(FFormState, fsCreating); // 标记为 Creating 状态
if not InitInheritedComponent(Self, TForm) then // 从资源中恢复 Form 信息
raise EResNotFound.CreateFmt(SResNotFound, [ClassName]);
...
Exclude(FFormState, fsCreating); // 取消 Creating 状态
end;
InitInheritedComponent 调用自身内置的函数：InitComponent(Instance.ClassType)。InitComponent 先判断 Instance.ClassType 是否是 TComponent 或 RootAncestor，如果是则返回 False 并退出，否则调用 InternalReadComponentRes。
* InitComponent 递归调用自己检查类信息。没看懂为什么要这样设计，如果有谁看懂了请告诉我。
function InitComponent(ClassType: TClass): Boolean;
begin
Result := False;
if (ClassType = TComponent) or (ClassType = RootAncestor) then Exit;
Result := InitComponent(ClassType.ClassParent);
Result := InternalReadComponentRes(ClassType.ClassName,
FindResourceHInstance(FindClassHInstance(ClassType)), Instance) or Result;
end;
InternalReadComponentRes 使用 Instance.ClassName 作为 ResourceName，调用 FindResourceHInstance 找到 class 资源所在模块的 HInst 句柄(因为 class 可能是在动态链接库中)，并通过引用方式传递 Instance 对象(* 好像没有必要使用引用方式，InitInheritedComponent 也没有使用引用方式)：
{ Classes.pas }
function InternalReadComponentRes(const ResName: string; HInst: THandle;
var Instance: TComponent): Boolean;
InternalReadComponentRes 先检查 class 资源是否存在，如果存在则创建一个 TResourceStream 对象(TResourceStream 的 Create 构造函数把 class 信息的资源内存地址和大小记录在成员字段中)，然后使用 TResourceStream.ReadComponent 方法从资源中读取 Instance 的信息。TResourceStream 并没有定义 ReadComponent 方法，而是使用祖先类 TStream 的方法。TStream.ReadComponent 创建一个 TReader 对象，然后使用自己的对象地址(Self)作为参数，调用 TReader.ReadRootComponent 读取 Instance 对象的内容。
{ TReader }
function ReadRootComponent(Root: TComponent): TComponent;
ReadRootComponent 先调用 TReader.ReadSignature。ReadSignature 从 stream 中读取 4 字节的内容，如果读出来的内容不是 'TPF0'，则触发异常(SInvalidImage)，表示该 stream 的内容是错误的。然后 ReadRootComponent 调用 ReadPrefix 读取元件的状态信息。
如果 Root 参数是 nil，也就是说 Root 对象还没被创建，则直接从流中读取 Root 的类名，再使用 FindClass 函数找到该类在内存中的地址，并调用该类的构造函数创建 Root 的实例。
接下来 ReadRootComponent 调用 Root 的 ReadState 虚函数从流中读取 Root 对象的属性。TComponent.ReadState 只有一行代码：Reader.ReadData(Self);。
ReadData 调用 ReadDataInner 读取 root 元件及 root 的子元件的属性信息。
ReadDataInner 先循环调用 ReadProperty 从流中读取 root 元件的属性，直到遇到 EndOfList 标志(vaNull)。ReadProperty 使用 RTTI 函数，将从流中读出的数据设置为对象的属性。ReadProperty 中还调用了 Instance.DefineProperties，用于实现自定义的属性存储。ReadDataInner 然后循环调用 ReadComponent(nil) 读取子元件的信息。
ReadComponent 的执行过程与 ReadRootComponent 的过程很相似，它根据流中的信息使用 FindComponentClass 找到元件类在内存中的地址，然后调用该元件类的构造函数创建对象，接下来调用新建对象的 ReadState -> TReader.ReadData -> ReadDataInner -> TReader.ReadProperty，重复 ReadRootComponent 的过程。
TReader.ReadComponent 和 TComponent.ReadState 形成递归调用过程，把表单上嵌套的元件创建出来。
最后 InitInheritedComponent 函数返回，一个 root class 对象从资源中实例化的过程完成。
===============================================================================
⊙ TStream Class 和 TStream.ReadComponent 方法
===============================================================================
TStream 在对象持续机制扮演的角色是提供一种存储媒介，由 TFiler 对象使用。TStream 是一个虚类，它定义了数据的“流式”读写方法。它的继承类 TFileStream、TMemoryStream、TResourceStream 等实现对不同媒体的读写。对象的 persistent 信息可以存储在任何 TStream 类中，也可以从任何 TStream 中获得。由于 Delphi 缺省的对象信息存储在应用程序的资源段中，因此，可以从程序的资源段中读取数据的 TResourceStream 类就显得更加重要。
TStream 定义两个读写缓冲的方法：ReadBuffer 和 WriteBuffer。这两个方法封装了 TStream.Read 和 TStream.Write 纯虚方法(必须被后继类重载)。
{ TStream }
procedure ReadBuffer(var Buffer; Count: Longint);
procedure WriteBuffer(const Buffer; Count: Longint);
可以看到这两个方法的 Buffer 参数都是无类型的，也就是使用引用的方式传入的，所以不管是使用单个字符或自定义的结构都是正确的(当然，不能使用常量)。Count 指示要读或写入的 Buffer 的大小(Bytes)。
TStream 还定义了两个元件信息的读写方法：ReadComponent 和 WriteComponent。由于 WriteComponent 通常是由 Delphi 的 IDE/编译器调用的，很难跟踪它的执行过程，所以我们以后主要考察 ReadComponent 方法。我们可以很容易想像这两个方法互为逆过程，理解了其中一个也就能知道另一个所做的工作。
{ TStream }
function ReadComponent(Instance: TComponent): TComponent;
procedure WriteComponent(Instance: TComponent);
TStream.ReadComponent 创建了一个 TReader 对象，将自己的对象地址作为参数传递给 Reader，并调用 Reader.ReadRootComponent 创建对象实例。
function TStream.ReadComponent(Instance: TComponent): TComponent;
var
Reader: TReader;
begin
Reader := TReader.Create(Self, 4096); // 4096 是缓冲区大小
Result := Reader.ReadRootComponent(Instance);
Reader.Free;
end;
TStream 把自己的对象句柄交给 TReader 之后，就成了 TReader 读取对象属性资料的来源。此后 TStream 对象只由 TReader 来掌控，自己不再主动进行其它工作。
===============================================================================
⊙ TReader Class 和 TReader.ReadRootComponent 方法
===============================================================================
TReader 和 TWriter 都是从 TFiler 继承下来的类。TFiler 是个纯虚类，它的构造函数被 TReader 和 TWrite 共享。TFiler.Create 先把 Stream 参数保存在 FStream 字段中，然后生成一个自己的缓冲区：
constructor TFiler.Create(Stream: TStream; BufSize: Integer);
begin
FStream := Stream; // 保存 stream 对象
GetMem(FBuffer, BufSize); // 创建自己的缓冲区，加速数据访问
FBufSize := BufSize; // 设置缓冲区大小
end;
上面说到 TStream.ReadComponent 在创建 TReader 对象之后，立即调用 TReader.ReadRootComponent 方法。TReader.ReadRootComponent 方法的功能是从 stream 中读取 root class 对象的属性。并返回该对象的指针。
{ TReader }
function ReadRootComponent(Root: TComponent): TComponent;
ReadRootComponent 先调用 TReader.ReadSignature。
TReader.ReadSignature 方法从 stream 中读取 4 字节的内容，如果读出来的内容不是 'TPF0'，则触发异常(SInvalidImage)，表示该 stream 的内容是错误的。'TPF0' 就是 root class 对象的标记。
然后 ReadRootComponent 调用 ReadPrefix 读取元件的继承信息。
如果 Root 参数是 nil，也就是说 Root 对象还没被创建，则直接从流中读取 Root 的类名，再使用 FindClass 函数找到该类在内存中的地址，并调用该类的构造函数创建 Root 的实例。如果 Root 实例已存在，则调用内嵌的 FindUniquName 函数检查 Root.Name 是否与已有的实例重复，如有重复则在 Root.Name 后加上序号使其唯一。
接下来 ReadRootComponent 调用 Root 的 ReadState 虚方法从流中读取 Root 对象的属性。
===============================================================================
⊙ TReader.ReadPrefix 方法
===============================================================================
ReadPrefix 方法用于读取元件的状态信息，这些信息是由 Writer 在写入元件属性之前写入的。
{ TReader }
procedure ReadPrefix(var Flags: TFilerFlags; var AChildPos: Integer); virtual;
Flags 参数是以引用方式传递的，用于设置元件的在表单中的状态，元件的状态在这里包含三种情况：
ffInherited：表示元件存在于表单的父类之中
ffChildPos ：表示元件在表单中的创建次序(creation order)是重要的
ffInline ：表示元件是最上级(top-level)的元件，比如表单或数据模块
如果元件的状态中包含 ffChildPos，ReadPrefix 还会读取元件的创建次序值，存放在 AChildPos 参数中。
===============================================================================
⊙ TComponent.ReadState 虚方法
===============================================================================
设置 ReadState 方法的主要目的是在读取属性信息的前后可以让元件进行一些处理工作。ReadState 是 Component Writer 需要注意的方法。
{ TComponent }
procedure ReadState(Reader: TReader); virtual;
由于 ReadState 是虚函数，在 TControl、TWinControl、TCustomForm 等后续类中都被重载，进行自己需要的操作(比如 DisableAlign、UpdateControlState)。
TComponent.ReadState 只有一行代码：Reader.ReadData(Self);
注意：自己重载 ReadState 方法必须调用 inherited 。
===============================================================================
⊙ TReader.ReadData 方法
===============================================================================
上面说到 TComponent.ReadState 又回头调用 TReader.ReadData 方法。它的主要代码如下：
{ TReader }
procedure TReader.ReadData(Instance: TComponent);
begin
...
ReadDataInner(Instance);
DoFixupReferences;
...
end;
TReader.ReadData 基本上是个包装函数，它调用 TReader.ReadDataInner 读取 root 对象及 root 所包含的元件的属性信息。
===============================================================================
⊙ TReader.ReadDataInner 方法
===============================================================================
ReadDataInner 负责读取元件的属性和子元件的属性，它的主要代码如下：
procedure TReader.ReadDataInner(Instance: TComponent);
begin
...
while not EndOfList do ReadProperty(Instance);
...
while not EndOfList do ReadComponent(nil);
...
end;
ReadDataInner 先循环调用 ReadProperty 从流中读取对象的属性，直到遇到 EndOfList 标志(vaNull)。再循环调用 ReadComponent(nil) 读取子元件的信息。这两个方法都是 TReader 的重要方法，后面分两节讨论。ReadDataInner 在ReadProperty 调用之后还设置了元件的 Parent 和 Owner 关系。
===============================================================================
⊙ TReader.ReadProperty 方法
===============================================================================
ReadProperty 使用 RTTI 函数将从流中读出的数据设置为对象的属性。它先解析从流中读出的属性名称，然后判断该属性是否有 RTTI 信息，如果有则调用 TReader.ReadPropValue 方法从流中读取属性值；如果该属性没有 RTTI 信息，说明该属性不属于 published 段，而是由元件自己写入的，因此调用 TPersistent.DefineProperties 读取自定义的元件信息。ReadProperty 的关键代码：
procedure TReader.ReadProperty(AInstance: TPersistent);
begin
...
PropInfo := GetPropInfo(Instance.ClassInfo, FPropName);
if PropInfo <> nil then // 检查属性 RTTI 信息
ReadPropValue(Instance, PropInfo) // 从流中读取属性
else begin
Instance.DefineProperties(Self); // 调用自定义存储过程
if FPropName <> '' then PropertyError(FPropName); // 注意这里
end;
...
end;
ReadPropValue 方法基本上是使用 SetOrdProp、SetFloatProp、SetStrProp、GetEnumValue 等 RTTI 函数设置元件的属性值，它的代码冗长而简单，不再单独列出。下面介绍比较重要的 DefineProperties 函数。
===============================================================================
⊙ TPersistent.DefineProperties 虚方法
===============================================================================
DefineProperties 虚方法用于元件设计者自定义非 published 属性的存储和读取方法。 TPersistent 定义的该方法是个空方法，到 TComponent 之后被重载。
procedure TPersistent.DefineProperties(Filer: TFiler); virtual;
下面以 TComponent 为例说明该方法的用法：
procedure TComponent.DefineProperties(Filer: TFiler);
var
Ancestor: TComponent;
Info: Longint;
begin
Info := 0;
Ancestor := TComponent(Filer.Ancestor);
if Ancestor <> nil then Info := Ancestor.FDesignInfo;
Filer.DefineProperty('Left', ReadLeft, WriteLeft,
LongRec(FDesignInfo).Lo <> LongRec(Info).Lo);
Filer.DefineProperty('Top', ReadTop, WriteTop,
LongRec(FDesignInfo).Hi <> LongRec(Info).Hi);
end;
DefineProperties 调用 Filer.DefineProperty 或 DefineBinaryProperty 方法读写流中属性值。
TReader.DefineProperty 方法检查传入的属性名称是否与当前流中读到的属性名称相同，如果相同，则调用传入的 ReadData 方法读取数据，并设置 FPropName 为空，用以通知 ReadProperty 已经完成读属性值的工作，否则将会触发异常。
procedure TReader.DefineProperty(const Name: string;
ReadData: TReaderProc; WriteData: TWriterProc; HasData: Boolean);
begin
if SameText(Name, FPropName) and Assigned(ReadData) then
begin
ReadData(Self);
FPropName := '';
end;
end;
TWriter.DefineProperty 根据 HasData 参数决定是否需要写属性值。
procedure TWriter.DefineProperty(const Name: string;
ReadData: TReaderProc; WriteData: TWriterProc; HasData: Boolean);
begin
if HasData and Assigned(WriteData) then
begin
WritePropName(Name);
WriteData(Self);
end;
end;
如果 Filer.Ancestor 不是 nil，表示当前正在读取的元件继承自表单父类中的元件，元件设计者可以根据 Ancestor 判断是否需要写属性至流中。例如：当前元件的属性值与原表单类中的元件属性值相同的时候，可以不写入(通常是这样设计)。
ReadData、WriteData 参数是从 Filer 对象中读写数据的方法地址，它们的类型是：
TReaderProc = procedure(Reader: TReader) of object;
TWriterProc = procedure(Writer: TWriter) of object;
比如：
procedure TComponent.ReadLeft(Reader: TReader);
begin
LongRec(FDesignInfo).Lo := Reader.ReadInteger;
end;
procedure TComponent.WriteLeft(Writer: TWriter);
begin
Writer.WriteInteger(LongRec(FDesignInfo).Lo);
end;
对于二进制格式的属性值，可以使用 TFiler.DefineBinaryProperty 方法读写：
procedure DefineBinaryProperty(const Name: string;
ReadData, WriteData: TStreamProc; HasData: Boolean); override;
TStreamProc = procedure(Stream: TStream) of object;
Stream 参数是从流中读出的二进制数据或要写入二进制数据的流对象句柄。
注意：自己定义属性的读写方法时要记得调用 inherited DefineProperties(Filer)，否则祖先类的自定义属性读写操作不会进行。TControl 是个例外，因为它已经定义了 published Left 和 Top 属性。
===============================================================================
⊙ TReader.ReadComponent 方法
===============================================================================
ReadComponent 的执行过程与 ReadRootComponent 的过程很相似，它根据流中的信息使用 FindComponentClass 方法找到元件类在内存中的地址，然后调用该元件类的构造函数创建对象，接下来调用新建对象的 ReadState -> TReader.ReadData -> ReadDataInner -> TReader.ReadProperty，重复 ReadRootComponent 的过程。
{ TReader }
function ReadComponent(Component: TComponent): TComponent;
TReader.ReadComponent 和 TComponent.ReadState 形成递归调用过程，把表单上嵌套的元件创建出来。
===============================================================================
⊙ TReader.ReadValue / TReader.NextValue 系列方法
===============================================================================
ReadValue 方法从流中读出一个 TValueType 类型的数据，它主要由其它的方法调用。
TValueType 中只有 vaList 比较特殊，它表示后面的数据是一个属性值系列，以 vaNull 结束。其余的枚举值的都是指属性的数据类型或值。
TValueType = (vaNull, vaList, vaInt8, vaInt16, vaInt32, vaExtended,
vaString, vaIdent, vaFalse, vaTrue, vaBinary, vaSet, vaLString,
vaNil, vaCollection, vaSingle, vaCurrency, vaDate, vaWString,
vaInt64, vaUTF8String);
function TReader.ReadValue: TValueType;
begin
Read(Result, SizeOf(Result));
end;
NextValue 方法调用 ReadValue 返回流中下一个数据的类型，然后将流指针回退至读数据之前。通常用于检测流中下一个数据的类型。
function TReader.NextValue: TValueType;
begin
Result := ReadValue;
Dec(FBufPos);
end;
CheckValue 方法调用 ReadValue 检查下一个数据类型是否是指定的类型，如果不是则触发异常。
ReadListBegin 方法检查下一个数据是否是 vaList，它调用 CheckValue 方法。
ReadListEnd 方法检查下一个数据是否是 vaNull，它调用 CheckValue 方法。
SkipValue 方法使用 ReadValue 获得下一个数据的类型，然后将流指针跳过这个数据。
===============================================================================
⊙ TReader.ReadStr 方法
===============================================================================
ReadStr 方法读出流中的短字符串，TReader 内部使用它读取属性名称等字符串，元件设计者应该使用 ReadString 函数读取属性值。
function ReadStr: string;
===============================================================================
⊙ TReader.ReadInteger / ReadString / ReadBoolean 系列方法
===============================================================================
TReader 有一系列读取属性值的函数，可供元件设计者使用。
function ReadInteger: Longint;
function ReadInt64: Int64;
function ReadBoolean: Boolean;
function ReadChar: Char;
procedure ReadCollection(Collection: TCollection);
function ReadFloat: Extended;
function ReadSingle: Single;
function ReadCurrency: Currency;
function ReadDate: TDateTime;
function ReadIdent: string;
function ReadString: string;
function ReadWideString: WideString;
function ReadVariant: Variant;
===============================================================================
⊙ TReader.Read 方法
===============================================================================
TReader 中所有的数据都是通过 TReader.Read 方法读取的。TReader 不直接调用 TStream 的读方法是因为 TReader 的读数据操作很频繁，它自己建立了一个缓冲区(4K)，只有当缓冲区中的数据读完之后才会调用 TStream.Read 再读入下一段数据，这样可以极大地加快读取速度。Read 是个汇编函数，编写得很巧妙，它的代码及注释如下：
procedure TReader.Read(var Buf; Count: Longint); assembler;
asm
PUSH ESI
PUSH EDI
PUSH EBX
MOV EDI,EDX ; EDI <- @Buf
MOV EBX,ECX ; EBX <- Count
MOV ESI,EAX ; ESI <- Self
JMP @@6 ; check if Count = 0
{ @@1: 检查 TReader 的缓冲数据是否用尽 }
@@1: MOV ECX,[ESI].TReader.FBufEnd ; ECX <- FBufEnd
SUB ECX,[ESI].TReader.FBufPos ; if FBufEnd > FBufPos jmp @@2
JA @@2
MOV EAX,ESI ; else EAX <- Self
CALL TReader.ReadBuffer ; call ReadBuffer
MOV ECX,[ESI].TReader.FBufEnd ; ECX <- FBufEnd
{ @@2: 检查要读出的数量是否超过缓冲区大小，如是则分批读取 }
@@2: CMP ECX,EBX ; if FBufEnd < Count jmp @@3
JB @@3
MOV ECX,EBX ; else ECX <- Count
{ @@3: 分批读取缓冲区 }
@@3: PUSH ESI
SUB EBX,ECX ; Count = Count - FBufEnd
MOV EAX,[ESI].TReader.FBuffer ; EAX <- FBuffer
ADD EAX,[ESI].TReader.FBufPos ; EAX = FBuffer + FBufPos
ADD [ESI].TReader.FBufPos,ECX ; FBufPos = FBufPos + FBufEnd
MOV ESI,EAX ; ESI <- Curr FBuffer Addr
MOV EDX,ECX ; EDX <- FBufEnd
SHR ECX,2 ; ECX <- FBufEnd / 4
CLD
REP MOVSD ; Copy Buffer
MOV ECX,EDX ; ECX <- FBufEnd
AND ECX,3 ; Check if FBufEnd Loss 3
REP MOVSB ; Copy left Buff
POP ESI ; ESI <- Self
{ @@6: 检查是否读完数据，然后重复 @@1 或退出 }
@@6: OR EBX,EBX ; if Count = 0 then Exit
JNE @@1 ; Repeat ReadBuffer
POP EBX
POP EDI
POP ESI
end;
===============================================================================
⊙ ObjectBinaryToText / ObjectTextToBinary 函数
===============================================================================
Classes.pas 中的 ObjectBinaryToText 和 ObjectTextToBinary 函数用于把对象属性信息转换为文本形式或二进制形式。
procedure ObjectBinaryToText(Input, Output: TStream);
procedure ObjectTextToBinary(Input, Output: TStream);
新建一个项目，在表单上放置一个 TMemo 控件，然后执行以下代码，就能明白这两个函数的作用了。在 Delphi 的 IDE 中，将 DFM 文件进行二进制和文本方式的转换应该是通过这两个函数进行的。
var
InStream, OutStream: TMemoryStream;
begin
InStream := TMemoryStream.Create;
OutStream := TMemoryStream.Create;
InStream.WriteComponent(Self);
InStream.Seek(0, soFromBeginning);
ObjectBinaryToText(InStream, OutStream);
OutStream.Seek(0, soFromBeginning);
Memo1.Lines.LoadFromStream(OutStream);
end;
上面的两个函数还有一对增强版本，它们增加了对资源文件格式的转换，实际上也是调用了上面的函数：
procedure ObjectResourceToText(Input, Output: TStream);
procedure ObjectTextToResource(Input, Output: TStream);
Delphi 编译程序生成应用程序的资源数据段，应该是用 ObjectTextToResource 函数进行的。
注：ObjectTextToBinary 调用了 TParser 对象进行字符串解析工作。
目录
===============================================================================
⊙ RTTI 简介
⊙ 类(class) 和 VMT 的关系
⊙ 类(class)、类的类(class of class)、类变量(class variable) 的关系
⊙ TObject.ClassType 和 TObject.ClassInfo
⊙ is 和 as 运算符的原理
⊙ TTypeInfo – RTTI 信息的结构
⊙ 获取类(class)的属性(property)信息
⊙ 获取方法(method)的类型信息
⊙ 获取有序类型(ordinal)、集合(set)类型的 RTTI 信息
⊙ 获取其它数据类型的 RTTI 信息
===============================================================================
本文排版格式为：
正文由窗口自动换行；所有代码以 80 字符为边界；中英文字符以空格符分隔。
(作者保留对本文的所有权利，未经作者同意请勿在在任何公共媒体转载。)
正文
===============================================================================
⊙ 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); // loses return 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
case PropList[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 = packed record
case TTypeKind of
tkClass: (
ClassType: TClass; // 类 (VMTptr)
ParentInfo: PPTypeInfo; // 父类的 RTTI 指针
PropCount: SmallInt; // 属性数量
UnitName: ShortStringBase; // 单元的名称
{PropData: TPropData}); // 属性的详细信息
end;
其中的 PropData 又是一个大小可变的字段。TPropData 的定义如下：
TPropData = packed record
PropCount: Word; // 属性数量
PropList: record end; // 占位符，真正的意义在下一行
{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) to Integer(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 = mkFunction then
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 = packed record
case TTypeKind of
tkMethod: (
MethodKind: TMethodKind; // 方法指针的类型
ParamCount: Byte; // 参数数量
ParamList: array[0..1023] of Char // 参数详细信息，见下行注释
{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^.MinValue to 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 和动态数组不太熟悉，就不作介绍了。
Delphi 的RTTI机制浅探<二> |
本文上篇基本上是 RTTI 入门介绍，续篇介绍了所有 TypInfo.pas 中的函数，附加了 Classes.pas、Graphics.pas、Controls.pas 中的几个 RTTI 相关函数。对于关键函数的代码提供汇编注释。希望本文覆盖了 Delphi 中 80% 的 RTTI 函数。时间仓促，错误难免，敬请批评指正。
本文排版格式为：
正文由窗口自动换行；所有代码以 80 字符为边界；中英文字符以空格符分隔。
(作者保留对本文的所有权利，未经作者同意请勿在在任何公共媒体转载。)
目 录
===============================================================================
⊙ 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。
function GetPropInfo(TypeInfo: PTypeInfo; const PropName: string): PPropInfo;
function GetPropInfo(Instance: TObject; const PropName: string;
AKinds: TTypeKinds = []): PPropInfo;
function GetPropInfo(AClass: TClass; const PropName: string;
AKinds: TTypeKinds = []): PPropInfo;
function GetPropInfo(TypeInfo: PTypeInfo; const PropName: 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 数组中。
注意：这个函数不负责分配该数组的内容，使用前必须根据属性的数量分配足够的空间。该数组结束后必须清除分配的内容。
procedure GetPropInfos(TypeInfo: PTypeInfo; PropList: PPropList);
注：使用 GetPropList 实现相同的功能更方便。
===============================================================================
⊙ SortPropList 函数
===============================================================================
SortPropList 可以对 GetPropInfos 函数填充的属性信息指针数组按属性名称排序。
procedure SortPropList(PropList: PPropList; PropCount: Integer);
在 VCL 中 SortPropList 只被 GetPropList 函数使用。
===============================================================================
⊙ GetPropList 函数
===============================================================================
GetPropList 函数同 GetPropInfos 一样，填充 PPropList 数组。GetPropList 实际上是调用 GetPropInfos 进行填充工作，最后返回已填充的属性的数量。
function GetPropList(TypeInfo: PTypeInfo; TypeKinds: TTypeKinds;
PropList: PPropList; SortList: Boolean): Integer;
function GetPropList(TypeInfo: PTypeInfo; out PropList: PPropList): Integer;
function GetPropList(AObject: TObject; out PropList: PPropList): Integer;
注意：GetPropList 的内存分配有点混乱，上面第一个 GetPropList 必须自己分配 PPrpList 数组的内存，后面二个 GetPropList 会自动分配 PPropList 数组的内存。造成这种情况的原因是：第一个 GetPropList 可以设置 TypeKinds 参数限制只返回指定类型的属性，这样就不能直接得到可能返回的属性数量。TypeKinds 参数可以设置为 tkAny，表示返回所有数据类型的属性。
第一个 GetPropList 函数可以设置 SortList 参数对属性名称进行排序。它实际上是调用第二个 GetPropList 并调用 SortPropList 函数执行排序。
注意：PPropList 不再使用的时候，要记得使用 FreeMem 函数清除数组内存(根据返回值是否大于1)。
===============================================================================
⊙ GetObjectPropClass 函数
===============================================================================
GetObjectPropClass 函数用于返回对象类型的属性所属的类(class)。
function GetObjectPropClass(Instance: TObject; PropInfo: PPropInfo): TClass;
function GetObjectPropClass(Instance: TObject; const PropName: string): TClass;
function GetObjectPropClass(PropInfo: PPropInfo): TClass;
这个函数被 SetObjectProp 函数使用，用于参数检验。
===============================================================================
⊙ PropType / PropIsType 函数
===============================================================================
PropType 函数用于获得属性的数据类型。
function PropType(Instance: TObject; const PropName: string): TTypeKind;
function PropType(AClass: TClass; const PropName: string): TTypeKind;
PropIsType 判断属性是否属于某种数据类型。它调用 PropType 实现功能。
function PropIsType(Instance: TObject; const PropName: string;
TypeKind: TTypeKind): Boolean;
function PropIsType(AClass: TClass; const PropName: string;
TypeKind: TTypeKind): Boolean;
===============================================================================
⊙ IsPublishedProp 函数
===============================================================================
IsPublishedProp 函数用于判断属性是否是 published 属性，它通过检查该属性 RTTI 指针是否等于 nil 来实现功能。
function IsPublishedProp(Instance: TObject; const PropName: string): Boolean;
function IsPublishedProp(AClass: TClass; const PropName: string): Boolean;
IsPublishedProp 函数没有被 VCL 使用。
===============================================================================
⊙ IsStoredProp 函数
===============================================================================
IsStoredProp 函数使用属性信息中的 TPropInfo.StoredProp 函数指针来调用属性定义时用 stored 关键字定义的函数的结果。
这个函数被用于 Delphi 持续机制，TWriter.WriteProperties 方法调用 IsStoredProp 判断是否需要把该属性的值写入流中。
function IsStoredProp(Instance: TObject; PropInfo: PPropInfo): Boolean;
function IsStoredProp(Instance: TObject; const PropName: string): Boolean;
===============================================================================
⊙ FreeAndNilProperties 函数
===============================================================================
FreeAndNilProperties 函数用于清除一个对象的所有 published 的对象类型的属性的对象。这个函数调用 GetObjectProp 执行获得对象属性的对象句柄，并调用对象的 Free 方法清除这个对象，然后调用 SetObjectProp 设置该属性为 nil。
procedure FreeAndNilProperties(AObject: TObject);
我不知道这个函数能用在哪里，至少 VCL 中没有使用这个函数。
===============================================================================
⊙ SetToString / StringToSet 函数
===============================================================================
SetToString 和 StringToSet 是两个 RTTI 辅助函数，它们把集合值转换为字符串，或者把字符串转换为集合值。
function SetToString(PropInfo: PPropInfo; Value: Integer;
Brackets: Boolean = False): string;
function StringToSet(PropInfo: PPropInfo; const Value: string): Integer;
注意：这里的集合值最多只能包含 32 个元素(4 bytes)，这是集合 RTTI 的限制。
===============================================================================
⊙ GetEnumName / GetEnumValue / GetEnumNameValue 函数
===============================================================================
GetEnumName 函数根据枚举整数值返回枚举字符串。它可以返回以下三种枚举名称：
Integer：直接返回 IntToStr(Integer)
Boolean：返回 True/False
Enum ：返回 TTypeData^.NameList 中存储的枚举名称
function GetEnumName(TypeInfo: PTypeInfo; Value: Integer): string;
GetEnumValue 函数根据枚举字符串返回枚举整数值。它与 GetEnumName 类似，可以返回三种枚举的整数值，但对于 Enum 类型，它调用了 GetEnumNameValue 函数。
function GetEnumValue(TypeInfo: PTypeInfo; const Name: string): Integer;
GetEnumNameValue 函数与 GetEnumValue 函数功能差不多，但它是个汇编函数，只能返回纯枚举类型的值。其工作原理也是匹配 TTypeData^.NameList 值。
function GetEnumNameValue(TypeInfo: PTypeInfo; const Name: string): Integer;
注意：GetEnumNameValue 隐藏在 Implementation 段，不能直接使用，它是为 GetEnumValue 函数服务的。
===============================================================================
⊙ GetOrdProp 函数详解
===============================================================================
GetOrdProp 是 Delphi RTTI 中使用频繁的函数。GetOrdProp 根据对象句柄和对象属性的 TPropInfo 指针获得对象的属性值。它的返回值是 Longint，需要强制转换成相应的属性类型才能使用。
function GetOrdProp(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 dword ptr [ECX] { call vmt[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 是字段偏移、虚方法偏移和静态方法。
procedure SetOrdProp(Instance: TObject; PropInfo: PPropInfo; Value: Longint);
SetOrdProc 也根据属性名称重载了：
procedure SetOrdProp(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 的返回值。
function GetEnumProp(Instance: TObject; PropInfo: PPropInfo): string;
function GetEnumProp(Instance: TObject; const PropName: string): string;
SetEnumProp 函数使用枚举字符串设置枚举类型属性值，它调用 GetEnumValue 转换枚举字符串后再调用 SetOrdProp 设置属性值。
procedure SetEnumProp(Instance: TObject; PropInfo: PPropInfo;
const Value: string);
procedure SetEnumProp(Instance: TObject; const PropName: string;
const Value: string);
===============================================================================
⊙ GetSetProp / SetSetProp 函数
===============================================================================
GetSetProp 函数用于获取集合类型属性的字符串值，它也是调用 GetOrdProp 获得属性值，然后调用 SetToString 函数把数值转换成字符串。
注意：GetOrdProp 函数返回值是 Integer，那么它是如何表示可以存储 256 个元素的集合类型呢？答案是：如果是 published 集合属性，那么该集合最大只能是 4 个字节，也就是最多只能存储 32 个元素。
function GetSetProp(Instance: TObject; PropInfo: PPropInfo;
Brackets: Boolean): string;
function GetSetProp(Instance: TObject; const PropName: string;
Brackets: Boolean = False): string;
SetSetProp 函数用于通过字符串设置集合类型属性的值。它先调用 StringToSet 函数把字符串转换为整数值，然后使用 SetOrdProp 函数设置属性值。
procedure SetSetProp(Instance: TObject; PropInfo: PPropInfo;
const Value: string);
procedure SetSetProp(Instance: TObject; const PropName: string;
const Value: string);
试验： SetSetProp(Self, 'BorderIcons', '[biSystemMenu]');
===============================================================================
⊙ GetObjectProp / SetObjectProp 函数
===============================================================================
对象实际上是指针，也就是整数值，所以 GetObjectProp 直接调用 GetOrdProp 就可以了。
MinClass 参数指定得到的 Object 必须属于某个 class ，如果不是则返回 nil 。
function GetObjectProp(Instance: TObject; PropInfo: PPropInfo;
MinClass: TClass = nil): TObject;
function GetObjectProp(Instance: TObject; const PropName: string;
MinClass: TClass = nil): TObject;
SetObjectProp 用于设置属性的对象句柄。ValidateClass 参数表示是否需要检查传入的对象类型与属性信息的类信息是否兼容。
procedure SetObjectProp(Instance: TObject; PropInfo: PPropInfo;
Value: TObject; ValidateClass: Boolean = True);
procedure SetObjectProp(Instance: TObject; const PropName: string;
Value: TObject);
例子：
var
MyFont: TFont;
begin
MyFont := TFont.Create;
MyFont.Height := 20;
SetObjectProp(Self, 'Font', MyFont);
end;
===============================================================================
⊙ GetStrProp / SetStrProp 函数
===============================================================================
GetStrProp 函数用于获得字符串类型的属性值。
function GetStrProp(Instance: TObject; PropInfo: PPropInfo): string;
function GetStrProp(Instance: TObject; const PropName: string): string;
由于 Delphi 支持三种类型的字符串，GetStrProp 根据字符串的类型，分别调用三个获得字符串属性值的函数：
case PropInfo^.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 类似。
procedure SetStrProp(Instance: TObject; PropInfo: PPropInfo;
const Value: string);
procedure SetStrProp(Instance: TObject; const PropName: string;
const Value: string);
===============================================================================
⊙ GetFloatProp / SetFloatProp 函数
===============================================================================
GetFloatProp 用于获得浮点型属性值。它将 Single(4 bytes)、Double(8 bytes)、Comp(8 bytes)、Currency(8 bytes) 类型的浮点数属性转换为 Extented(10 bytes) 类型返回。
function GetFloatProp(Instance: TObject; PropInfo: PPropInfo): Extended;
function GetFloatProp(Instance: TObject; const PropName: string): Extended;
SetFloatProp 用于设置浮点型属性值。它的实现方法与 GetFloatProp 类似。
procedure SetFloatProp(Instance: TObject; PropInfo: PPropInfo;
const Value: Extended);
procedure SetFloatProp(Instance: TObject; const PropName: string;
const Value: Extended);
===============================================================================
⊙ GetVariantProp / SetVariantProp
===============================================================================
GetVariantProp 函数用于获得 Variant 类型的属性值。
function GetVariantProp(Instance: TObject; PropInfo: PPropInfo): Variant;
function GetVariantProp(Instance: TObject; const PropName: string): Variant;
SetVariantProp 函数用于设置 Variant 类型的属性值。
procedure SetVariantProp(Instance: TObject; PropInfo: PPropInfo;
const Value: Variant);
procedure SetVariantProp(Instance: TObject; const PropName: string;
const Value: Variant);
===============================================================================
⊙ GetMethodProp / SetMethodProp
===============================================================================
GetMethodProp 函数用于获得 Method 类型的属性值。
function GetMethodProp(Instance: TObject; PropInfo: PPropInfo): TMethod;
function GetMethodProp(Instance: TObject; const PropName: string): TMethod;
SetMethodProp 函数用于设置 Method 类型的属性值。
procedure SetMethodProp(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 的获取和设置方法。
function GetInt64Prop(Instance: TObject; PropInfo: PPropInfo): Int64;
function GetInt64Prop(Instance: TObject; const PropName: string): Int64;
SetInt64Prop 函数用于设置 Int64 类型的属性值。
procedure SetInt64Prop(Instance: TObject; PropInfo: PPropInfo;
const Value: Int64);
procedure SetInt64Prop(Instance: TObject; const PropName: string;
const Value: Int64);
===============================================================================
⊙ GetInterfaceProp / SetInterfaceProp 函数
===============================================================================
GetInterfaceProp 函数用于获得 Interface 类型的属性值。
function GetInterfaceProp(Instance: TObject; PropInfo: PPropInfo): IInterface;
function GetInterfaceProp(Instance: TObject; const PropName: string): IInterface;
SetInterfaceProp 函数用于设置 Interface 类型的属性值。
procedure SetInterfaceProp(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 还可以返回动态数组类型的属性值。(目前对动态数组不太熟悉，先记下来。)
function GetPropValue(Instance: TObject; const PropName: string;
PreferStrings: Boolean): Variant;
SetPropValue 函数用于设置任何类型的属性值。SetPropValue 的实现与 GetPropValue 类似。并且 SetPropValue 内部分析 Value 参数是否是字符串来设置枚举和集合类型的属性，所以不需要 PreferStrings 参数。SetPropValue 也可以设置动态数组属性，它使用了 SetOrdProp 函数实现这一功能，看来动态数组在内存中的表现是一个指针。
procedure SetPropValue(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)。
procedure RegisterClass(AClass: TPersistentClass);
RegisterClasses 函数可以方便地注册一批类：
procedure RegisterClasses(AClasses: array of TPersistentClass);
RegisterClassAlias 函数可以为类以其它的名称注册，以避免名称冲突。
procedure RegisterClassAlias(AClass: TPersistentClass; const Alias: string);
GetClass 函数根据类名称字符串获得类(class)，如果没找到，将返回 nil：
function GetClass(const AClassName: string): TPersistentClass;
FindClass 函数包装了 GetClass，不同的是如果没找到该类，则触发异常(EClassNotFound)：
function FindClass(const ClassName: string): TPersistentClass;
UnRegisterClass 系列函数执行 RegisterClass 相反的工作：
procedure UnRegisterClass(AClass: TPersistentClass);
procedure UnRegisterClasses(AClasses: array of TPersistentClass);
procedure UnRegisterModuleClasses(Module: HMODULE);
缺省的 RegGroup 用于组织从 TPersistent 继承下来的类，下面五个函数可以设置自己的 RegGroup：
procedure StartClassGroup(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，表示转换是否成功。
function IdentToInt(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; var Ident: string): Boolean;
function IdentToCharset(const Ident: string; var Charset: Longint): Boolean;
function ColorToIdent(Color: Longint; var Ident: string): Boolean;
function IdentToColor(const Ident: string; var Color: Longint): Boolean;
{ Controls.pas }
function CursorToIdent(Cursor: Longint; var Ident: string): Boolean;
function IdentToCursor(const Ident: string; var Cursor: Longint): Boolean;
例子：
var
NewColor: Integer;
begin
if IdentToColor('clWindow', NewColor) then
Self.Color := NewColor;
end;
| |