运行期类型信息(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属性
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来完成通过配置信息对控件进行属性的赋值操作,这里将演示文本类型和事件类型的赋值。
窗体文件如下:代码如下:
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
作者: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;
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.
注:示例程序在winxp+D7以及turbo delphi+winxp下测试通过。Borland文档中不包含将来也许会有版本变化的功能。当使用如RTTI等无文档说明的功能时,就不能保证你的程序可以完全移植到Delphi的未来版本。转载请注明出处!
程序效果图如下:
编译、运行程序,你可以通过点击左上角列表框中的类型,获得他们的信息。而在窗体的下部,主要演示了通过读取配置信息来对控件的属性赋值(例程中的配置信息是通过edit输入的,可以在实际运用中改成从配置文件读取)。当使用下半部分功能时,在默认情况下,点击初始化按钮,然后点击修改,你会发现label1的caption变成了12345,并在在鼠标点击的时候会弹出一个对话框,你可以尝试把第一个edit的内容改成bitbtn1试试。