dynamically create popup menu tree from sql server table in Delphi

Question

I have a table like this:

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

How can I dynamically create popup menu with all subitems in Delphi?

This is how it should look like:

Answer 1

Too many solutions for such a simple problem. Too bad you got ordered ID's because without ordered ID's things would have been more fun. Here's my own solution. On an empty form drop a button, a TClientDataSet and a TPopupMenu. Make the form's PopupMenu = PopupMenu1 so you can see the result. Add this to Button1.OnClick:

Note: I'm intentionally using TClientDataSet and not a real Query. This question is not about the query and this solution works with whatever TDataSet descendant you throw at it. Just make sure the result set is ordered on id , or else you could see the child nodes before the parents. Also note, half the code is used to fill up the ClientDataSet with the sample data in the question!

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

Assuming root element has NULL as Parent_ID you can issue the request

 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

You would also cache in-memory created menu items: var MI_by_id: TDictionary<integer, TMenuItem>;

The traversing through the results would look like

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;

Actually, since we made sort upon Parent_ID on the query, all the children for given parent make single continuous list, so could be better to remove populated parents from the dictionary after we populated last child (ie after parent_ID got new value) and caching previously found parent otherwise in another local variable (instead of making yet another search through the dictionary). However reasonable size for human-targeted menu should be much less to worth this. But you have to understand this approach most probably scales as O(n*n) thus would start loose speed very fast as the table grows.

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

Note: this also requires that for every non-root element ID > ParentID (put CHECK CONSTRAINT on the table)

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

This would lead to BMW tied to create before its parent CLK created. Violation for that conditions can be overcome by few means:

• recursive load: select <items> where Parent_id is null , then for each of the added menu items do select <items> where Parent_id = :current_memuitem_id and so on that. This is like VirtualTreeView would work
• ask SQL server to sort and flatten the tree - this is usually called self-recursive SQL selection and is server-dependant.
• introduce one more collection variable - menu items w/o parent. After each new item added to the menu this collection should be searched if there are pending children to extract from it and move into the newly created parent.

Answer 3

Try this

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;

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

Answer 4

This solution requires parent_id of root to be 0, tested with

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'

should by optimized, have just a lack of time ...

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

Interesting conundrum ...another late night thought, a practical answer for re-use :)

Make a derived component:

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

with code

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;

end;

Main form, Assumes your data:

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;

You could derive a TCascasePopupMenu and put it on the palette :)