How to copy part of a Treeview to a Menu

Question

I am trying to copy part of a Treeview to a popup menu, and am not having any luck at all I just cannot seem to get recursion to work and I know I am probably doing it all wrong.

Take this example image (which is a runtime screenshot from the code below):

I need the menu to be created with the same relationship as the Treeview, but I do not want the Root item adding. This is what I want it to look like:

Note the first item is not the settings icon (Root), and that they are in levels like the Treeview.

This is the code I have:

unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ComCtrls,
  Menus, StdCtrls, Buttons;

type
  TForm1 = class(TForm)
    Button1: TButton;
    ImageList1: TImageList;
    MenuItem1: TMenuItem;
    PopupMenu1: TPopupMenu;
    TreeView1: TTreeView;
    procedure MyMenuItemClick(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    procedure TreeViewToMenu(TreeView: TTreeView; BaseNode: TTreeNode; OutMenu: TMenu);
  public
    { public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.lfm}

procedure TForm1.MyMenuItemClick(Sender: TObject);
begin
  ShowMessage('You selected ' + TMenuItem(Sender).Name + ' - Tag: ' +
    IntToStr(TMenuItem(Sender).Tag));
end;

procedure TForm1.TreeViewToMenu(TreeView: TTreeView; BaseNode: TTreeNode; OutMenu: TMenu);
var
  I: Integer;
  MenuItem: TMenuItem;
begin
  MenuItem := TMenuItem.Create(nil);
  with MenuItem do
  begin
    Caption := BaseNode.Text;
    ImageIndex := BaseNode.ImageIndex;
    OnClick := @MyMenuItemClick;
  end;

  for I := 0 to BaseNode.Count - 1 do
  begin
    MenuItem.Tag := I;
    TreeViewToMenu(TreeView, BaseNode[I], OutMenu);
  end;

  OutMenu.Items.Add(MenuItem);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  Pt: TPoint;
  I: Integer;
  Node: TTreeNode;
begin
  Pt.X := Button1.Left + 1;
  Pt.Y := Button1.Top + Button1.Height + 1;
  Pt := ClientToScreen(Pt);

  PopupMenu1.Items.Clear;
  TreeViewToMenu(TreeView1, TreeView1.Items[0], PopupMenu1);

  PopupMenu1.Popup(Pt.X, Pt.Y);
end;

end.

I am also trying to add to the MenuItem Tag property so I can identify each menu item by its tag.

I thought recursion basically meant calling the procedure again from within the procedure, so it repeats itself, either way I really could do with some help.

Thanks.

Middlebrow

Answer 1

There's no problem with your understanding of a recursive call, but you don't want to append an item for the root node, so you should add an item and recurse for each child of any node that's passed to the procedure. Here's one sample implementation:

type
  TForm1 = class(TForm)
    ..
  private
    procedure TreeViewToMenu(BaseNode: TTreeNode; OutMenu: TComponent);
    ..

procedure TForm1.TreeViewToMenu(BaseNode: TTreeNode; OutMenu: TComponent);
var
  i: Integer;
  Node: TTreeNode;
  MenuItem: TMenuItem;
begin
  for i := 0 to BaseNode.Count - 1 do begin
    Node := BaseNode.Item[i];

    MenuItem := TMenuItem.Create(nil);
    MenuItem.Caption := Node.Text;
    MenuItem.ImageIndex := Node.ImageIndex;
    MenuItem.Tag := i;
    if Node.Count = 0 then
      MenuItem.OnClick := MyMenuItemClick;

    if OutMenu is TPopupMenu then
      TMenu(OutMenu).Items.Add(MenuItem)
    else if
      OutMenu is TMenuItem then
        TMenuItem(OutMenu).Add(MenuItem)
      else
        raise Exception.Create('Invalid class type');

    TreeViewToMenu(Node, MenuItem);

  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  ..
begin
  ..
  TreeViewToMenu(TreeView1.Items[0], PopupMenu1);
  ..

Note that I changed the declaration of TreeViewToMenu for (1) the TreeView is not used and (2) we are appending to items to either a TPopupMenu or a TMenuItem, hence I declared 'OutMenu' as TComponent which would accept both.

Moquette

When experimenting with creating TMenuItems at runtime I find a terrible problem as the menu grows in size. Each Add call causes a full rebuild of the menus. A workaround with class helpers is possible that sets ComponentState = [csLoading] avoiding hundreds of menu item rebuilds. A tree of 100 items will be 100x slower than a tree of 10 items to create, and so on, O(N^2). – Gandhi

@Warren - Thanks for that. I once had a similar problem - if I recall correct which was caused by RethinkHotkeys - which I couldn't find a solution and changed the design. – Moquette

+1 It matches OP's situation exactly. But it will only work when there is that master root item. – Dehlia

@Dehlia - To be exact it works with any node, but it doesn't add that node but its children and so on. Thanks and +1 for your answer for at the very least reminding me that TPopupMenu.Items is actually a TMenuItem, in fact I didn't need to change the declaration. I won't modify the answer though, since yours shows how it should be done. – Moquette

@Sertac +1 On the TMenuItem thing, but sorry to be pernickety: when there is no root item, Items[0].Count = 0 (Items[0].HasChildren = False) and your loop won't run. I know, I tried it, because I forgot that root item in my own test code. – Dehlia

Thanks for explaining the changes, this works great. And +1 for the alternative from @Dehlia – Middlebrow

@Dehlia - That was what I said ;) - .. but it doesn't add that node but its children and so on. If there're no child then it doesn't add anything. I was not contradicting you, I was trying to say you can pass any node for having its children populated in a menu. – Moquette

Answer 2

Like Sertac says, you are adding all menu items to the root of the PopupMenu. You should add sub menu items to the last menu item created.

Hereby an alternative approach, making use of TTreeNode.GetFirstChild and .GetNextSibling:

procedure TForm1.TreeViewToMenu(Node: TTreeNode; Menu: TMenuItem);
var
  MenuItem: TMenuItem;
begin
  while Node <> nil do
  begin
    MenuItem := TMenuItem.Create(nil);
    MenuItem.Caption := Node.Text;
    MenuItem.ImageIndex := Node.ImageIndex;
    Menu.Add(MenuItem);
    if Node.HasChildren then
      TreeViewToMenu(Node.GetFirstChild, MenuItem)
    else
      MenuItem.OnClick := MyMenuItemClick;
    Node := Node.GetNextSibling;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  PopupMenu1.Items.Clear;
  TreeViewToMenu(TreeView1.Items[1], PopupMenu1.Items);
end;

Note that the routine starts here with item index 1, the first child of your root item. When there would not be a root item, start with index 0.

Dehlia