VirtualStringTree - Can't get parent-child nodes to work correctly

Question

I need to render a Main-Menu in a TVirtualStringTree - each menu item has a Category. The Categories will make up the root nodes of the tree, and under each Category root node, will be the menu items.

The datasets fields for the Categories and MenuItems look like this:

My code in OnInitNode scrolls through the Category dataset's records and loads the menu items for each Category as child nodes. However I've got something wrong (see image) and the Category nodes are all the same text - which means that the dataset is not scrolling to the next record.

It seems that this line of code in the InitNode event is causing it to exit the loop and seems to be the cause of problem:

Sender.ChildCount[Node] := x;

But then what is the proper way to render the child nodes?

This is my code:

type
  TTreeCategoryData = record
    ID: Integer;
    DispText: String;
  end;

  PTreeCategoryData = ^TTreeCategoryData;

  TTreeMenuItemData = record
    ID: Integer;
    CategoryID: Integer;
    DispText: String;
    ClassName: String;
  end;

  PTreeMenuItemData = ^TTreeMenuItemData;

  Tvstmainmenu_CategoryNodeData = record
    TreeCategoryData: PTreeCategoryData;
  end;

  Pvstmainmenu_CategoryNodeData = ^Tvstmainmenu_CategoryNodeData;

  Tvstmainmenu_MenuItemNodeNodeData = record
    TreeMenuItemData: PTreeMenuItemData;
  end;

  Pvstmainmenu_MenuItemNodeNodeData = ^Tvstmainmenu_MenuItemNodeNodeData;


procedure TfmMain.FormShow(Sender: TObject);
var
  x: Integer;
begin
  datamod.uspspmenucatgy_S.PrepareSQL(True);
  datamod.uspspmenucatgy_S.Open;

  x := datamod.uspspmenucatgy_S.RecordCount;
  vstmainmenu.RootNodeCount := x;
end;

procedure TfmMain.vstmainmenuFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode);
var
  CategoryNodeData: Pvstmainmenu_CategoryNodeData;
  MenuItemNodeNodeData: Pvstmainmenu_MenuItemNodeNodeData;
begin
  if (Sender.GetNodeLevel(Node) = 0) then
  begin
    CategoryNodeData := Sender.GetNodeData(Node);

    if Assigned(CategoryNodeData) and Assigned(CategoryNodeData.TreeCategoryData) then
    begin
      Dispose(CategoryNodeData.TreeCategoryData);
    end;
  end
  else if (Sender.GetNodeLevel(Node) = 1) then
  begin
    MenuItemNodeNodeData := Sender.GetNodeData(Node);

    if Assigned(MenuItemNodeNodeData) and Assigned(MenuItemNodeNodeData.TreeMenuItemData) then
    begin
      Dispose(MenuItemNodeNodeData.TreeMenuItemData);
    end;
  end;

end;

procedure TfmMain.vstmainmenuGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex;
  TextType: TVSTTextType; var CellText: string);
var
  CategoryNodeData: Pvstmainmenu_CategoryNodeData;
  MenuItemNodeNodeData: Pvstmainmenu_MenuItemNodeNodeData;

  TreeCategoryData: PTreeCategoryData;
  TreeMenuItemData: PTreeMenuItemData;
begin

  if (Sender.GetNodeLevel(Node) = 0) then
  begin
    CategoryNodeData := Sender.GetNodeData(Node);

    if Assigned(CategoryNodeData) and Assigned(CategoryNodeData.TreeCategoryData) then
    begin
      TreeCategoryData := CategoryNodeData.TreeCategoryData;

      CellText := TreeCategoryData^.DispText;
    end;
  end
  else if (Sender.GetNodeLevel(Node) = 1) then
  begin
    MenuItemNodeNodeData := Sender.GetNodeData(Node);

    if Assigned(MenuItemNodeNodeData) and Assigned(MenuItemNodeNodeData.TreeMenuItemData) then
    begin
      TreeMenuItemData := MenuItemNodeNodeData.TreeMenuItemData;

      CellText := TreeMenuItemData^.DispText;
    end;
  end;

end;

procedure TfmMain.vstmainmenuInitNode(Sender: TBaseVirtualTree; ParentNode, Node: PVirtualNode;
  var InitialStates: TVirtualNodeInitStates);
