从Delphi中的sql server表动态创建弹出菜单树

Question

我有一张这样的表：

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

如何在Delphi中动态创建包含所有子项的弹出菜单？

这应该是这样的：

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

Answer 1

针对这样一个简单问题的解决方案太多了。太糟糕了，你订购了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 2

假设根元素的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＆gt; ParentID（将CHECK CONSTRAINT放在表上）

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 3

试试这个

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 4

此解决方案要求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 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并将其放在调色板上：）