如何将对象函数(of object)赋给普通函数指针？(50)

我写了如下一段代码，在procedure TForm1.Button1Click(Sender: TObject);的最后一句报异常，该语句是想实现：将一对象函数(of object)赋给普通函数指针，并调用该对象函数。请问各们，如何实现上述功？先在这里谢谢大家了！unit Unit1;interfaceuses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls;type TFunctionType = function: string of object
//定义对象函数指针 TFunctionType1 = function: string
//定义函数指针 TForm1 = class(TForm) Button1: TButton
procedure Button1Click(Sender: TObject)
private { Private declarations } function selfFunciotn: string
public { Public declarations } end;var Form1: TForm1;procedure CallFunction(ft: TFunctionType)
//以函数指针为参数,调用指定函数procedure CallFunction1(ft: TFunctionType1)
//以函数指针为参数,调用指定函数function GFunction(obj: TObject): string;function GFunction1(): string;implementation{$R *.dfm}//以对象函数指针为参数,过程中调用传入函数procedure CallFunction(ft: TFunctionType);begin ShowMessage(ft);end;//以普通函数指针为参数,过程中调用传入函数procedure CallFunction1(ft: TFunctionType1);begin ShowMessage(ft);end;//普通函数，多了一个参数，用以与 对象函数指针 兼容function GFunction(obj: TObject): string;begin Result:= 'GFunction';end;//普通函数function GFunction1(): string;begin Result:= 'GFunction1';end;procedure TForm1.Button1Click(Sender: TObject);var M: TMethod;begin //以对象函数指针为参数，调用普通函数，成功 M.Code := @GFunction
M.Data := nil
CallFunction(TFunctionType(M))
//以对象函数指针为参数，调用对象函数，成功 CallFunction(self.selfFunciotn)
//以普通函数指针为参数，调用普通函数，成功 CallFunction1(GFunction1)
//以普通函数指针为参数，调用对象函数，失败 CallFunction1(MethodAddress('selfFunciotn'));end;function TForm1.selfFunciotn: string;begin Result:= 'selfFunciotn';end;end.

自己顶一下，谢谢大家了！

我只知道你的 MethodAddress('selfFunciotn')返回nil；需要将selfFunciotn定义在published区域才能返回函数地址，但调试时仍然会异常。

//以普通函数指针为参数，调用对象函数，失败 CallFunction1(MethodAddress('selfFunciotn'));失败是因为: TFunctionType 与 TFunctionType1 不等价! --- 相当于两种过程所传的参数不同,不能相互转换! 如果定义如下的话就可以了 TFunctionType = function: string of object
// 定义对象函数指针 TFunctionType1 = function(Sender: TObject): string
// 定义函数指针

