在pascal中动态分配匿名通用函数

时间:2015-03-25 01:12:27

标签: delphi generics interface anonymous-function

我有以下类层次结构

Class

我希望能够动态分配对TBTC两种类型的对象进行操作的匿名方法。

所以这是一个简单的人为例子:

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
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

  TNotifyEventWrapper = class
    private
      FProc: TProc<TObject>;
    public
      constructor Create(Proc: TProc<TObject>);
    published
      procedure Event(Sender: TObject);
    end;

  IA = interface
    procedure Foo;
  end;

  TA = class(TInterfacedObject)
    procedure Foo;
  end;

  TB = class(TA, IA)
    procedure Foo;
  end;

  TC = class(TA, IA)
    procedure Foo;
  end;

  TControl = class
    strict private
    public
    class var NEW : TNotifyEventWrapper;
    class var Foo : TNotifyEvent;
    class function GetWrapper<T:TA, IA, constructor>(D: T): TNotifyEventWrapper;
    class procedure AssignFooHandler<T:TA, IA, constructor>;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TC.Foo;
begin
    ShowMessage('TC.Foo');
end;

class function TControl.GetWrapper<T>(D: T): TNotifyEventWrapper;
begin
    Result :=
    TNotifyEventWrapper.Create
    (
        procedure (S : TObject)
        begin
            T(D).Foo;
        end
    );
end;

class procedure TControl.AssignFooHandler<T>;
var
    X : T;
begin
    X := T.Create;
    try
        TControl.NEW := TControl.GetWrapper<T>(X);

        TControl.Foo := TControl.NEW.Event;

    finally
        FreeAndNil(X);
    end;
end;

procedure TA.Foo;
begin
    ShowMessage('TA.Foo');
end;

procedure TB.Foo;
begin
    ShowMessage('TB.Foo');
end;

constructor TNotifyEventWrapper.Create(Proc: TProc<TObject>);
begin
    inherited Create;
    FProc := Proc;
end;

procedure TNotifyEventWrapper.Event(Sender: TObject);
begin
    FProc(Sender);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
    TControl.Foo(Sender);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
    TControl.AssignFooHandler<TC>;  //TB
end;

end.

我希望能够致电

TControl.AssignFooHandler<TC>;

TControl.Foo(Sender);方法调用TC.Foo

另外,我希望TControl.AssignFooHandler<TB>;导致TControl.Foo(Sender);调用TB.Foo

不幸的是,当我运行它时,它总是调用基类方法TA.Foo

MessageBox

我不确定如何解决这个问题。

1 个答案:

答案 0 :(得分:5)

您的Generic受限于TAIA的后代。 TA.Foo未声明为virtualT(B|C).Foo()未向override声明。TA.Foo()这就是每次调用TA.Foo()的原因。您需要将T(B|C).Foo虚拟覆盖,T(B/C).Foo覆盖它,然后T(A/B/C)将按预期调用。

此外,在TControl.GetWrapper()有机会调用该对象的TControl.Foo()方法之前,您正在释放传递给Foo()的{​​{1}}对象。在这个特定的例子中,没有任何Foo()方法可以访问任何对象成员字段,但是一旦你在实际的生产代码中开始这样做,它很可能会崩溃。在使用T(A/B/C)对象完成之前,您需要保持TNotifyEventWrapper对象存活。