动态创建SQL Server表弹出菜单树德尔福

Question

我有这样的一个表：

id  parent_id  name 
1   1   Root 
2   1   Car 
3   1   Plane 
4   2   BMW 
5   4   CLK 

我怎么能动态地创建弹出菜单，在德尔福所有子项？

这是应该的样子：

image http://img217.imageshack.us/img217/5020/treees.jpg

Answer 1

假设根元素有NULL作为PARENT_ID可以发出请求

Select ID, Parent_ID, Name from all_my_menus 
    order by Parent_ID nulls first, ID 
    where Menu_ID = :MenuIDParameter 

1 <NULL> Root 
8 <NULL> another root 
2  1 Car 
4  1 Plane 
3  2 BMW 
5  4 CLK 

你还能缓存在内存中创建的菜单项：var MI_by_id: TDictionary<integer, TMenuItem>;

通过结果的穿越会是什么样子

var MI: TMenuItem; 
    MI_by_id: TDictionary<integer, TMenuItem>; 
begin 
    MI_by_id := TDictionary<integer, TMenuItem>.Create; 
    try 
    While not Query.EOF do begin 
     MI := TMenuItem.Create(Self); 
     MI.Caption := Query.Fields[2].AsString; 
     MI.Tag := Query.Fields[0].AsInteger; // ID, would be helpful for OnClick event 
     MI.OnClick := ...some click handler 

     if Query.Fields[1].IsNull {no parent} 
      then MainMenu.Items.Add(MI) 
      else MI_by_id.Items[Query.Fields[1].AsInteger].Add(MI); 

     MI_by_id.Add(MI.Tag, MI); //save shortcut to potential parent for future searching 
     Query.Next; 
    end; 
    finally 
    MI_by_id.Free; 
    end; 
end; 

其实，因为我们对Parent_ID进行排序在查询中，给定父母的所有孩子都会创建单一连续列表，因此，在我们填充最后一个孩子后，可能会更好地从字典中移除填充父母。在parent_ID获得新值之后），并且缓存先前在另一个局部变量中找到父项（而不是在字典中进行另一次搜索）。 然而，以人为目标的菜单的合理大小应该少得多。但是你必须明白，这种方法很可能会随着O（n * n）随着表的增长而以非常快的速度开始减速。

• http://docwiki.embarcadero.com/Libraries/XE3/en/Vcl.Menus.TMenuItem.Add
• http://docwiki.embarcadero.com/CodeExamples/XE2/en/Generics.Collections.TDictionary_(Delphi）

注意：这也要求为每个非根元素ID> PARENTID（放在桌子上检查约束）

1 <NULL> Root 
8 <NULL> another root 
7  1 Plane 
3  4 BMW 
4  7 CLK 
5  8 Car 

这将导致宝马绑在母公司CLK创建之前。

• 递归负载： 违反该条件可以通过一些手段来克服select <items> where Parent_id is null，然后为每个加入的菜单项都select <items> where Parent_id = :current_memuitem_id等上。这就像VirtualTreeView可以工作
• 要求SQL服务器对树进行排序和扁平化 - 这通常称为自递归SQL选择，并且依赖于服务器。
• 介绍一个更多的收集变量 - 无父项的菜单项。在每个新项目添加到菜单后，如果有待处理的子项从其中提取并移动到新创建的父项中，则应该搜索该集合。

Answer 2

试试这个

procedure TForm1.MyPopup(Sender: TObject); 
begin 
    with Sender as TMenuItem do ShowMessage(Caption); 
end; 

procedure TForm1.Button1Click(Sender: TObject); 
var 
    MyItem,MySubItem1: TMenuItem; 
begin 
    Inc(Num); 
    MyItem:=TMenuItem.Create(Self); 
    MySubItem1:=TMenuItem.Create(Self); 

    MyItem.Caption:='Hello'+IntToStr(Num); 
    MySubItem1.Caption:='Good Bye'+IntToStr(Num); 

    MainMenu1.Items.Add(MyItem); 
    MainMenu1.Items[0].Insert(num-1,MySubItem1); 

    MyItem.OnClick:=MyPopUp; 
    MySubItem1.OnClick:=MyPopUp; 
end; 

从http://www.greatis.com/delphicb/tips/lib/components-addmenuitem.html

Answer 3

此溶液中取出需要root的PARENT_ID为0，与

测试

Select 1 as ID,   0 as Parent_ID,   'Root' as Name 
union 
Select 2,   1,  ' Car' 
union 
Select 3 ,   1,   'Plane' 
union 
Select 4,   2,  'BMW' 
union 
Select 5,   4,   'CLK' 

应该优化，刚才缺乏时间...

Function GetMenu(pop:TPopupmenu;ID:Integer):TMenuItem; 
var 
i:Integer; 
Function CheckItem(mi:TMenuItem):TMenuItem; 
    var 
    i:Integer; 
    begin 
     Result := nil; 
     if mi.Name = 'DYN_' + INtToStr(ID) then Result := mi 
     else for i := 0 to mi.Count-1 do 
     if not Assigned(Result) then Result := CheckItem(mi[i]); 
    end; 
begin 
    Result := nil; 
    for i := 0 to pop.Items.Count-1 do 
    begin 
     if not Assigned(Result) then Result := CheckItem(pop.Items[i]); 
     if Assigned(Result) then Break; 
    end; 
end; 


Function InsertMenuItem(pop:TPopupMenu;mi:TMenuItem;ID:Integer;Const caption:String):TMenuItem; 
begin 
    Result := TMenuItem.Create(pop); 
    Result.Caption := caption; 
    Result.Name := 'DYN_' + INtToStr(ID) ; 
    if not Assigned(mi) then pop.Items.Add(Result) else mi.Add(Result); 

