Search code examples
delphidelphi-xefreepascallazarus

How to copy part of a Treeview to a Menu


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.


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.