DELPHI中使用RTTI

运行期类型信息(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;
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

... {
   作者: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试试。