2013-09-14 1 views
3

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

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

enter image description here

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

enter image description here

Обратите внимание на первый пункт не значок настройки (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 таким образом я могу определить каждый пункт меню его тега.

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

Спасибо.

ответ

6

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

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, который принял бы оба.

+5

При экспериментировании с созданием TMenuItems во время выполнения я нахожу ужасную проблему по мере того, как меню растет по размеру. Каждый вызов «Добавить» вызывает полную перестройку меню. Обходной путь с помощниками классов возможен, что устанавливает 'ComponentState = [csLoading]' избегая сотни перестроек меню. Дерево из 100 предметов будет в 100 раз медленнее, чем дерево из 10 элементов для создания и т. Д. O (N^2). –

+0

@ Уоррен - Спасибо за это. У меня когда-то была аналогичная проблема - если я правильно помню, что было вызвано RethinkHotkeys, - что я не мог найти решение и изменил дизайн. –

+0

+1 Это точно соответствует ситуации с ОП. Но он будет работать только тогда, когда есть этот главный корневой элемент. – NGLN

3

Как и Sertac says, вы добавляете все пункты меню в корень 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.

Смежные вопросы