有办法的！of object ，只不过是先压入了一个self，再加上函数地址，用汇编直接取出，就可以搞定！cnpack的这个单元CnCallBack，貌似也可以搞定的！///////////////////////////////////////////////////{******************************************************************************}{ CnPack For Delphi/C++Builder }{ 中国人自己的开放源码第三方开发包 }{ (C)Copyright 2001-2009 CnPack 开发组 }{ ------------------------------------ }{ }{ 本开发包是开源的自由软件，您可以遵照 CnPack 的发布协议来修 }{ 改和重新发布这一程序。 }{ }{ 发布这一开发包的目的是希望它有用，但没有任何担保。甚至没有 }{ 适合特定目的而隐含的担保。更详细的情况请参阅 CnPack 发布协议。 }{ }{ 您应该已经和开发包一起收到一份 CnPack 发布协议的副本。如果 }{ 还没有，可访问我们的网站： }{ }{ 网站地址：http://www.cnpack.org }{ 电子邮件：master@cnpack.org }{ }{******************************************************************************}unit CnCallBack;{* |<PRE>================================================================================* 软件名称：CnPack 组件包* 单元名称：回调转换的工具单元* 单元作者：CnPack开发组 savetime (savetime2k@yahoo.com)* 刘啸 (liuxiao@cnpack.org)* 备 注：该单元是回调转换等的代码单元* 包装的代码部分在自行分配的可执行的内存空间，避免了 DEP 下出错。* 开发平台：PWin2000 + Delphi 5.0* 兼容测试：PWin9X/2000/XP + Delphi 5/6/7* 本 地 化：该单元中的字符串均符合本地化处理方式* 单元标识：$Id: CnCallBack.pas,v 1.7 2009/01/02 08:27:38 liuxiao Exp $* 修改记录：2006.10.13 V1.0* 创建单元，实现功能================================================================================|</PRE>}interface{$I CnPack.inc}uses Classes, Windows, SysUtils;type ECallBackException = class(Exception) end;function StdcallMethodToCallBack(ASelf: Pointer
AMethodAddr: Pointer): Pointer;{* 将 stdcall 的类成员函数和实例加以包装，返回一个新的 stdcall 的回调函数地址 }{* 使用语法: @AStdCallbackFunc := StdcallMethodToCallBack(AObject, @TAObject.CallbackMethod)
其中 AStdCallbackFunc 和 CallbackMethod 都必须使用 stdcall 声明。}implementationtype TCnCallback = array [1..18] of Byte
// 按代码中最长的来 PCnCallback = ^TCnCallback
const THUNK_SIZE = 4096
// x86 页大小，目前只弄一个页面 StdcallCode: TCnCallback = ($8B,$04,$24,$50,$B8,$00,$00,$00,$00,$89,$44,$24,$04,$E9,$00,$00,$00,$00)
{----------------------------} { Stdcall CallbackCode ASM } {----------------------------} { MOV EAX, [ESP]
} { PUSH EAX
} { MOV EAX, ASelf
} { MOV [ESP+4], EAX
} { JMP AMethodAddr
} {----------------------------}var FCallBackPool: Pointer = nil
FEmptyPtr: Integer = 0
FCS: TRTLCriticalSection;procedure InitCallBackPool;begin FCallBackPool := VirtualAlloc(nil, THUNK_SIZE, MEM_COMMIT, PAGE_EXECUTE_READWRITE)
if FCallBackPool = nil then raise ECallBackException.Create('Callback Pool Init Error!');end;function StdcallMethodToCallBack(ASelf: Pointer
AMethodAddr: Pointer): Pointer;var Instance: PCnCallback;begin Result := nil
Instance := nil
try EnterCriticalSection(FCS)
if FCallBackPool = nil then begin InitCallBackPool
Instance := FCallBackPool
end else begin if FEmptyPtr = (THUNK_SIZE div SizeOf(TCnCallback)) then raise ECallBackException.Create('Callback Pool Overflow!')
Instance := PCnCallback(Integer(FCallBackPool) + FEmptyPtr * SizeOf(TCnCallback))
Inc(FEmptyPtr)
end
finally LeaveCriticalSection(FCS)
end
if Instance <> nil then begin Move(StdcallCode, Instance^, SizeOf(TCnCallback))
PInteger(@(Instance^[6]))^ := Integer(ASelf)
PInteger(@(Instance^[15]))^ := Integer(Integer(AMethodAddr) - Integer(Instance) - 18)
Result := Instance
end;end;initialization InitializeCriticalSection(FCS);finalization DeleteCriticalSection(FCS)
if FCallBackPool <> nil then VirtualFree(FCallBackPool, 0, MEM_RELEASE);end.

谢谢大家的回复，有没有类似像下面： //以对象函数指针为参数，调用普通函数，成功 M.Code := @GFunction
M.Data := nil
CallFunction(TFunctionType(M));这样简单的处理方法不知道能不能通过TMethod来实现，谢谢！

自己顶一下，谁知道还望告诉我，谢谢了！

找了个折中的办法，同时声明对象函数类型和普通函数类型，通过overload来实现同一个函数功能，没有找到我想要的答案，但问题也算解决了，大家来领分吧

多人接受答案了。