Delphi中使用RTTI

概要

运行期类型信息(RTTI)是一种语言特征，能使应用程序在运行时得到关于对象的信息。

RTTI是Delphi的组件能够融合到IDE中的关键。它在IDE中不仅仅是一个纯学术的过程。 由于对象都是从TObject继承下来的，因此，对象都包含一个指向它们的RTTI的指针以及几个内建的方法。下面的表列出了TObject的一些方法，用这些方法能获得某个对象实例的信息。

第一部分：关于as 和 is

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

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

procedure TForm1.ClearEdit(Acontrl: TWinControl); var i : integer; begin for i := 0 to Acontrl.ControlCount-1 do begin if Acontrl.Controls[i] is TEdit then ((Acontrl.Controls[i]) as TEdit).Text := ''; if Acontrl.Controls[i] is TCustomControl then 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来完成通过配置信息对控件进行属性的赋值操作，这里将演示文本类型和事件类型的赋值。 窗体文件如下：代码如下：

object Form1: TForm1 Left = 150 Top = 161 Width = 639 Height = 372 Caption = 'Form1' Color = clBtnFace Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -11 Font.Name = 'Tahoma' Font.Style = [] OldCreateOrder = False OnCreate = FormCreate PixelsPerInch = 96 TextHeight = 13 object Panel1: TPanel Left = 0 Top = 0 Width = 631 Height = 185 Align = alTop TabOrder = 0 object GroupBox1: TGroupBox Left = 1 Top = 1 Width = 185 Height = 183 Align = alLeft Caption = '在这里选择要查看类型的信息' TabOrder = 0 object ListBox1: TListBox Left = 2 Top = 15 Width = 181 Height = 166 Align = alClient ItemHeight = 13 TabOrder = 0 OnClick = ListBox1Click end end object GroupBox2: TGroupBox Left = 368 Top = 1 Width = 262 Height = 183 Align = alRight Caption = '属性信息' TabOrder = 1 object ListBox3: TListBox Left = 2 Top = 15 Width = 258 Height = 166 Align = alClient ItemHeight = 13 TabOrder = 0 end end object GroupBox3: TGroupBox Left = 186 Top = 1 Width = 182 Height = 183 Align = alClient Caption = '基本信息' TabOrder = 2 object ListBox2: TListBox Left = 2 Top = 15 Width = 178 Height = 166 Align = alClient ItemHeight = 13 TabOrder = 0 end end end object TPanel Left = 0 Top = 185 Width = 631 Height = 157 Align = alClient TabOrder = 1 object Panel2: TPanel Left = 1 Top = 1 Width = 230 Height = 155 Align = alLeft TabOrder = 0 object Label2: TLabel Left = 10 Top = 8 Width = 84 Height = 13 Caption = '要修改的控件名' end object Label3: TLabel Left = 8 Top = 32 Width = 72 Height = 13 Caption = '修改的属性名' end object Label4: TLabel Left = 8 Top = 64 Width = 72 Height = 13 Caption = '将属性修改为' end object edComName: TEdit Left = 104 Top = 5 Width = 78 Height = 21 TabOrder = 0 Text = 'label1' end object edPproName: TEdit Left = 104 Top = 32 Width = 81 Height = 21 TabOrder = 1 Text = 'caption' end object edValue: TEdit Left = 104 Top = 56 Width = 81 Height = 21 TabOrder = 2 Text = '12345' end object btnInit: TButton Left = 8 Top = 104 Width = 75 Height = 25 Caption = '初始化' TabOrder = 3 OnClick = btnInitClick end object btnModify: TButton Left = 104 Top = 104 Width = 75 Height = 25 Caption = '修改' TabOrder = 4 OnClick = btnModifyClick end end object Panel3: TPanel Left = 231 Top = 1 Width = 399 Height = 155 Align = alClient TabOrder = 1 object GroupBox4: TGroupBox Left = 1 Top = 1 Width = 397 Height = 153 Align = alClient Caption = '被修改的控件' TabOrder = 0 object Label1: TLabel Left = 16 Top = 32 Width = 28 Height = 13 Caption = 'label1' end object BitBtn1: TBitBtn Left = 8 Top = 64 Width = 75 Height = 25 Caption = 'BitBtn1' TabOrder = 0 end end end end end

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); with AStrings 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 to classDataInfo.PropCount - 1 do begin if Pplst[i]^.PropType^.Kind <> tkMethod then //这里过滤掉了事件属性 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 to NumPro - 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 not Assigned(obj) then exit; //如果没有则退出 //通过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 = tkMethod then 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添加一些类型的类名 with ListBox1.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.

-END-