在 Pascal 中动态分配匿名泛型函数

Question

我有以下 class 层次结构

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

所以这是一个简单的人为示例：

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

不幸的是，当我运行这个时，它总是调用基础 class 方法 TA.Foo.

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

Answer 1

您的泛型仅限于 TA 和 IA 的后代。 TA.Foo 未声明为 virtual，并且 T(B|C).Foo() 未声明为 override。这就是为什么 TA.Foo() 每次都被调用的原因。您需要使 TA.Foo() 虚拟化并 T(B|C).Foo 覆盖它，然后 T(B/C).Foo 将按预期被调用。

此外，在 TControl.Foo() 有机会调用该对象的 Foo() 方法之前，您正在释放传递给 TControl.GetWrapper() 的 T(A/B/C) 对象。在此特定示例中，由于 Foo() 方法中的 none 方法访问任何对象成员字段，因此没问题，但是一旦您在实际生产代码中开始这样做，它就可能会崩溃。在使用完 TNotifyEventWrapper 对象之前，您需要让 T(A/B/C) 对象保持活动状态。

在 Pascal 中动态分配匿名泛型函数

Dynamically assigning anonymous generic functions in pascal

delphi

generics

interface

anonymous-function