Delphi VirtualTreeView Sort Multiple Columns?

Question

I have heard a lot of praise about the VirtualTreeView component and looked at using it in a rewrite we are doing. Currently we use a StringGrid.

I can't find a way to sort multiple columns, though single column sorting works great. Is there any way to do something similar to click column 1>sort, Ctrl+click column 2>sort column 2 after column 1, etc?

Specifically, I want to sort at least three columns: PO Number, Line Item, Release.

Thanks in advance for your help!

Here is the code (slightly simplified) I am testing the theory with (not from the same project referenced above):

Note: After your update I edited my code, also, to show what it currently is. Below I posted the results of the sort:

type
  PBatchDetails = ^TBatchDetails;
  TBatchDetails = record
    TheBatchKey
    OperationKey,
    PO,
    Line,
    Release,
    Temp,
    Notes : String;
    TransDate : TDateTime;
end;

....
Sorting_Columns: array of TColumnIndex;
....
procedure TForm1.TreeHeaderClick(Sender: TVTHeader; HitInfo: TVTHeaderHitInfo);
var
  I: Integer;
begin
  if not CtrlDown then //function I have to test Ctrl state.
  begin
    setlength(Sorting_Columns,0);
  end;
  SetLength(Sorting_Columns,length(Sorting_Columns)+1);
  Sorting_Columns[Length(Sorting_Columns)-1] := HitInfo.Column;
  tree.SortTree(HitInfo.Column,Sender.SortDirection,True);
  if Sender.SortDirection=sdAscending then
    Sender.SortDirection:=sdDescending
  else
    Sender.SortDirection:=sdAscending
end;


procedure TForm1.TreeCompareNodes(Sender: TBaseVirtualTree; Node1,
  Node2: PVirtualNode; Column: TColumnIndex; var Result: Integer);
var
  BatchRec1 : PBatchDetails;
  BatchRec2: PBatchDetails;
  I: Integer;
begin
  if length(Sorting_Columns) > 0 then
  begin
    BatchRec1 := Tree.GetNodeData(Node1);
    BatchRec2 := Tree.GetNodeData(Node2);
    if (not Assigned(BatchRec1)) or (not Assigned(BatchRec2)) then
      Result:=0
    else
    begin
      for I := High(Sorting_Columns) downto 0 do
      begin
        case Sorting_Columns[i] of
          0,1: Result := Result + CompareDate(BatchRec1.TransDate,BatchRec2.TransDate); // col 0 is Date and col 1 is Time.
          2: Result := Result + CompareText(BatchRec1.OperationKey,BatchRec2.OperationKey);
          3: Result := Result + CompareText(BatchRec1.PO,BatchRec2.PO);
          4: Result := Result + CompareText(BatchRec1.Line,BatchRec2.Line);
          5: Result := Result + CompareText(BatchRec1.Release,BatchRec2.Release);
          6: Result := Result + CompareText(BatchRec1.Temp, BatchRec2.Temp);
          7: Result := Result + CompareText(BatchRec1.Notes,BatchRec2.Notes);
        end; //end case;
        if Result <> 0 then
          Break;
      end;
    end;
  end;
end;

This produced the following results (I am only showing the three columns I am trying to sort here):

When originally loaded:
PO Line Release
153 7 2
153 7 1
153 1 1
153 1 2
153 4 1
153 6 2
153 6 1
120 3 2
120 3 1
153 2 1
153 4 2
120 2 1
153 4 1
120 1 1
153 3 1
153 2 1
111 2 1
111 1 5
111 1 1
111 4 2
111 3 1
111 4 1
111 1 3
111 1 2
111 1 4

After first click
PO Line Release
111 2 1
111 1 5
111 1 1
111 4 2
111 3 1
111 4 1
111 1 3
111 1 2
111 1 4
120 3 2
120 3 1
120 2 1
120 1 1
153 7 2
153 7 1
153 1 1
153 1 2
153 4 1
153 6 2
153 6 1
153 2 1
153 4 2
153 4 1
153 3 1
153 2 1

After second click
PO Line Release
153 7 2
153 7 1
153 6 2
153 6 1
153 4 1
153 4 2
153 4 1
111 4 2
111 4 1
153 3 1
120 3 2
120 3 1
111 3 1
153 2 1
153 2 1
120 2 1
111 2 1
153 1 1
153 1 2
120 1 1
111 1 5
111 1 1
111 1 3
111 1 2
111 1 4

After Third Click
PO Line Release
111 1 1
120 1 1
153 1 1
111 2 1
120 2 1
153 2 1
153 2 1
111 3 1
120 3 1
153 3 1
111 4 1
153 4 1
153 4 1
153 6 1
153 7 1
111 1 2
153 1 2
120 3 2
111 4 2
153 4 2
153 6 2
153 7 2
111 1 3
111 1 4
111 1 5

