delphi – 在pascal中动态分配匿名函数

我希望能够在pascal中动态生成弹出菜单.

我还希望能够为每个菜单项动态分配OnClick处理程序.

这是我以前在C#中可以做的事情,这是我在pascal中的尝试.

菜单项onClick事件处理程序需要属于一个Object对象,所以我为此创建了一个容器对象.

这是我的代码：

unit Unit1;

interface

uses
  Winapi.Windows,Winapi.messages,System.SysUtils,System.Variants,System.Classes,Vcl.Graphics,Vcl.Controls,Vcl.Forms,Vcl.Dialogs,Vcl.StdCtrls,Vcl.Menus;

type
  TForm1 = class(TForm)
    PopupMenu1: TPopupMenu;
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

  TFoo = class
    public
      Bar : String;
      Val : @R_607_8056@r;
  end;

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

var
  Form1: TForm1;
  NE : TNotifyEventWrapper;

implementation

{$R *.dfm}

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

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

procedure TForm1.FormCreate(Sender: TObject);
var
    F : TFoo;
    I: @R_607_8056@r;
    mi : TMenuItem;
begin
    if Assigned(NE) then FreeAndNil(NE);

    for I := 1 to 10 do
    begin
        F := TFoo.Create;
        F.bar := 'Hello World!';
        F.Val := I;
        NE := TNotifyEventWrapper.Create
        (
            procedure (Sender :TObject)
            begin
               Showmessage(F.bar + ' ' + inttostr(F.Val) + Format('  Addr = %p',[Pointer(F)]) + Format('Sender = %p,MI.onClick = %p',[Pointer(Sender),Pointer(@TMenuItem(Sender).onClick)]));
            end
        );
        NE.I := I;

        mi := TMenuItem.Create(PopupMenu1);

        mi.onClick := NE.Event;

        mi.Caption := inttostr(F.Val);

        PopupMenu1.Items.Add(mi);
    end;
end;

end.

单击菜单项目编号6

该程序显示预期的消息

但是,下一条消息未显示预期结果.

而不是6它显示项目10

无论我点击列表中的哪个项目,它们似乎都会触发列表中最后一项的事件处理程序(10).

有人向我建议NE对象的成员过程Event对于该对象的所有实例都是相同的内存地址.

无论我点击哪个菜单项,内存地址MI.onClick都是一样的.

function GetWrapper(F: Foo): TNotifyEventWrapper;
begin
  Result := TNotifyEventWrapper.Create(
    procedure(Sender: TObject)
    begin
      Showmessage(F.bar + ...);
    end
  );
end;

F := TFoo.Create;
F.bar := 'Hello World!';
F.Val := I;
NE := GetWrapper(F);
NE.I := I;