delphi - 如何创建带有滚动条且支持子菜单的弹出菜单

Question

我想将滚动条(和/或滚轮支持)添加到我现有的 Delphi 应用程序的弹出菜单中，因为它们通常高于屏幕，并且内置的滚动功能不够好。 How to make a popup menu with scrollbar?对我来说将是一个很好的解决方案，只是它不支持我绝对需要的子菜单。该解决方案的作者自去年 7 月以来就没有出现在 StackOverflow 上，所以我认为他不会回复我的评论。谁能看到如何修改该代码以添加对子菜单的支持？如果重要的话，我需要它与 Delphi 2007 一起工作。

Answer 1

我同意 @KenWhite 对用户如何收到庞大菜单的保留意见。因此，向他和读者道歉，以下内容可能会冒犯他们的情感;=)

无论如何，我希望下面的代码表明原则上，它很简单创建基于 TPopUpMenu 的 TreeView(请参阅例程 PopUpMenuToTree)，它反射(reflect)了 PopUpMenu 的结构，包括子项目，并利用 TreeView 的自动垂直滚动条。在代码中，PopUpMenu 恰好与 TreeView 具有相同的窗体，但这仅适用于当然，紧凑性 - PopUpMenu 可以完全采用另一种形式。

正如评论中提到的，我个人会基于这样的事情TVirtualTreeView ( http://www.soft-gems.net/index.php/controls/virtual-treeview )因为它比标准 TTreeView 更具可定制性。

type
  TForm1 = class(TForm)
    PopupMenu1: TPopupMenu;
    TreeView1: TTreeView;  //  alClient-aligned
    Start1: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure TreeView1Click(Sender: TObject);
  private
  protected
    procedure MenuItemClick(Sender : TObject);
    procedure PopUpMenuToTree(PopUpMenu : TPopUpMenu; TreeView : TTreeView);
  public
  end;

var
  Form1: TForm1;

[...]

procedure TForm1.FormCreate(Sender: TObject);
var
  Item,
  SubItem : TMenuItem;
  i,
  j : Integer;
begin
  //  (Over)populate a PopUpMenu
  for i := 1 to 50 do begin
    Item := TMenuItem.Create(PopUpMenu1);
    Item.Caption := 'Item ' + IntToStr(i);
    Item.OnClick := MenuItemClick;
    PopUpMenu1.Items.Add(Item);
    for j := 1 to 5 do begin
      SubItem := TMenuItem.Create(PopUpMenu1);
      SubItem.Caption := Format('Item %d Subitem %d ', [i, j]);
      SubItem.OnClick := MenuItemClick;
      Item.Add(SubItem);
    end;
  end;

  //  Populate a TreeView from the PopUpMenu
  PopUpMenuToTree(PopUpMenu1, TreeView1);
end;

procedure TForm1.MenuItemClick(Sender: TObject);
var
  Item : TMenuItem;
begin
  if Sender is TMenuItem then
    Caption := TMenuItem(Sender).Caption + ' clicked';
end;

procedure TForm1.PopUpMenuToTree(PopUpMenu: TPopUpMenu;
  TreeView: TTreeView);
//  Populates the TreeView with the Items in the PopUpMenu
var
  i : Integer;
  Item : TMenuItem;
  RootNode : TTreeNode;

  procedure AddItem(Item : TMenuItem; ParentNode : TTreeNode);
  var
    Node : TTreeNode;
    j : Integer;
  begin
    Node := TreeView.Items.AddChildObject(ParentNode, Item.Caption, Item);
    for j := 0 to Item.Count - 1 do begin
      AddItem(Item.Items[j], Node);
    end;
  end;

begin
  TreeView.Items.BeginUpdate;
  TreeView.Items.Clear;
  try
    for i := 0 to PopUpMenu.Items.Count - 1 do begin
      AddItem(PopUpMenu.Items[i], Nil);
    end;
  finally
    TreeView.Items.EndUpdate;
  end;
end;

procedure TForm1.TreeView1Click(Sender: TObject);
var
  Node : TTreeNode;
  Item : TMenuItem;
begin
  if Sender is TTreeView then begin
    Node := TTreeView(Sender).Selected;
    Item := TMenuItem(Node.Data);
    Item.Click;
  end;
end;