如何在显示子项时将子项动态添加到 TMenuItem

Question

我有这样的菜单结构：

1. Option A
    1.1 Option B
        1.1.1 Option C
        1.1.2 Option D
    1.2 Option C
        1.2.1 Option B
        1.2.2 Option D
    1.3 Option D
        1.3.1 Option B
        1.3.2 Option C
2. Option B
    2.1 Option A
        2.1.1 Option C
        2.1.2 Option D
    2.2 Option C
        2.2.1 Option A
        2.2.2 Option D
    2.3 Option D
        2.3.1 Option A
        2.3.2 Option C
3. Option C
    3.1 Option A
        3.1.1 Option B
        3.1.2 Option D
    3.2 Option B
        3.2.1 Option A
        3.2.2 Option D
    1.3 Option D
        3.3.1 Option A
        3.3.2 Option B
4. Option D
    4.1 Option A
        4.1.1 Option B
        4.1.2 Option C
    4.2 Option B
        4.2.1 Option A
        4.2.2 Option C
    4.3 Option C
        4.3.1 Option A
        4.3.2 Option B

我为什么要做这样的事？- 此菜单用于选择选项组合，A,B,C,D其中所选选项的顺序很重要。
例如：用户单击菜单项 2.3.1。这就产生了组合B-D-A。

现在，你知道我目前在理论上是如何做到的。事实上，还有更多的选择可以组合。但只能同时组合三个。
问题是我必须在显示菜单之前创建所有菜单项（三层深）。

有没有办法在需要时添加子菜单项（即应该显示它们的时候）？

Answer 1

您可以添加虚拟项目作为子菜单的占位符，然后使用OnClick具有虚拟项目的项目的事件处理程序将其替换为真实项目。

以下仅用于演示，并不意味着在生产代码中使用。它重复了问题中的示例。

procedure TForm1.PopupMenu1Popup(Sender: TObject);
var
  NewItem: TMenuItem;
  i: Integer;
begin
  PopupMenu1.Items.Clear;
  for i := 0 to 3 do begin
    NewItem := TMenuItem.Create(PopupMenu1);
    NewItem.Caption := Format('%d. Option %s', [i + 1, Chr(i + 65)]);
    NewItem.OnClick := ItemClick;
    NewItem.Tag := i;
    NewItem.Add(TMenuItem.Create(NewItem));
    PopupMenu1.Items.Add(NewItem);
  end;
end;


procedure TForm1.ItemClick(Sender: TObject);
var
  Root: TMenuItem;

  function ItemLevel(Item: TMenuItem): Integer;
  begin
    Result := 0;
    while Item.Parent <> Root do begin
      Item := Item.Parent;
      Inc(Result);
    end;
  end;

  function ExistsInTree(Item: TMenuItem; Option: Integer): Boolean;
  begin
    Result := Option = Item.Tag;
    if not Result then
      while Item.Parent <> Root do begin
        Item := Item.Parent;
        Result := Option = Item.Tag;
        if Result then
          Break;
      end;
  end;

  function LevelString(Item: TMenuItem): string;
  begin
    Result := '';
    while Item.Parent <> Root do begin
      Item := Item.Parent;
      Result := IntToStr(Item.MenuIndex + 1) + '.' + Result;
    end;
  end;

var
  Item, NewItem: TMenuItem;
  i: Integer;
  path: string;
begin
  Item := Sender as TMenuItem;
  Root := PopupMenu1.Items;

  if ItemLevel(Item) < 2 then begin
    if Item.Count = 1 then begin
      for i := 0 to 3 do begin
        if ExistsInTree(Item, i) then
          Continue;

        NewItem := TMenuItem.Create(Item);
        NewItem.OnClick := ItemClick;
        NewItem.Tag := i;
        Item.Add(NewItem);
        NewItem.Caption := Format('%s%d. Option %s',
                           [LevelString(NewItem), Item.Count - 1, Chr(i + 65)]);
        if ItemLevel(NewItem) < 2 then
          NewItem.Add(TMenuItem.Create(NewItem));
      end;
      Item.Delete(0);
    end;
  end else begin
    path := Chr(Item.Tag + 65);
    while Item.Parent <> Root do begin
      Item := Item.Parent;
      path := Chr(Item.Tag + 65) + '-' + path;
    end;
    ShowMessage(path);
  end;
end;