Delphi 动态创建弹出菜单项 - 无效指针操作/访问冲突

Question

我遇到错误消息“无效浮点运算”的问题。弹出菜单是一个设计时控件，名为NavPop。它没有指定菜单项。它被指定为 Panel1 的弹出菜单。

然后，我从列表框中动态创建菜单项，并分配标题和单击事件。就我想要实现的目标而言，一切都 100% 有效。即它有效。

只有当我关闭程序时，我才会得到

Invalid floating point operation

或者其他方式:

Access Violation Address 000007355. Read of Addrss 0000007355.

请注意，除了关闭程序时出现错误之外，一切正常。我将不胜感激任何帮助。

 //  I declare the Array of TMenuItems
 private
    { Private declarations }
    ItemArray : array of TMenuItem;

...    

procedure TMainForm.Button1Click(Sender: TObject);
begin
  CreateNavPop;
end;

//  Create the menu items from listbox(Navlist) items and Link them 
//  to events on a navigation bar.
procedure TMainForm.CreateNavPop;
var
  I:  Integer;
  NavIndex:  Integer;
begin
  SetLength(ItemArray, NavList.Items.Count);
  NavIndex:=0;
  For I:=0 to NavList.Items.Count-1 do
  begin
    NavIndex:=NavBar1.Items.ItemByCaption(NavList.Items.Strings[i]).Index;
    ItemArray[i]:=TMenuItem.create(Nil);
    ItemArray[i].Caption:=NavList.Items.Strings[i];
    ItemArray[i].OnClick:=NavBar1.Items.Items[Navindex].OnClick;
    NavPop.Items.Add(ItemArray[i]);
  end;
end;

//  Call the Items free on program close
procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  FreeItems(ItemArray);
end;

//  Free Dynamically created Menu Items on Form Close
procedure TMainForm.FreeItems(MItems : array of TMenuItem);
var
  cnt : integer;
begin
  for cnt := High(MItems) downto Low(MItems) do
  begin
    MItems[cnt].Free;
    MItems[cnt] := nil;
  end;
end;

Answer 1

发生这种情况是因为 TPopupMenu 已经释放了这些项目，而您正在再次释放它。

此代码导致“无效指针操作”:

procedure TForm1.FormCreate(Sender: TObject);
var
  I: Integer;
begin
  for I := 0 to 3 do
    PopupMenu1.Items.Add(TMenuItem.Create(nil));
end;

destructor TForm1.Destroy;
var
  I: Integer;
begin
  for I := 3 downto 0 do
    PopupMenu1.Items.Free;
  inherited;
end;

Items 属性是一个 TMenuItem 实例，如果您查看它的析构函数，它已经释放了您添加的所有项目。

destructor TMenuItem.Destroy;
begin
...
  while Count > 0 do Items[0].Free;
...

保持简短，您不需要在 FreeItems 方法中再次执行此操作。

我使用 ReportMemoryLeaksOnShutdown := True 进行测试，没有发生内存泄漏。