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.
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.
发表于 2023-1-24 21:15:00