RTTI练习代码

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls,typinfo;
 
 type
  PParamRecord =^TParamRecord;
   TParamRecord = record
      flag : TParamFlags;
      Name : shortstring;
      TypeName: shortString;
   end;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    procedure GetProp(aClass:Tobject;aStrings:TStrings);
    procedure GetMethodDefine(aclassinfo:PTypeInfo;aStrings:TStrings); // 取得方法的定义
    procedure getOrderType1(typei:Ptypeinfo;aStrings:TStrings);
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

type
  TMyMethod = function(A: array of Char; var B: TObject): Integer of object;
  TMyEnum = (EnumA, EnumB, EnumC);

procedure Tform1.GetProp(aClass:TObject;aStrings:TSTrings);
var
  typeData:PTypeData;
  typeInfo:PTypeInfo;
  typeProp:PPropList;
  i : integer;
begin
  TypeInfo := aClass.ClassInfo;
  TypeData := getTypeData(typeInfo);
  //i := TypeData.PropCount;
  getPropList(typeInfo,typeProp);  //　取得属性列表到 typeList
  //　以分配内存

  aStrings.Add('------- Property List -------');
  aStrings.Add('Name                     Type');
  for i:=0 to TypeData.PropCount-1 do
  begin
    // 　看当前的属性的属性类型 是否是 TkMethod
    if TypeProp[i].PropType^.kind <> tkmethod then
       aStrings.Add(format('%s                     %s',
       [TypeProp[i].Name,TypeProp[i].propType^.Name]));

  end;
  //　看有多少个方法类型
  i := getPropList(typeInfo,[tkMethod],TypeProp);
  aStrings.Add('');
  aStrings.Add('方法数为:'+IntTostr(i));
  aStrings.Add('Name                     Type');
  while i>0 do
  begin
    aStrings.Add(format('%s                     %s= %d',
    [TypeProp[i-1].name,typeProp[i-1].PropType^.name,i]));

    // 列出该方法的定义
    self.GetMethodDefine(typeprop[i-1]^.proptype^,astrings);
  //  上面我又对每个方法取得其详细的定义

    dec(i);
  end;
  //　释放内存
  freeMem(typeProp,sizeof(TPropInfo)*Typedata.PropCount);
end;

 

 

// 下面这个有点问题，没有把过程或函数组重新组合好，不过都能把参数及类型取出来

procedure TForm1.GetMethodDefine(aClassinfo:ptypeinfo;aStrings:TStrings);
var
  ParamRecord : PParamRecord;
  TypeData : pTypeData;
  TypeInfo : PTypeInfo;
  PropList : PPropList;
  typStr : ^shortString;
  i :integer;
  j :integer;
  s :string;
begin
  //TypeInfo := aClass.ClassInfo;
  TypeData := GetTypeData(aClassInfo);

  case TypeData.MethodKind of
    typinfo.mkProcedure : s := 'procedure';
    typinfo.mkFunction  : s := 'function';
    typinfo.mkConstructor : s:= 'constructor';
    typinfo.mkDestructor :  s:= 'destructor';
    typinfo.mkClassProcedure : s:= 'class procedure';
    typinfo.mkClassFunction : s := 'class function';
   
  end;
  ParamRecord := @typeData.ParamList;
  i :=1;
  memo1.Lines.Add(inttostr(typedata.ParamCount));

  while i<= TypeData.ParamCount do
  begin

     if i=1 then
       s := s+'(';
     if typinfo.pfVar in ParamRecord^.flag then
       s := s+'var ';
     if typinfo.pfConst in paramRecord^.flag then
       s := s+'const ';
     if typinfo.pfArray in paramRecord^.flag then
       s := s+ 'array of ';
     if typinfo.pfOut in paramRecord^.flag then
       s := s+ 'out ';

     typstr := pointer(integer(@paramRecord.Name)+length(paramRecord.Name)+1);

     s := s+ParamRecord.Name+typStr^;
     inc(i); //　到下一个参数
     paramRecord := PParamRecord(integer(paramRecord)+sizeof(paramRecord.flag)+1+
     length(paramRecord.Name)+length(typstr^)+1);
     if i<=Typedata.ParamCount then
     begin
       s := s+';';
     end
     else
       s := s+')';

     if TypeData.MethodKind = mkFunction then
     begin
       typstr := pointer(paramRecord);
       s := s+':'+typstr^;
     end;
  end;
  aStrings.Add(s);

end;

//取得有序类型，枚举，集合的信息
procedure tform1.getOrderType1(typei:Ptypeinfo;aStrings:TStrings);

var
  typekindStr:string;
  typeD:Ptypedata;

  i :integer;
begin

  typed:=getTypeData(typei);
  aStrings.Add('TypeName='+typei.Name);
  TypeKindStr := GetEnumName(typeInfo(TTypeKind),Integer(TypeI.Kind));

  aStrings.Add('KindType='+typeKindStr);

  aStrings.add('DataType='+GetEnumName(TypeInfo(TOrdType),integer(typed.OrdType)));

  if typei.Kind<>tkset then
  begin
    astrings.Add('max='+inttostr(typed.MaxValue));
    astrings.Add('min='+inttostr(typed.MinValue));

  end;
  if typei.Kind = tkset then
    self.getOrderType1(typed^.comptype^,astrings);
  if typei.Kind = typinfo.tkEnumeration then
  begin
     for i:=typed.MinValue to typed.MaxValue do
       astrings.Add(format('%d value %s',[i,getEnumName(typei,i)]));
  end;

 
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
  self.GetProp(form1,memo1.Lines);
end;

procedure TForm1.Button2Click(Sender: TObject);

begin
  //getMethodTypeInfo(typeInfo(tmyMethod),memo1.Lines);
  //self.GetMethodDefine(PTypeInfo(typeInfo(TNotifyEvent)),memo1.Lines);
  //self.GetMethodDefine(PTypeInfo(TypeInfo(TMouseEvent)),memo1.Lines);
  //self.GetMethodDefine(typeinfo(tmyMethod),memo1.Lines);
  self.getOrderType1(typeinfo(integer),memo1.Lines);
  self.getOrderType1(typeinfo(tformBorderstyle),memo1.Lines);
  self.getOrderType1(typeinfo(tmyenum),memo1.Lines);

end;

end.