DELPHI中使用RTTI - 王朝网络

运行期类型信息(RTTI)是一种语言特征，能使应用程序在运行时得到关于对象的信息。RTTI是Delphi的组件能够融合到IDE中的关键。它在IDE中不仅仅是一个纯学术的过程。

由于对象都是从TObject继承下来的，因此，对象都包含一个指向它们的RTTI的指针以及几个内建的方法。下面的表列出了TObject的一些方法，用这些方法能获得某个对象实例的信息。

函数

返回类型

返回值

ClassName( )

string

对象的类名

ClassType()

boolean

对象的类型

InheritsFrom

boolean

判断对象是否继承于一个指定的类

ClassParent()

TClass

对象的祖先类型

Instancesize()

word

对象实例的长度(字节数)

ClassInfo()

Pointer

指向RTTI的指针

第一部分：关于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行进行指针转换来优化。

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

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;

第二部分：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

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

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

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

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

...{

作者: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);

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;

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;

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;

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;

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;

procedure TForm1.MyClick(Sender: TObject);

begin

//给指定控件添加的一个方法

ShowMessage('wudi_1982');

end;

initialization

//初始化的时候注册

RegisterClasses([TApplication,TButton,TEdit,TMemo,TForm]);

end.

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

程序效果图如下：

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