delphi通过方法名调用方法

一岁就会笑 發表於 2023-1-24 21:15:00

delphi通过方法名调用方法
<div class="cnblogs_code">
<pre>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.</pre>
</div>
 方法二：通过RTTI调用
 
<div class="cnblogs_code">
<pre>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.</pre>
</div>
 

</div>
<div id="MySignature" role="contentinfo">
本文来自博客园，作者：{咏南中间件}，转载请注明原文链接：https://www.cnblogs.com/hnxxcxg/p/17066399.html 
来源：https://www.cnblogs.com/hnxxcxg/p/17066399.html

頁: [1]

琼殿技术论坛's Archiver

delphi通过方法名调用方法