delphi通过方法名调用方法

delphi通过方法名调用方法

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs,
  Vcl.StdCtrls;

type
  TFunc = procedure(Param: string) of object;          //定义方法原型

  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  published
    procedure hello(p: string);   //必须声明为published方法
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//根据方法名调用方法

procedure ExecFunc(className, funcName, funcParam: string);
var
  m: TMethod;
  f: TFunc;
begin
  var p: TPersistentClass := FindClass(className);
  if p = nil then exit;
  m.Data := Pointer(p);
  m.Code := p.MethodAddress(funcName);
  if Assigned(m.Code) then
  begin
    f := TFunc(m);
    f(funcParam);
  end;
end;

{ TForm1 }

procedure TForm1.Button1Click(Sender: TObject);
begin
  ExecFunc('TForm1', 'hello', 'hello yn');
end;

procedure TForm1.hello(p: string);
begin
  ShowMessage(p);
end;

initialization
  RegisterClass(TForm1);
finalization
  UnRegisterClass(TForm1);

end.

 方法二：通过RTTI调用

 

unit Unit1;

interface

uses
  system.Rtti, System.StrUtils, Winapi.Windows, Winapi.Messages, System.SysUtils,
  System.Variants, System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms,
  Vcl.Dialogs, Vcl.StdCtrls;

type
  TFunc = class(TPersistent)   //基类

  end;

  TFunc1 = class(TFunc)
  //必须public,published
    procedure p1(p: string);
    procedure p2(p: string);
  end;

  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

function FindAClass(const Name: string): TClass;
var
  ctx: TRttiContext;
  typ: TRttiType;
  list: TArray<TRttiType>;
begin
  Result := nil;
  ctx := TRttiContext.Create;
  list := ctx.GetTypes;
  for typ in list do
  begin
    if typ.IsInstance and (EndsText(Name, typ.Name)) then
    begin
      Result := typ.AsInstance.MetaClassType;
      break;
    end;
  end;
  ctx.Free;
end;

procedure execFunc(className, funcName: string; funcParam: array of TValue);
begin
  var ctx: TRttiContext;
  var t: TRttiType;
  var m: TRttiMethod;
  ctx := TRttiContext.Create;
  var c: TClass := FindAClass(className);
  t := ctx.GetType(c);
  m := t.GetMethod(funcName);
  var o: TFunc := c.Create as TFunc;
  m.Invoke(o, funcParam);
  ctx.Free;
  o.Free;
end;

{ TForm1 }

procedure TForm1.Button1Click(Sender: TObject);
begin
  RegisterClass(TFunc1);  //注册类
  execFunc('TFunc1', 'p1', ['hello yn']);
  execFunc('TFunc1', 'p2', ['hello yn2']);
end;

{ TFunc1 }

procedure TFunc1.p1(p: string);
begin
  ShowMessage(p);
end;

procedure TFunc1.p2(p: string);
begin
  ShowMessage(p);
end;

end.