怎样用函数名为参数, 在调用函数中调用"函数入口"为名的函数? 300美金请高手.(300分)

S

sileo

Unregistered / Unconfirmed
GUEST, unregistred user!
怎样用函数名为参数, 在调用函数中调用"函数入口"为名的函数?
type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private

{ Private declarations }
public
{ Public declarations }
end;

function pro1:string;
function pro2:string;
procedure dopro(sname:string);

var
Form1: TForm1;

implementation

{$R *.DFM}


function pro1:string;
begin
...
Result := 'pro1';
end;

function pro2:string;
begin
...
Result := 'pro2';
end;

procedure dopro(sname:xxxxxx)
//我想传function proc1 或function proc2
var
s: string;
begin
...
showmessage('begin');
//前面是pro1 和 pro2都通用的部分.

s := sname
//怎么调用function pro1/pro2
showmessage(s);

//后面是pro1 和 pro2都通用的部分.
...
showmessage('end');
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
dopro('pro1')
//想调用dopro 并在dopro调用pro1
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
dopro('pro2')
//想调用dopro 并在dopro调用pro2
end;
...
 
procedure dopro(sname:string)

var
s: string;
begin
...
showmessage('begin');
//前面是pro1 和 pro2都通用的部分.

s := sname
//怎么调用function pro1/pro2
if s='pro1' then
s:=pro1 //调用function pro1
else
s:=pro2
//调用function pro2

showmessage(s);

.....
 
这样不好.

我有很多函数.PRO1,PRO2,PRO3.........
我就想直接传进去,免的写IF...(不想维护这代码)

有好的办法吗?
 
unit Unit1;

interface

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

type
TNotify=Function:string;
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
function f1:string;
function f2:string;
procedure sellect(Notify:TNotify);
var
Form1: TForm1;
Notify:TNotify;
implementation

{$R *.dfm}

function f1:string;
begin
result:='Hello!';
end;

function f2:string;
begin
result:='DFW';
end;

procedure sellect(Notify:TNotify);
var s:string;
begin
s:=Notify;
showmessage(s);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
sellect(@f1);
sellect(@f2);
end;

end.
 
这样的话, 对于调用同一种类型,格式的函数可以,
但在procedure sellect(Notify:TNotify);中要处理多一种函数,又怎么样实现呢?

如:
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;

type
TNotify=Function:string;
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
Button3: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
function f1:string;
function f2:string;
function f3(n:integer):string;
procedure sellect(Notify:TNotify);

var
Form1: TForm1;
Notify:TNotify;
implementation

{$R *.dfm}

function f1:string;
begin
result:='Hello!';
end;

function f2:string;
begin
result:='DFW';
end;

function f3(n:integer):string;
begin
if n = 1 then
Result := '参数为1'
else
Result := '参数为其他';
end;

procedure sellect(Notify:TNotify);
var s:string;
begin
s:=Notify;
showmessage(s);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
sellect(@f1);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
sellect(@f2);
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
sellect(@f3)
//运行这时就会出错了.
end;


end.

 
来自葵花宝典
type
AFunctionType = function(IntIn : integer) : integer;

function AddProc(IntIn : integer) : integer;
begin
Result := IntIn + 1;
end;

function SubProc(IntIn : integer) : integer;
begin
Result := IntIn - 2;
end;

procedure PassAFunction(var IntIn : integer;
fn : AFunctionType);
begin
IntIn := fn(IntIn);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
i : integer;

begin
i := 10;

PassAFunction(i, @AddProc);
ShowMessage(IntToStr(i));

PassAFunction(i, @SubProc);
ShowMessage(IntToStr(i));
end;



 
c里是可以的, 我试过. 就不知Delphi行不行.

若没实际的函数,可做出错处理.

我就想, 如果能实现的话. 我的程序就成了架构程序,就不再需要维护主控调用程序.
而且,procedure sellect(Notify:TNotify);里也可以放公共的代码.
只是专心写好被调用的子的业务函数就行了.如:F1,F2,F3....等.



 
还得请大家帮我多想想啊,谢谢大家!!
 
想法真的很好,
一起来关注一下吧.
这样的话以后写程序可省劲儿了.
^_^
 
unit Unit1;

interface

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