end; 

Function AddMenuItem(pop:TPopupmenu;ID:Integer;Ads:TDataset):TMenuItem; 
begin 
    Ads.Locate('ID',ID,[]); 
    Result := GetMenu(pop,id); 
    if (not Assigned(Result)) then 
    begin 
    if (Ads.FieldByName('parent_ID').AsInteger<>0) then 
     begin 
     result := AddMenuItem(pop,Ads.FieldByName('parent_ID').AsInteger,Ads); 
     Ads.Locate('ID',ID,[]); 
     end; 
    Result := InsertMenuItem(pop,Result,ID,Ads.FieldByName('Name').AsString); 
    end; 
    Ads.Locate('ID',ID,[]); 
end; 

procedure TForm1.Button1Click(Sender: TObject); 

begin 
    while not ADS.Eof do 
     begin 
     AddMenuItem(Popupmenu1,ads.FieldByName('ID').AsInteger,Ads); 
     Ads.Next 
     end; 
end; 

Answer 4

这样一个简单的问题，太多的解决方案。太糟糕了，您订购了ID，因为没有订购ID，事情会变得更有趣。这是我自己的解决方案。在一个空的表单上拖放一个按钮，一个TClientDataSet和一个TPopupMenu。制作窗体的PopupMenu = PopupMenu1，以便看到结果。添加到Button1.OnClick：

注意：我故意使用TClientDataSet而不是一个真正的查询。这个问题不是关于查询，这个解决方案适用于你抛出的任何TDataSet后代。只要确保结果集是在id上订购的，否则您可以在父母面前看到子节点。还要注意，有一半的代码用于填充ClientDataSet和问题中的示例数据！

procedure TForm16.Button1Click(Sender: TObject); 
var Prev: TDictionary<Integer, TMenuItem>; // We will use this to keep track of previously generated nodes so we do not need to search for them 
    CurrentItem, ParentItem: TMenuItem; 
begin 
    if not ClientDataSet1.Active then 
    begin 
    // Prepare the ClientDataSet1 structure 
    ClientDataSet1.FieldDefs.Add('id', ftInteger); 
    ClientDataSet1.FieldDefs.Add('parent_id', ftInteger); 
    ClientDataSet1.FieldDefs.Add('name', ftString, 100); 

    ClientDataSet1.CreateDataSet; 

    // Fill the dataset 
    ClientDataSet1.AppendRecord([1, 1, 'Root']); 
    ClientDataSet1.AppendRecord([2, 1, 'Car']); 
    ClientDataSet1.AppendRecord([3, 1, 'Plane']); 
    ClientDataSet1.AppendRecord([4, 2, 'BMW']); 
    ClientDataSet1.AppendRecord([5, 4, 'CLK']); 
    end; 

    // Clear the existing menu 
    PopupMenu1.Items.Clear; 

    // Prepare the loop 
    Prev := TDictionary<Integer, TMenuItem>.Create; 
    try 
    ClientDataSet1.First; // Not required for a true SQL Query, only required here for re-entry 
    while not ClientDataSet1.Eof do 
    begin 
     CurrentItem := TMenuItem.Create(Self); 
     CurrentItem.Caption := ClientDataSet1['name']; 

     if (not ClientDataSet1.FieldByName('parent_id').IsNull) and Prev.TryGetValue(ClientDataSet1['parent_id'], ParentItem) then 
     ParentItem.Add(CurrentItem) 
     else 
     PopupMenu1.Items.Add(CurrentItem); 

     // Put the current Item in the dictionary for future reference 
     Prev.Add(ClientDataSet1['id'], CurrentItem); 

     ClientDataSet1.Next; 
    end; 
    finally Prev.Free; 
    end; 
end; 

Answer 5

有趣的难题......另一个深夜思想，重新使用:)

做一个衍生成分的实际答案：

type 
    TCascadeMenuItem = class(TMenuItem) 
    private 
    Id: Integer; 
    public 
    function AddItem(const ToId, WithId: Integer; AName: string): Boolean; 
    end; 

与代码

function TCascadeMenuItem.AddItem(const ToId, WithId: Integer; AName: string): Boolean; 
var 
    i: Integer; 
    cmi: TCascadeMenuItem; 
begin 
    if ToId = Id then 
    begin 
    cmi := TCascadeMenuItem.Create(Owner); 
    cmi.Caption := AName; 
    cmi.Id := WithId; 
    Add(cmi); 
    Result := True; 
    end 
    else begin 
    i := 0; 
    Result := False; 
    while (i < Count) and (not Result) do 
    begin 
     Result := TCascadeMenuItem(Items[i]).AddItem(ToId,WithId, ANAme); 
     inc(i); 
    end; 
    end; 

结束;

主要形式，假定您的数据：

procedure TForm4.Button2Click(Sender: TObject); 
var 
    mi: TCascadeMenuItem; 
    i: Integer; 
    Added: Boolean; 
begin 
    cds1.First; 
    while not cds1.Eof do 
    begin 
     i := 0; 
     Added := False; 
     while (i < pup.Items.Count) and (not Added) do 
     begin 
     Added := TCascadeMenuItem(pup.Items[i]).AddItem(cds1Parent_Id.AsInteger, cds1id.AsInteger, cds1name.AsString); 
     inc(i); 
     end; 
     if not Added then 
     begin // new root 
     mi := TCasCadeMenuItem.Create(Self); 
     mi.Caption := cds1name.AsString; 
     mi.id := cds1Parent_Id.AsInteger; 
     pup.Items.Add(mi); 
     end; 
     cds1.Next; 
    end; 
end; 

你可以得到一个TCascasePopupMenu并把它放在调色板:)