----------开发环境：D7
这是一个简单的回调函数，再结合回调函数的相关资料(资料没有提供)，能快速的掌握回调函数;
回调函数定义在Unit2中
--------------------
---------Unit1开始
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Edit1: TEdit;
Edit2: TEdit;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
procedure mytest(str:string);
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
uses Unit2;
{$R *.dfm}
procedure TForm1.mytest(str: string);
begin
Edit2.Text :=str;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
getss(mytest,StrToFloatDef(Edit1.Text,1));
end;
end.
----------Unit1结束
----------------Form1开始
object Form1: TForm1
Left = 786
Top = 461
Width = 273
Height = 283
Caption = 'Form1'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
PixelsPerInch = 96
TextHeight = 13
object Button1: TButton
Left = 104
Top = 136
Width = 75
Height = 25
Caption = 'Button1'
TabOrder = 0
OnClick = Button1Click
end
object Edit1: TEdit
Left = 64
Top = 64
Width = 121
Height = 21
ImeName = '中文(简体) - 搜狗拼音输入法'
TabOrder = 1
Text = 'Edit1'
end
object Edit2: TEdit
Left = 64
Top = 104
Width = 121
Height = 21
ImeName = '中文(简体) - 搜狗拼音输入法'
TabOrder = 2
Text = 'Edit2'
end
end
-----------------Form1结束
------------Unit2开始------
unit Unit2;
interface
uses Windows,Classes;
type
Tmyfun=procedure(str:string) of object ;
function getss(MyFun:Tmyfun;mydouble:double=0 ):integer ;
implementation
function getss(MyFun:Tmyfun;mydouble:double=0 ):integer ;
begin
Result:=0;
if mydouble>0 then
begin
MyFun('正数');
end
else
if mydouble=0 then
begin
MyFun('零');
end
else
begin
MyFun('负数');
end;
end;
end.
------------Unit2结束--------
------------------------------------------------------杂乱的东西-------------
把类成员函数传递给非类成员函数的回调例子
1 unit Unit1; 2 3 interface 4 5 uses 6 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 7 Dialogs, StdCtrls; 8 9 type 10 TMYMyf=function (var int:integer):Integer of Object; 11 TForm1 = class(TForm) 12 Button1: TButton; 13 procedure Button1Click(Sender: TObject); 14 private 15 function Myf(var int:integer):Integer; 16 { Private declarations } 17 public 18 { Public declarations } 19 end; 20 21 var 22 Form1: TForm1; 23 24 implementation 25 uses Unit2; 26 {$R *.dfm} 27 28 procedure TForm1.Button1Click(Sender: TObject); 29 var 30 ff:TMyFun; 31 pp:Pointer; 32 m:TMYMyf; 33 begin 34 m:=Myf; 35 PP:=Tmethod(m).code; 36 MyTestCallFun(PP); 37 end; 38 39 function TForm1.Myf(var int: integer): Integer; 40 begin 41 Result:=100+int; 42 ShowMessage(IntToStr(Result)); 43 end; 44 45 end.
1 unit Unit2; 2 3 interface 4 5 uses 6 Classes,SysUtils,Dialogs; 7 8 type 9 TMyFun=function(var int:integer):Integer; 10 11 function MyTestCallFun( ppp:TMyFun):Integer; 12 implementation 13 14 function MyTestCallFun( ppp:TMyFun):Integer; 15 var 16 i:Integer; 17 begin 18 i:=888; 19 Result:=ppp(i); 20 showmessage(inttostr(Result)) 21 end; 22 end.
1 object Form1: TForm1 2 Left = 660 3 Top = 521 4 Width = 352 5 Height = 301 6 Caption = 'Form1' 7 Color = clBtnFace 8 Font.Charset = DEFAULT_CHARSET 9 Font.Color = clWindowText 10 Font.Height = -11 11 Font.Name = 'MS Sans Serif' 12 Font.Style = [] 13 OldCreateOrder = False 14 PixelsPerInch = 96 15 TextHeight = 13 16 object Button1: TButton 17 Left = 128 18 Top = 112 19 Width = 75 20 Height = 25 21 Caption = 'Button1' 22 TabOrder = 0 23 OnClick = Button1Click 24 end 25 end
------------------------------