var
  CategoryNodeData: Pvstmainmenu_CategoryNodeData;
  MenuItemNodeNodeData: Pvstmainmenu_MenuItemNodeNodeData;

  x: Integer;
begin

  if (Sender.GetNodeLevel(Node) = 0) then
  begin
    CategoryNodeData := Sender.GetNodeData(Node);
    CategoryNodeData.TreeCategoryData := New(PTreeCategoryData);

    with CategoryNodeData.TreeCategoryData^ do
    begin
      ID := datamod.uspspmenucatgy_Srow_id.AsInteger;
      DispText := datamod.uspspmenucatgy_Scategory.AsString;
    end;

    // :Pcategory_id
    datamod.uspspmenu_S.ParamByName('Pcategory_id').AsInteger := datamod.uspspmenucatgy_Srow_id.AsInteger;
    datamod.uspspmenu_S.PrepareSQL(True);
    if (datamod.uspspmenu_S.State = dsBrowse) then
      datamod.uspspmenu_S.Refresh
    else
      datamod.uspspmenu_S.Open;

    x := datamod.uspspmenu_S.RecordCount;

    Sender.ChildCount[Node] := x;

    datamod.uspspmenucatgy_S.Next;
  end
  else if (Sender.GetNodeLevel(Node) = 1) then
  begin
    MenuItemNodeNodeData := Sender.GetNodeData(Node);
    MenuItemNodeNodeData.TreeMenuItemData := New(PTreeMenuItemData);

    with MenuItemNodeNodeData.TreeMenuItemData^ do
    begin
      ID := datamod.uspspmenu_Srow_id.AsInteger;
      CategoryID := datamod.uspspmenucatgy_Srow_id.AsInteger;
      DispText := datamod.uspspmenu_Smenuitem.AsString;
      ClassName := datamod.uspspmenu_Stframeclass.AsString;
    end;

    datamod.uspspmenu_S.Next;
  end;

end;

Here is what is happening. Each root node (parent) should be different but it isn't. Further the child nodes for the 2nd root node should be different, but it seems to be stuck on the last child node of the 1st root node:

Thanks in advance!

Answer 1

Try some alternative approach like creating nodes in a separate procedure, e.g.:

procedure TfrmMain.LoadTree;
var
  LTreeCategoryData: PTreeCategoryData;
  LCategoryNode: PVirtualNode;
begin
  datamod.uspspmenucatgy_S.PrepareSQL(True);
  datamod.uspspmenucatgy_S.Open;
  while not datamod.uspspmenucatgy_S.Eof do
  begin
    // 1. create parent node itself
    LTreeCategoryData := New(PTreeCategoryData);
    with LTreeCategoryData^ do
    begin
      ID := datamod.uspspmenucatgy_Srow_id.AsInteger;
      DispText := datamod.uspspmenucatgy_Scategory.AsString;
    end;
    LCategoryNode := vstmainmenu.AddChild(vstmainmenu.RootNode, LTreeCategoryData);

    // 2. create child nodes
    datamod.uspspmenu_S.ParamByName('Pcategory_id').AsInteger := datamod.uspspmenucatgy_Srow_id.AsInteger;
    datamod.uspspmenu_S.PrepareSQL(True);
    datamod.uspspmenu_S.Open;
    while not datamod.uspspmenu_S.Eof do
    begin
      LTreeMenuItemData := New(PTreeMenuItemData);

      with LTreeMenuItemData^ do
      begin
        ID := datamod.uspspmenu_Srow_id.AsInteger;
        CategoryID := datamod.uspspmenucatgy_Srow_id.AsInteger;
        DispText := datamod.uspspmenu_Smenuitem.AsString;
        ClassName := datamod.uspspmenu_Stframeclass.AsString;
      end;

      vstmainmenu.AddChild(LCategoryNode, LTreeMenuItemData);

      datamod.uspspmenu_S.Next;
    end;
    datamod.uspspmenu_S.Close;

    datamod.uspspmenucatgy_S.Next;
  end;
  datamod.uspspmenucatgy_S.Close;
end;

Just call this new procedure, whenever you want to load the whole tree.