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

Question

我有一张这样的桌子：

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

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

它应该是这样的：

score 3 · Accepted Answer

假设根元素的 Parent_ID 为 NULL，您可以发出请求

 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 获得新值之后）并缓存之前从字典中删除填充的父级可能会更好否则在另一个局部变量中找到父级（而不是通过字典进行另一个搜索）。然而，以人为本的菜单的合理大小应该不值得这样做。但是您必须了解这种方法很可能会随着表的增长而扩展，因此会以非常快的速度开始降低速度。

注意：这也要求对于每个非根元素 ID > ParentID（将 CHECK CONSTRAINT 放在表上）

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

这将导致 BMW 在其父 CLK 创建之前绑定创建。违反该条件可以通过以下几种方式克服：

recursive load: select <items> where Parent_id is null，然后为每个添加的菜单项做select <items> where Parent_id = :current_memuitem_id，依此类推。这就像 VirtualTreeView 会工作
要求 SQL 服务器对树进行排序和展平 - 这通常称为自递归 SQL 选择，并且取决于服务器。
引入另一个集合变量 - 没有父级的菜单项。在将每个新项目添加到菜单之后，如果有待处理的子项要从中提取并移动到新创建的父项中，则应搜索此集合。

score 3 · Accepted Answer

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

score 2 · Accepted Answer

尝试这个

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

score 1 · Accepted Answer

有趣的难题......另一个深夜的想法，重用的实用答案:)

制作派生组件：

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 并将其放在调色板上:)

score 1 · Accepted Answer

此解决方案要求 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;

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

5 回答 5

Related

Reference