從 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並將其放在調色板上:)