TAdvVirtualTreeview How to subclass the nodes

VCL TMS VCL UI Pack
1

I'm trying to use the TAdvVirtualTreeview in virtual node mode and want to store references to other data within each node. I have not been able to find any examples of this nor anything on the forums other than mentions of overriding the nodes but no description of how. 


Looking through the source, I create 2 new classes that inherited off TAdvTreeViewNodes and TAdvTreeViewNode and overrode the GetItemClass in the TAdvTreeViewNodes to return the class of my new node. This gets called but in the OnGetNodeText the aNode is still a TAdvTreeViewVirtualNode and not my new class.

I can't see what I'm doing wrong. Does anyone have any pointers on which methods I should be overriding and if possible a simple example.
2

I have some code thats sort of working from looking at other forum entries. The is below. The problem with the code is when I click on a column to sort it, the order doesnt change. Is there another event/method I need to process to change the order ?


Unit Browser;

Interface

Uses
  AdvTreeView,
  AdvTreeViewData,
  Generics.Collections,
  Classes;

Type
  TMyNodes = Class(TAdvTreeViewNodes)
  protected
    function GetItemClass: TCollectionItemClass; override;
  End;

  TMyNode = Class(TAdvTreeViewNode)
  private
    FMyText: String;
  protected
    function CreateNodes: TAdvTreeViewNodes; override;
  public
    constructor Create(Collection: TCollection); override;
    Property MyText: String Read FMyText Write FMyText;
  End;

  TBrowser = Class(TAdvTreeView)
  Private
  Protected
    Procedure GetNumberOfNodes(aSender: TObject; aNode: TAdvTreeViewVirtualNode; Var aNumberOfNodes: Integer);
  Protected
//    function CreateNodes: TAdvTreeViewNodes; override;
  Public
    FStrings: TList<String>;
    Constructor Create(aOwner: TComponent); Override;
    Destructor Destroy; Override;
    Procedure MyGetNodeText(aSender: TObject; aNode: TAdvTreeViewVirtualNode; aColumn: Integer; aMode: TAdvTreeViewNodeTextMode; Var aText: String);
    Procedure LoadData;
  End;

Implementation

Uses
  SysUtils;

{ TBrowser }

constructor TBrowser.Create(aOwner: TComponent);
begin
  inherited;
  FStrings := TList<String>.Create;
  LoadData;
  BeginUpdate;
  ColumnsAppearance.Stretch := False;
  Interaction.ColumnSizing := True;
//  NodesAppearance.ShowLines := False;
  Columns.Add.Text := 'Col 1';
  Columns.Add.Text := 'Col 2';
  Columns[0].Sorting := tcsRecursive;

  OnGetNumberOfNodes := GetNumberOfNodes;
  OnGetNodeText := MyGetNodeText;

  EndUpdate;

end;

procedure TBrowser.LoadData;
Var
  i: Integer;
begin
  for i:=1 To 100 Do
  Begin
    FStrings.Add('xxx ' + IntToStr(random(1000)));
  End;
end;

//function TBrowser.CreateNodes: TAdvTreeViewNodes;
//begin
//  Result := TMyNodes.Create(Self,nil);
//end;

destructor TBrowser.Destroy;
begin
  inherited;
end;

procedure TBrowser.GetNumberOfNodes(aSender: TObject; aNode: TAdvTreeViewVirtualNode; var aNumberOfNodes: Integer);
begin
  if aNode.Level = -1 then
  Begin
    aNumberOfNodes := FStrings.Count;//Nodes.Count;
  End
end;

procedure TBrowser.MyGetNodeText(aSender: TObject; aNode: TAdvTreeViewVirtualNode; aColumn: Integer; aMode: TAdvTreeViewNodeTextMode; var aText: String);
begin
  aText := FStrings[aNode.Row];
end;

{ TMyNodes }

function TMyNodes.GetItemClass: TCollectionItemClass;
begin
  Result := TMyNode;
end;

{ TMyNode }

constructor TMyNode.Create(Collection: TCollection);
begin
  inherited;
  FMyText := Format('%4.4d',[random(1000)]);
end;

function TMyNode.CreateNodes: TAdvTreeViewNodes;
begin
  Result := TMyNodes.Create(TreeView, Self);
end;

End.
3

Hi, 


When sorting, the OnGetNodeCompare is being called, which need to be implemented and used to sort your TStringList. Currently you are mixing collection and virtual based modes. Please either use one of the 2. There is no need to override the default nodes collection if you plan on using the OnGetNumberOfNodes.
4

