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):

enter image description here

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:

enter image description here

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.

Was it helpful?

Solution

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.

OTHER TIPS

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.

Licensed under: CC-BY-SA with attribution
Not affiliated with StackOverflow
scroll top