Delphi中的“委托”

 .NET中有委托（Delegate）的概念，其声明形式如下所示：

 

  public delegate void MyDelegate(int aIntParam, string aStringParam);

 

　　依个人所见，委托实际上就是规定一种接口，提供一种规范，任何符合该委托签名的函数/过程都属于同一类。

 

　　在Delphi中，也有类似于“委托”的概念（不过可没有C#的功能丰富，不过两者从根本上说都应该是函数指针），如下所示：

 

  type
    TMyDelegateFunc = function (AIntParam: integer; AStringParam: string): Boolean;
    TMyDelegateProc = procedure (AIntParam: integer; AStringParam: string);

 

　　在以上的声明中，还可以用of object关键字来规定所定义的“委托”是应用于对象的函数/过程，还是应用于非对象的函数/过程，例：

 

  type
    TMyObjectDelegate = procedure (AIntParam: integer; AStringParam: string) of object; //对象的

函数/过程
    TMyRegularDelegate = procedure (AIntParam: integer; AStringParam: string); //非对象的（一般的）函数/过程

 

　　以下举个简单的例子来说明一下Delphi中“委托”的应用。附件为完整程序。
　　

{type
    TMyDelegateFunc = function (AIntParam: integer; AStringParam: string): Boolean;
    TMyDelegateProc = procedure (AIntParam: integer; AStringParam: string);

　　//在以上的声明中，还可以用of object关键字来规定所定义的“委托”是应用于对象的函数/过程，还是应用于非对象的函数/过程，例：


  type
    TMyObjectDelegate = procedure (AIntParam: integer; AStringParam: string) of object; //对象的函数/过程
    TMyRegularDelegate = procedure (AIntParam: integer; AStringParam: string); //非对象的（一般的）函数/过程

　　//以下举个简单的例子来说明一下Delphi中“委托”的应用。附件为完整程序。    }

unit UnitFrmTest;
interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;
type
  TDelegateType = (dtObject, dtRegular);

  //对象的函数委托
  TObjectNumFuncs = function (const ANumOne: Double;
    const ANumTwo: Double): Double of object;
  //非对象（一般）的函数委托
  TRegularNumFuncs = function (const ANumOne: Double;
    const ANumTwo: Double): Double;
type
  TfrmTest = class(TForm)
    edtNumOne: TEdit;
    edtNumTwo: TEdit;
    btnAdd: TButton;
    btnSub: TButton;
    btnMultiply: TButton;
    btnDivide: TButton;
    lblResult: TLabel;
    rbObjectDelegate: TRadioButton;
    rbRegularDelegate: TRadioButton;
    procedure rbRegularDelegateClick(Sender: TObject);
    procedure rbObjectDelegateClick(Sender: TObject);
    procedure MyButtonClick(Sender: TObject);
  private
    { Private declarations }
    //指示当前是使用对象的函数，还是非对象的函数
    FDelegateType: TDelegateType;

    { 对象的函数列表 }
    function Add(const ANumOne: Double;
      const ANumTwo: Double): Double;
    function Sub(const ANumOne: Double;
      const ANumTwo: Double): Double;
    function Multiply(const ANumOne: Double;
      const ANumTwo: Double): Double;
    function Divide(const ANumOne: Double;
      const ANumTwo: Double): Double;
    { 对象的函数列表　结束 }
    function DoObjectCalc(const ANumOne: Double;
      const ANumTwo: Double; AMethod: TObjectNumFuncs): Double;
  public
    { Public declarations }
  end;

{ 非对象（一般）的函数列表 }
  function Add(const ANumOne: Double; const ANumTwo: Double): Double;
  function Sub(const ANumOne: Double; const ANumTwo: Double): Double;
  function Multiply(const ANumOne: Double; const ANumTwo: Double): Double;
  function Divide(const ANumOne: Double; const ANumTwo: Double): Double;
  function DoRegularCalc(const ANumOne: Double; const ANumTwo: Double;
    AMethod: TRegularNumFuncs): Double;
{ 非对象（一般）的函数列表　结束 }
var
  frmTest: TfrmTest;
implementation
{$R *.dfm}
{ 非对象（一般）的函数列表 }
function Add(const ANumOne: Double; const ANumTwo: Double): Double;
begin
  Result := ANumOne + ANumTwo;
end;
function Sub(const ANumOne: Double; const ANumTwo: Double): Double;
begin
  Result := ANumOne - ANumTwo;
end;
function Multiply(const ANumOne: Double; const ANumTwo: Double): Double;
begin
  Result := ANumOne * ANumTwo;
end;
function Divide(const ANumOne: Double; const ANumTwo: Double): Double;
begin
  try
    Result := ANumOne / ANumTwo;
  except
    on E: EZeroDivide do
    begin
      frmTest.edtNumTwo.SetFocus();
      frmTest.lblResult.Caption := '除数不能为零';
      Abort();
    end;
  end;
end;
function DoRegularCalc(const ANumOne: Double; const ANumTwo: Double;
  AMethod: TRegularNumFuncs): Double;
begin
  Result := AMethod(ANumOne, ANumTwo);
end;
{ 非对象（一般）的函数列表　结束 }
{ TfrmTest }
{ 对象的函数列表 }
function TfrmTest.Add(const ANumOne, ANumTwo: Double): Double;
begin
  Result := ANumOne + ANumTwo;
end;
function TfrmTest.Divide(const ANumOne, ANumTwo: Double): Double;
begin
  try
    Result := ANumOne / ANumTwo;
  except
    on E: EZeroDivide do
    begin
      edtNumTwo.SetFocus();
      lblResult.Caption := '除数不能为零';
      Abort;
    end;
  end;
end;
function TfrmTest.DoObjectCalc(const ANumOne, ANumTwo: Double;
  AMethod: TObjectNumFuncs): Double;
begin
  Result := AMethod(ANumOne, ANumTwo);
end;
function TfrmTest.Multiply(const ANumOne, ANumTwo: Double): Double;
begin
  Result := ANumOne * ANumTwo;
end;
procedure TfrmTest.MyButtonClick(Sender: TObject);
var
  dblNumOne, dblNumTwo, dblResult: Double;
begin
  if not (Sender is TButton) then Exit;
  dblNumOne := StrToFloatDef(Trim(edtNumOne.Text), 0.0);
  dblNumTwo := StrToFloatDef(Trim(edtNumTwo.Text), 0.0);

  case (Sender as TButton).Tag of
    0: //加
      begin
        case Self.FDelegateType of
          dtObject:
            begin
              dblResult := Self.DoObjectCalc(dblNumOne, dblNumTwo, Self.Add);
              //若为
              //dblResult := Self.DoObjectCalc(dblNumOne, dblNumTwo, UnitFrmTest.Add);
              //则会提示以下错误：
              //E2009 Incompatible types: 'regular procedure and method pointer'
            end;
          dtRegular:
            begin
              dblResult := DoRegularCalc(dblNumOne, dblNumTwo, UnitFrmTest.Add);
              //若为
              //dblResult := DoRegularCalc(dblNumOne, dblNumTwo, Self.Add);
              //则会提示以下错误：
              //E2009 Incompatible types: 'regular procedure and method pointer'
            end;
        end;
      end;
    1: //减
      begin
        case Self.FDelegateType of
          dtObject:
            begin
              dblResult := Self.DoObjectCalc(dblNumOne, dblNumTwo, Self.Sub);
            end;
          dtRegular:
            begin
              dblResult := DoRegularCalc(dblNumOne, dblNumTwo, UnitFrmTest.Sub);
            end;
        end;

      end;
    2: //乘
      begin
        case Self.FDelegateType of
          dtObject:
            begin
              dblResult := Self.DoObjectCalc(dblNumOne, dblNumTwo, Self.Multiply);
            end;
          dtRegular:
            begin
              dblResult := DoRegularCalc(dblNumOne, dblNumTwo, UnitFrmTest.Multiply);
            end;
        end;

      end;
    3: //除
      begin
        case Self.FDelegateType of
          dtObject:
            begin
              dblResult := Self.DoObjectCalc(dblNumOne, dblNumTwo, Self.Divide);
            end;
          dtRegular:
            begin
              dblResult := DoRegularCalc(dblNumOne, dblNumTwo, UnitFrmTest.Divide);
            end;
        end;

      end;

  end;
  lblResult.Caption := '结果：' + FloatToStr(dblResult);
end;
procedure TfrmTest.rbObjectDelegateClick(Sender: TObject);
begin
  Self.FDelegateType := dtObject;
end;
procedure TfrmTest.rbRegularDelegateClick(Sender: TObject);
begin
  Self.FDelegateType := dtRegular;
end;
function TfrmTest.Sub(const ANumOne, ANumTwo: Double): Double;
begin
  Result := ANumOne - ANumTwo;
end;
{ 对象的函数列表　结束 }
end.

http://blog.csdn.net/procedure1984/article/details/3897028