Hi Pieter,


I couldnt find an OnGetNodeCompare I ran grep through the source and nothing found. I assume you meant OnNodeCompare. I removed the CreateNodes. 

Clicking on the column title to get the sort arrows to show in the column titles does not call the OnNodeCompare method. The only place I found the compare could get called if I found it correctly is in TAdvTreeViewNodes.Compare. Putting a breakpoint at the beginning of that method showed it's not getting called. Below is the code I was testing it with.

Unit Browser;

Interface

Uses
  AdvTreeView,
  AdvTreeViewData,
  Generics.Collections,
  Classes;

Type
  TMyNodes = Class(TList<TStringList>)
  End;

  TBrowser = Class(TAdvTreeView)
  Private
  Protected
    Procedure GetNumberOfNodes(aSender: TObject; aNode: TAdvTreeViewVirtualNode; Var aNumberOfNodes: Integer);
    procedure MyNodeCompare(Sender: TObject; Node1, Node2: TAdvTreeViewNode; AColumn: Integer; var ACompareResult: Integer);
  Public
    FStrings: TMyNodes;
    Constructor Create(aOwner: TComponent); Override;
    Destructor Destroy; Override;
    Procedure MyGetNodeText(aSender: TObject; aNode: TAdvTreeViewVirtualNode; aColumn: Integer; aMode: TAdvTreeViewNodeTextMode; Var aText: String);
    Procedure LoadData;
  End;

Implementation

Uses
Unit3,
  SysUtils;

Var
  GCount: Integer = 0;

{ TBrowser }

constructor TBrowser.Create(aOwner: TComponent);
begin
  inherited;
  FStrings := TMyNodes.Create;
  LoadData;
  BeginUpdate;
  ColumnsAppearance.Stretch := False;
  Interaction.ColumnSizing := True;
//  NodesAppearance.ShowLines := False;
  Columns.Add.Text := 'Col 1';
  Columns.Add.Text := 'Col 2';
  Columns[0].Sorting := tcsNormal;
  Columns[1].Sorting := tcsNormal;
//  Columns[0].Filtering.Enabled := True;
//  Columns[1].Filtering.Enabled := True;

  OnGetNumberOfNodes := GetNumberOfNodes;
  OnGetNodeText := MyGetNodeText;
  OnNodeCompare := MyNodeCompare;

//  sort(0,true,false,nsmdescending);

  EndUpdate;

end;

procedure TBrowser.LoadData;
Var
  i: Integer;
  n: TStringList;
begin
  for i:=1 To 100 Do
  Begin
    n := TStringList.Create;
    n.Add('xxx ' + IntToStr(Random(100)));
    n.Add('yyy ' + IntToStr(Random(100)));
    FStrings.Add(n);
  End;
end;

procedure TBrowser.MyGetNodeText(aSender: TObject; aNode: TAdvTreeViewVirtualNode; aColumn: Integer; aMode: TAdvTreeViewNodeTextMode; var aText: String);
Var
  n: TStringList;
begin
  aText := FStrings[aNode.Row][aColumn];
end;

procedure TBrowser.MyNodeCompare(Sender: TObject; Node1, Node2: TAdvTreeViewNode; AColumn: Integer; var ACompareResult: Integer);
begin
  if aColumn = 0 then
  Begin
    aCompareResult := 0;
  End;
end;

destructor TBrowser.Destroy;
begin
  inherited;
end;

procedure TBrowser.GetNumberOfNodes(aSender: TObject; aNode: TAdvTreeViewVirtualNode; var aNumberOfNodes: Integer);
begin
  if aNode.Level = -1 then
  Begin
    aNumberOfNodes := FStrings.Count;//Nodes.Count;
  End
end;


End.
5

I found the soring reaches TAdvTreeViewNodes.Sort but the TAdvTreeViewNodes count is 0 and hence it doesnt call the quicksort method. I suspect I may still have a virtual vs non-virtual clash but I cant see where.

6

Sorting applies to collection-based. Sorting is not supported in virtual mode.If you want to support this, you'll need to override the InitializeColumnSorting method which is called when sorting is applied at column level. The sort indicator should change, but the data itself needs to be sorted inside this method, using a BeginUpdate/EndUpdate




