Delphi中怎么使用RTTI

今天就跟大家聊聊有关Delphi中怎么使用RTTI,可能很多人都不太了解,为了让大家更加了解,小编给大家总结了以下内容,希望大家根据这篇文章可以有所收获。

我们提供的服务有:成都网站建设、做网站、微信公众号开发、网站优化、网站认证、官渡ssl等。为上千家企事业单位解决了网站和推广的问题。提供周到的售前咨询和贴心的售后服务,是有科学管理、有技术的官渡网站制作公司

概要

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

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

Delphi中怎么使用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行进行指针转换来优化。

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]);

看完上述内容,你们对Delphi中怎么使用RTTI有进一步的了解吗?如果还想了解更多知识或者相关内容,请关注创新互联行业资讯频道,感谢大家的支持。


新闻名称:Delphi中怎么使用RTTI
转载注明:http://ybzwz.com/article/pgdpgi.html