Как скопировать часть Treeview в меню

Я пытаюсь скопировать часть Treeview во всплывающее меню, и мне совсем не повезло. Я просто не могу заставить рекурсию работать, и я знаю, что, вероятно, делаю все это неправильно.

Возьмите этот пример изображения (который является скриншотом времени выполнения из кода ниже):

введите здесь описание изображения

Мне нужно, чтобы меню было создано с теми же отношениями, что и Treeview, но я не хочу добавлять корневой элемент. Вот как я хочу, чтобы это выглядело:

введите здесь описание изображения

Обратите внимание, что первый элемент — это не значок настроек (Root), а то, что они находятся на уровнях, таких как Treeview.

Это код, который у меня есть:

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.

Я также пытаюсь добавить в свойство MenuItem Tag, чтобы я мог идентифицировать каждый пункт меню по его тегу.

Я думал, что рекурсия в основном означает повторный вызов процедуры из процедуры, поэтому она повторяется, в любом случае я действительно мог бы сделать с некоторой помощью.

Спасибо.


delphi freepascal lazarus delphi-xe
person Community    schedule 14.09.2013    source источник

Ответы (2)


arrow_upward
6
arrow_downward

С вашим пониманием рекурсивного вызова проблем нет, но вы не хотите добавлять элемент для корневого узла, поэтому вам следует добавить элемент и выполнить рекурсию для каждого дочернего элемента любого узла, переданного процедуре. Вот один пример реализации:

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);
  ..

Обратите внимание, что я изменил объявление TreeViewToMenu для (1) TreeView не используется и (2) мы добавляем элементы либо к TPopupMenu, либо к TMenuItem, поэтому я объявил «OutMenu» как TComponent, который будет принимать оба.

person Sertac Akyuz    schedule 14.09.2013
comment
Экспериментируя с созданием TMenuItems во время выполнения, я столкнулся с ужасной проблемой, поскольку меню увеличивается в размерах. Каждый вызов Add вызывает полную перестройку меню. Возможен обходной путь с помощниками классов, который устанавливает ComponentState = [csLoading], избегая сотен перестроений пунктов меню. Дерево из 100 элементов будет создаваться в 100 раз медленнее, чем дерево из 10 элементов, и так далее, O(N^2). - person Warren P; 14.09.2013
comment
@Warren - Спасибо за это. У меня когда-то была похожая проблема - если я правильно помню, которая была вызвана RethinkHotkeys - я не мог найти решение и изменил дизайн. - person Sertac Akyuz; 14.09.2013
comment
+1 Это точно соответствует ситуации ОП. Но это будет работать только тогда, когда есть этот главный корневой элемент. - person NGLN; 14.09.2013
comment
@NGLN. Точнее, он работает с любым узлом, но добавляет не этот узел, а его дочерние элементы и так далее. Спасибо и +1 за ваш ответ, по крайней мере, напомнивший мне, что TPopupMenu.Items на самом деле является TMenuItem, на самом деле мне не нужно было менять объявление. Однако я не буду изменять ответ, так как ваш показывает, как это должно быть сделано. - person Sertac Akyuz; 15.09.2013
comment
@Sertac +1 По поводу TMenuItem, но извините за придирчивость: когда нет корневого элемента, Items[0].Count = 0 (Items[0].HasChildren = False) и ваш цикл не запустится. Я знаю, я пробовал, потому что забыл этот корневой элемент в своем собственном тестовом коде. - person NGLN; 15.09.2013
comment
Спасибо за объяснение изменений, это прекрасно работает. И +1 за альтернативу от @NGLN - person ; 15.09.2013
comment
@NGLN - это то, что я сказал;) - .. но он добавляет не этот узел, а его дочерние элементы и так далее. Если дочерних элементов нет, он ничего не добавляет. Я не противоречил вам, я пытался сказать, что вы можете передать любой узел для заполнения его дочерних элементов в меню. - person Sertac Akyuz; 15.09.2013

arrow_upward
3
arrow_downward

Как говорит Сертак, вы добавляете все элементы меню в корень PopupMenu. Вы должны добавить пункты подменю к последнему созданному пункту меню.

Таким образом, альтернативный подход с использованием TTreeNode.GetFirstChild и .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;

Обратите внимание, что подпрограмма начинается здесь с индекса элемента 1, первого дочернего элемента вашего корневого элемента. Когда не будет корневого элемента, начните с индекса 0.

person NGLN    schedule 14.09.2013