procedure TBrowser.InitializeColumnSorting(AColumn: Integer; ASortMode: TAdvTreeViewNodesSortMode); 

begin
  inherited;
  BeginUpdate;
  case ASortMode of
    nsmAscending: //Sort data ascended;
    nsmDescending: //Sort data descended;
  end;
  EndUpdate;
end;
7

Thanks for that solution Pieter, it worked perfectly.


For anyone after the final code as an example its listed below.

Unit Browser;

Interface

Uses
  AdvTreeView,
  AdvTreeViewData,
  Generics.Collections,
  Generics.Defaults,
  Classes;

Type
  TMyNodes = Class(TList<TStringList>)
  End;

  TBrowser = Class(TAdvTreeView)
  Private
    FStrings: TMyNodes;
    Procedure GetNumberOfNodes(aSender: TObject; aNode: TAdvTreeViewVirtualNode; Var aNumberOfNodes: Integer);
    Procedure MyNodeCompare(Sender: TObject; Node1, Node2: TAdvTreeViewNode; AColumn: Integer; var ACompareResult: Integer);
    Procedure MyGetNodeText(aSender: TObject; aNode: TAdvTreeViewVirtualNode; aColumn: Integer; aMode: TAdvTreeViewNodeTextMode; Var aText: String);
    Procedure LoadData;
  Protected
    Procedure InitializeColumnSorting(AColumn: Integer; ASortMode: TAdvTreeViewNodesSortMode); Override;
  Public
    Constructor Create(aOwner: TComponent); Override;
    Destructor Destroy; Override;
  End;

Implementation

Uses
  SysUtils;

{ TBrowser }

Constructor TBrowser.Create(aOwner: TComponent);
Begin
  Inherited;
  FStrings := TMyNodes.Create;
  LoadData;

  OnGetNumberOfNodes := GetNumberOfNodes;
  OnGetNodeText := MyGetNodeText;
  OnNodeCompare := MyNodeCompare;

  BeginUpdate;
  Columns.Clear;
  Columns.Add.Text := 'Col 1';
  Columns.Add.Text := 'Col 2';
  Columns[0].Sorting := tcsNormal;
  Columns[1].Sorting := tcsNormal;
  EndUpdate;
End;

Procedure TBrowser.LoadData;
Var
  i: Integer;
  n: TStringList;
Begin
  for i:=1 To 100 Do
  Begin
    n := TStringList.Create;
    n.Add('xxx ' + IntToStr(Random(100)));
    n.Add('yyy ' + IntToStr(Random(100)));
    FStrings.Add(n);
  End;
End;

Procedure TBrowser.GetNumberOfNodes(aSender: TObject; aNode: TAdvTreeViewVirtualNode; var aNumberOfNodes: Integer);
Begin
  if aNode.Level = -1 then
    aNumberOfNodes := FStrings.Count;
End;

Procedure TBrowser.InitializeColumnSorting(AColumn: Integer; ASortMode: TAdvTreeViewNodesSortMode);
Var
  Comp: TComparison<TStringList>;
Begin
  Inherited;
  BeginUpdate;
  case aSortMode Of
    nsmAscending:
      Begin
        comp := function(const left,right: TStringList): Integer
        Begin
          if left[aColumn] < right[aColumn] then
            result := -1
          else if left[aColumn] > right[aColumn] then
            result := 1
          else
            Result := 0;
        End;
        FStrings.Sort(TComparer<TStringList>.Construct(Comp));
      End;
    nsmDescending:
      Begin
        comp := function(const left,right: TStringList): Integer
        Begin
          if left[aColumn] < right[aColumn] then
            result := 1
          else if left[aColumn] > right[aColumn] then
            result := -1
          else
            Result := 0;
        End;
        FStrings.Sort(TComparer<TStringList>.Construct(Comp));
      End;
  end;
  EndUpdate;
End;

Procedure TBrowser.MyGetNodeText(aSender: TObject; aNode: TAdvTreeViewVirtualNode; aColumn: Integer; aMode: TAdvTreeViewNodeTextMode; var aText: String);
Begin
  aText := FStrings[aNode.Row][aColumn];
End;

Procedure TBrowser.MyNodeCompare(Sender: TObject; Node1, Node2: TAdvTreeViewNode; AColumn: Integer; var ACompareResult: Integer);
Begin
  if aColumn = 0 then
    aCompareResult := 0;
End;

Destructor TBrowser.Destroy;
Begin
  Inherited;
End;

End.