unit1.pas

在delphi下实现类似于java, C#等反射调用的一个例子

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ObjAuto2009, untTestClass, StdCtrls, TypInfo;

type
  TForm1 = class(TForm)
    Memo1:   TMemo;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Button5: TButton;
    Button6: TButton;
    Button7: TButton;
    edtText: TEdit;
    Button8: TButton;
    Button9: TButton;
    Button10: TButton;
    Button11: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button8Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure Button7Click(Sender: TObject);
    procedure Button9Click(Sender: TObject);
    procedure Button10Click(Sender: TObject);
    procedure Button11Click(Sender: TObject);
  private
    { Private declarations }
  public
    test: TTestClass;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button2Click(Sender: TObject);
var
  mi:    PMethodInfoHeader;
begin
  mi := GetMethodInfo(test, 'ShowText');
  ObjectInvoke(test,mi,[],[]);
end;

procedure TForm1.Button3Click(Sender: TObject);
var
  mi:    PMethodInfoHeader;
  s:string;
begin
  mi := GetMethodInfo(test, 'GetText');
  s := ObjectInvoke(test,mi,[],[]);
  ShowMessage(s);
end;

procedure TForm1.Button4Click(Sender: TObject);
var
  mi:    PMethodInfoHeader;
begin
  mi := GetMethodInfo(test, 'ShowText2');
  ObjectInvoke(test,mi,[1],['test show text 2']);

end;

procedure TForm1.Button5Click(Sender: TObject);
var
  mi:    PMethodInfoHeader;
  s:string;
begin
  mi := GetMethodInfo(test, 'Reverse');
  s := ObjectInvoke(test,mi,[1],['test reverse']);
  ShowMessage(s);
end;

procedure TForm1.Button6Click(Sender: TObject);
var
  mi:    PMethodInfoHeader;
  i: Integer;
begin
  mi := GetMethodInfo(test, 'AddInt');
  i := ObjectInvoke(test,mi,[2],[10,20]);
  ShowMessage(IntToStr(i));

end;

procedure TForm1.Button7Click(Sender: TObject);
var
  mi:    PMethodInfoHeader;
  i: Integer;
begin
  mi := GetMethodInfo(test, 'Add3');
  i := ObjectInvoke(test,mi,[3],[10,20, 30]);
  ShowMessage(IntToStr(i));

end;

procedure TForm1.Button8Click(Sender: TObject);
begin
  // 为类内的属性赋值
  SetStrProp(test,'Text',edtText.Text);
end;

procedure TForm1.Button9Click(Sender: TObject);
var
  mi:    PMethodInfoHeader;
begin
  mi := GetMethodInfo(test, 'ShowCaption');
  ObjectInvoke(test,mi,[1],[Integer(Button1)]);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  test := TTestClass.Create;
end;

procedure TForm1.Button10Click(Sender: TObject);
var
  mi:    PMethodInfoHeader;
  b: Integer;
begin
  mi := GetMethodInfo(test, 'FindButton');
  b := ObjectInvoke(test,mi,[1],[Integer(self), edtText.Text]);
  if b = 0 then
    Exit
  else
    ShowMessage(TButton(b).Caption);
end;

procedure TForm1.Button11Click(Sender: TObject);
var
  pa: TPropertyArray;
  p: PPropertyInfo;
begin
  Memo1.Lines.Clear;
  // 获取公开属性列表
  pa:=GetProperties(TTestClass);
  // 依次取出每个属性
  for p in pa do
  begin
    Memo1.Lines.Add(p^.Name);
    Memo1.Lines.Add('Data Type: '+p^.PropType^.Name);
    if p^.PropType^.Kind = tkMethod then
      Memo1.Lines.Add('  Property Type: Method');
    if p^.PropType^.Kind = tkClass then
      Memo1.Lines.Add('  Property Type: Object');
    memo1.Lines.Add('--------------------------');
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  miArr: TMethodInfoArray;
  mi:    PMethodInfoHeader;
  retInfo: PReturnInfo;
  piArr: TParamInfoArray;
  pi: PParamInfo;
begin
  Memo1.Lines.Clear;
  // 获取类内函数列表
  miArr := GetMethods(test.ClassType);
  
  // 依次取出每个函数
  for mi in miArr do
  begin
    memo1.Lines.Add('MethodName: ' + mi.Name);
    // 获取返回值信息
    retInfo := GetReturnInfo(test, mi.Name);

    // 判断是否有返回值，若有则Type为Function，否则为Procedure
    if retInfo.ReturnType = nil then
      memo1.Lines.Add('  Type: procedure')
    else
    begin
      memo1.Lines.Add('  Type: function');
      memo1.Lines.Add('  Returns: ' + retInfo.ReturnType^.Name);
    end;
    // 获取方法的参数列表
    piArr := GetParams(test, mi.Name);

    if piArr <> nil then
    begin
      // 依次取出每个参数
      for pi in piArr do
      begin
        // 过滤掉Reflection自动产生的SELF参数
        if UPPERCASE(pi.Name) = 'SELF' then
          Continue;
        memo1.Lines.Add('    ParamName: ' + pi.Name);
        memo1.Lines.Add('    ParamType: ' + pi.ParamType^.Name);
        memo1.Lines.Add('    ParamKind: ' + GetEnumName(
          typeinfo(TTypeKind), Ord(pi.ParamType^.Kind)));
      end;
    end;
    memo1.Lines.Add('--------------------------');
  end;
end;

end.