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

sav*_*sav 4 delphi generics interface anonymous-function

我有以下类层次结构

类

我希望能够动态分配适用于这两种类型的对象进行操作的匿名方法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.
Run Code Online (Sandbox Code Playgroud)

我想能打电话

TControl.AssignFooHandler<TC>;

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

我也想TControl.AssignFooHandler<TB>;导致TControl.Foo(Sender);调用TB.Foo

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

消息框

我不知道怎么解决这个问题.

Rem*_*eau 5

你的Generic被限制为TA和的后代IA. TA.Foo未被声明为virtual,并且T(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()Foo()T(A/B/C)TNotifyEventWrapper