从 Delphi 中的 sql 服务器表动态创建弹出菜单树

Question

我有一张这样的桌子：

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

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

它应该是这样的：

Answer 1

针对这样一个简单问题的解决方案太多了。 太糟糕了，你订购了ID，因为没有订购ID的东西会更有趣。 这是我自己的解决方案。 在空表单上放置一个按钮，一个TClientDataSet和一个TPopupMenu。 使表单的PopupMenu = PopupMenu1，以便您可以看到结果。 将其添加到Button1.OnClick：

注意：我故意使用TClientDataSet而不是真正的Query。 这个问题与查询无关，此解决方案适用于您抛出的任何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> 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并将其放在调色板上:)