Thanks for your time!

Answer 1

Disable every auto sorting options in general. Then you need to implement OnCompareNodes along with OnHeaderClick events.

Here is I hope working code (I've made just quick test :)

The aim is to store sorting columns in some variable (Sorting_Columns). This variable you can feed in OnHeaderClick event.
In the OnCompareNodes event, which will be triggered after SortTree function call, iterate through the variable from the last added column to the first added one and to the Result parameter pass the first nonzero comparision result. Now humanly - you should go through the columns backwards as they were "selected" and check if they are same, if yes go to the previously selected, if not break the loop and pass the result. Note that you are comparing two nodes (rows) in one event hit, what's the reason for the iteration and subsequent comparision of sorting columns.

type
  PRecord = ^TRecord;
  TRecord = record
    ID: integer;
    Text_1: string;
    Text_2: string;
    Text_3: string;
    Date: TDateTime;
  end;

...

var Sorting_Columns: array of TColumnIndex;

...

procedure TForm1.VirtualStringTree1CompareNodes(Sender: TBaseVirtualTree;
  Node1, Node2: PVirtualNode; Column: TColumnIndex; var Result: Integer);
var Actual_Index: integer;
    Data_1: PRecord;
    Data_2: PRecord;

begin
  if Length(Sorting_Columns) > 0 then
    begin
      Data_1 := VirtualStringTree1.GetNodeData(Node1);
      Data_2 := VirtualStringTree1.GetNodeData(Node2);

      if Assigned(Data_1) and Assigned(Data_2) then
        for Actual_Index := High(Sorting_Columns) downto 0 do
          case Sorting_Columns[Actual_Index] of
            0: Result := Result + Data_1^.ID - Data_2^.ID;
            1: Result := Result + CompareStr(Data_1^.Text_1, Data_2^.Text_1);
            2: Result := Result + CompareStr(Data_1^.Text_2, Data_2^.Text_2);
            3: Result := Result + CompareStr(Data_1^.Text_3, Data_2^.Text_3);
            4: Result := Result + CompareDateTime(Data_1^.Date, Data_2^.Date);
          end;

      if Result <> 0 then
        Break;
    end;
end;

Answer 2

Slightly modified code from @user532231 to get a working solution

type
  PRecord = ^TRecord;
  TRecord = record
    ID: integer;
    Text_1: string;
    Text_2: string;
    Text_3: string;
    Date: TDateTime;
  end;

...

var Sorting_Columns: array of TColumnIndex;

...

procedure TForm1.VirtualStringTree1CompareNodes(Sender: TBaseVirtualTree;
  Node1, Node2: PVirtualNode; Column: TColumnIndex; var Result: Integer);
var Actual_Index: integer;
    Data_1: PRecord;
    Data_2: PRecord;
    Matrix : array of integer;
    I: Integer;
begin
  if Length(Sorting_Columns) > 0 then
    begin
      Data_1 := VirtualStringTree1.GetNodeData(Node1);
      Data_2 := VirtualStringTree1.GetNodeData(Node2);

      if Assigned(Data_1) and Assigned(Data_2) then
        begin
          SetLength(Matrix,Length(Sorting_Columns));
          for Actual_Index := 0 to High(Sorting_Columns) do
            begin
              case Sorting_Columns[Actual_Index] of
                0: Matrix[Actual_Index] := Data_1^.ID - Data_2^.ID;
                1: Matrix[Actual_Index] := CompareStr(Data_1^.Text_1, Data_2^.Text_1);
                2: Matrix[Actual_Index] := CompareStr(Data_1^.Text_2, Data_2^.Text_2);
                3: Matrix[Actual_Index] := CompareStr(Data_1^.Text_3, Data_2^.Text_3);
                4: Matrix[Actual_Index] := CompareDateTime(Data_1^.Date, Data_2^.Date);
              end;
            end;
          for I := 0 to Length(Matrix) - 1 do
            if (Matrix[i] <> 0) then
              begin
                Result:=Matrix[i];
                break;
              end;
          SetLength(Matrix,0);
        end;      
    end;
end;

The difference is, you need to remember the result of each column comparison and then return the first most significant non-zero value (most significant being the column that was added to sorting first). You don't need to loop from highest to lowest column. This code needs the OP's TreeHeaderClick procedure to add/remove columns to Sorting_Columns.

Here, the sort direction is always the same for all columns. It should be fairly easy to implement sorting direction, by reversing the comparison result of each column according to its sort direction, ascending or descending. I didn't try this.