Динамическое назначение анонимных функций в pascal

Question

Я хотел бы иметь возможность динамически генерировать всплывающие меню в pascal.

Я также хотел бы иметь возможность динамически назначать обработчики OnClick каждому элементу меню.

Это то, что я привык делать в C#, это моя попытка в pascal.

Элемент меню обработчик события onClick должен принадлежать объекту (of 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 : Integer; 
    end; 

    TNotifyEventWrapper = class 
    private 
     FProc: TProc<TObject>; 
     I : Integer; 
    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: Integer; 
    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

Программа показывает ожидаемое сообщение

Однако следующее сообщение не было t показывает ожидаемый результат.

Вместо 6 он не показывает пункт 10

Независимо от того, какой элемент в списке я нажимаю на все они, кажется, срабатывает обработчик событий для последнего элемента в списке (10).

Мне было предложено, чтобы процедура объекта объекта NEEvent была одинаковым адресом памяти для всех экземпляров этого объекта.

Какой бы элемент меню я нажимаю, адрес памяти MI.OnClick такой же.

Answer 1

Ключ к пониманию этого, чтобы понять, что переменная захвата захватывает переменные, а не значения.

Ваши методы anon захватывают одну и ту же переменную F. Есть только один экземпляр этой переменной, так как FormCreate выполняет только один раз. Это объясняет поведение. Когда ваши методы anon выполняются, переменная F имеет значение, присвоенное ей в последней итерации цикла.

Что вам нужно для каждого другого метода anon для захвата другой переменной. Вы можете сделать это, создав новый стек стека при создании каждого другого метода anon.

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

Поскольку аргумент функции GetWrapper является локальной переменной в кадре стека этой функции, каждый вызов GetWrapper создает новый экземпляр этой локальной переменной.

Вы можете разместить GetWrapper, где пожелаете. Как вложенная функция в FormCreate, или как частный метод, или в единицу объема.

Затем построить ваши меню, как это:

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

Связанные чтения:

• http://docwiki.embarcadero.com/RADStudio/en/Anonymous_Methods_in_Delphi#Variable_Binding_Mechanism
• Anonymous methods - variable capture versus value capture
• http://blogs.embarcadero.com/abauer/2008/10/15/38876