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试试。
 
相关推荐
<p> <span style="font-size:14px;color:#E53333;">限时福利1:</span><span style="font-size:14px;">购课进答疑群专享柳峰(刘运强)老师答疑服务</span> </p> <p> <br /> </p> <p> <br /> </p> <p> <span style="font-size:14px;"></span> </p> <p> <span style="font-size:14px;color:#337FE5;"><strong>为什么需要掌握高性能的MySQL实战?</strong></span> </p> <p> <span><span style="font-size:14px;"><br /> </span></span> <span style="font-size:14px;">由于互联网产品用户量大、高并发请求场景多,因此对MySQL的性能、可用性、扩展性都提出了很高的要求。使用MySQL解决大量数据以及高并发请求已经是程序员的必备技能,也是衡量一个程序员能力和薪资的标准之一。</span> </p> <p> <br /> </p> <p> <span style="font-size:14px;">为了让大家快速系统了解高性能MySQL核心知识全貌,我为你总结了</span><span style="font-size:14px;">「高性能 MySQL 知识框架图」</span><span style="font-size:14px;">,帮你梳理学习重点,建议收藏!</span> </p> <p> <br /> </p> <p> <img alt="" src="https://img-bss.csdnimg.cn/202006031401338860.png" /> </p> <p> <br /> </p> <p> <span style="font-size:14px;color:#337FE5;"><strong>【课程设计】</strong></span> </p> <p> <span style="font-size:14px;"><br /> </span> </p> <p> <span style="font-size:14px;">课程分为四大篇章,将为你建立完整的 MySQL 知识体系,同时将重点讲解 MySQL 底层运行原理、数据库的性能调优、高并发、海量业务处理、面试解析等。</span> </p> <p> <span style="font-size:14px;"><br /> </span> </p> <p> <span style="font-size:14px;"></span> </p> <p style="text-align:justify;"> <span style="font-size:14px;"><strong>一、性能优化篇:</strong></span> </p> <p style="text-align:justify;"> <span style="font-size:14px;">主要包括经典 MySQL 问题剖析、索引底层原理和事务与锁机制。通过深入理解 MySQL 的索引结构 B+Tree ,学员能够从根本上弄懂为什么有些 SQL 走索引、有些不走索引,从而彻底掌握索引的使用和优化技巧,能够避开很多实战遇到的“坑”。</span> </p> <p style="text-align:justify;"> <br /> </p> <p style="text-align:justify;"> <span style="font-size:14px;"><strong>二、MySQL 8.0新特性篇:</strong></span> </p> <p style="text-align:justify;"> <span style="font-size:14px;">主要包括窗口函数和通用表表达式。企业的许多报表统计需求,如果不采用窗口函数,用普通的 SQL 语句是很难实现的。</span> </p> <p style="text-align:justify;"> <br /> </p> <p style="text-align:justify;"> <span style="font-size:14px;"><strong>三、高性能架构篇:</strong></span> </p> <p style="text-align:justify;"> <span style="font-size:14px;">主要包括主从复制和读写分离。在企业的生产环境,很少采用单台MySQL节点的情况,因为一旦单个节点发生故障,整个系统都不可用,后果往往不堪设想,因此掌握高可用架构的实现是非常有必要的。</span> </p> <p style="text-align:justify;"> <br /> </p> <p style="text-align:justify;"> <span style="font-size:14px;"><strong>四、面试篇:</strong></span> </p> <p style="text-align:justify;"> <span style="font-size:14px;">程序员获得工作的第一步,就是高效的准备面试,面试篇主要从知识点回顾总结的角度出发,结合程序员面试高频MySQL问题精讲精练,帮助程序员吊打面试官,获得心仪的工作机会。</span> </p>
©️2020 CSDN 皮肤主题: 数字20 设计师:CSDN官方博客 返回首页