type
TNotify=Function(pt:pointer):string;
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
function f1(pt:pointer):string;
function f2(pt:pointer):string;
function f3(pn:pInteger):string;

procedure sellect(Notify:TNotify;pt:pointer);
var
Form1: TForm1;
Notify:TNotify;
implementation

{$R *.dfm}

function f1(pt:pointer):string;
begin
result:='Hello!';
end;

function f2(pt:pointer):string;
begin
result:='DFW';
end;

function f3(pn:pInteger):string;
begin
result:=inttostr(pn^);
end;

procedure sellect(Notify:TNotify;pt:pointer);
var s:string;
begin
s:=Notify(pt);
showmessage(s);
end;

procedure TForm1.Button1Click(Sender: TObject);
var pn:pInteger;
begin
new(pn);
pn^:=3;
sellect(@f1,nil);
sellect(@f2,nil);
sellect(@f3,pn);
end;

end.
 
谢谢phenix_sd
你写的可以通过.

但很多子函数入口参数的个数是不同的, 回值类型也很多种.
那,是不是子函数就定义一个结构指针, 把结构定义足够多,(考虑到所有函数的入口参数)
回值也干脆写在入口指定的内存里去.
这样行吗? 你有更好的办法吗?
 
hehe,我就知道你会问这个,我正在想
 
我用结构指针,出错,那里搞错了呢?
type
PTfuncjg = ^Tfuncjg;
Tfuncjg = record
pt1 : Integer;
pt2 : Integer;
pt3 : string;
end;
TNotify = Function(pt:pTfuncjg):string;
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
procedure Button2Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

function f1(pt:pTfuncjg):string;
function f2(pt:pTfuncjg):string;
function f3(pt:pTfuncjg):string;
function f4(pt:pTfuncjg):string;

procedure sellect(Notify:TNotify;pt:pTfuncjg);
var
Form1: TForm1;
Notify:TNotify;

implementation
{$R *.dfm}

function f1(pt:pTfuncjg):string;
begin
result:='Hello!';
end;

function f2(pt:pTfuncjg):string;
begin
result:='DFW';
end;

function f3(pt:pTfuncjg):string;
begin
result:=inttostr(pt.pt1);
end;

function f4(pt:pTfuncjg):string;
begin
result:=inttostr(pt.pt1+pt.pt2);
end;

procedure sellect(Notify:TNotify;pt:pTfuncjg);
var s:string;
begin
s:=Notify(pt);
showmessage(s);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
pn: PTfuncjg;
begin
pn.pt1 := 3;
pn.pt2 := 4;
sellect(@f1,nil)

sellect(@f2,nil);
sellect(@f3,pn);
sellect(@f4,pn);
end;

end.
 
错误提示为:"Access violation at address 004117AA in module 'Project1.exe'.
Read of address 00000013'.
 
procedure TForm1.Button1Click(Sender: TObject);
var
pn: PTfuncjg;
begin
new(pn);//我加的
pn.pt1 := 3;
pn.pt2 := 4;
sellect(@f1,nil)

sellect(@f2,nil);
sellect(@f3,pn);
sellect(@f4,pn);
end;
使用指针一定要先分配内存空间,系统会自动帮你释放
 
使用指针一定要先分配内存空间
这一句我同意,但系统会自动释放?如何见得?一般对于分配的指针应该用dispose释放
 
type
TForm1 = class (TForm)
Button1: TButton

procedure Button1Click(Sender: TObject)

// Your routines (that you'll run by name) must be here
procedure Hello_World(Sender: TObject)

private
procedure ExecuteRoutine(Instance: TObject
Name: string)

end


var
Form1: TForm1


type
TExecute = procedure of object


procedure TForm1.ExecuteRoutine(Instance: TObject
Name: string)

var
Routine: TMethod

Execute: TExecute

begin
Routine.Data := Pointer(Instance)

// Returns the address of a published method.
Routine.Code := Instance.MethodAddress(Name)

if Routine.Code = nil then Exit

Execute := TExecute(Routine)

Execute

end


procedure TForm1.Button1Click(Sender: TObject)

begin
ExecuteRoutine(Form1, 'Hello_World')

end


procedure TForm1.Hello_World(Sender: TObject)

begin
ShowMessage('This is a test')

end





 
顶部