Solved

Tviruailstringtree sort multi columns on header click

Posted on 2016-11-08
1
85 Views
Last Modified: 2016-11-09
i am trying to sort each columns on Virtuailstringtree like this

var
Data1,Data2: PLUSTPAPULAE;
begin
Data1 := LISTSHOW.GetNodeData(Node1);
Data2 := LISTSHOW.GetNodeData(Node2);
if (Assigned(Data1)) And (Assigned(Data2)) then
begin

case Column of
0: Result := Result + CompareText(Data1.name, Data2.name);
1: Result := Result + CompareText(Data1.lvl, Data2.lvl);
end;

end;
end;

Open in new window




i have issue on header click it does not compare if i click on the second column . its only sort when i click on the first column i want to sort each column when i click on the column name

as example on click on column 0 sort column 0,, on click on column 1 sort column 1 and so on...

here is my header click code

procedure Tform1.LISTSHOWHeaderClick(Sender: TVTHeader;
  HitInfo: TVTHeaderHitInfo);
begin



    if HitInfo.Button = mbLeft then
  begin

    with Sender do
    begin
      if HitInfo.Column <> MainColumn then
        SortColumn := NoColumn
      else
      begin
        if SortColumn = NoColumn then
        begin

          SortColumn := HitInfo.Column;
          SortDirection := sdAscending;
        end
        else
          if SortDirection = sdAscending then
            SortDirection := sdDescending
          else
            SortDirection := sdAscending;
        Treeview.SortTree(SortColumn, SortDirection, False);
      end;
    end;
  end;

end;

Open in new window

0
Comment
Question by:dolphin King
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
1 Comment
 
LVL 14

Accepted Solution

by:
Pierre Cornelius earned 500 total points
ID: 41880345
I have put together a working example for you:

Here is the source:
unit VTS_Main;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, VirtualTrees;

type
  PSampleData = ^TSampleData;
  TSampleData  = record
    Col1: string;
    Level: integer;
  end;
  TSampleDataArray = array of TSampleData;

  TForm1 = class(TForm)
    VirtualStringTree1: TVirtualStringTree;
    procedure FormCreate(Sender: TObject);
    procedure VirtualStringTree1GetText(Sender: TBaseVirtualTree;
      Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
      var CellText: string);
    procedure VirtualStringTree1FreeNode(Sender: TBaseVirtualTree;
      Node: PVirtualNode);
    procedure VirtualStringTree1InitNode(Sender: TBaseVirtualTree; ParentNode,
      Node: PVirtualNode; var InitialStates: TVirtualNodeInitStates);
    procedure VirtualStringTree1HeaderClick(Sender: TVTHeader;
      HitInfo: TVTHeaderHitInfo);
    procedure VirtualStringTree1CompareNodes(Sender: TBaseVirtualTree; Node1,
      Node2: PVirtualNode; Column: TColumnIndex; var Result: Integer);
  end;



var
  Form1: TForm1;

implementation

{$R *.dfm}

{ TForm1 }

procedure TForm1.FormCreate(Sender: TObject);
begin
  VirtualStringTree1.NodeDataSize:= SizeOf(TSampleData);
  VirtualStringTree1.RootNodeCount:= 20;
end;

procedure TForm1.VirtualStringTree1CompareNodes(Sender: TBaseVirtualTree; Node1,
  Node2: PVirtualNode; Column: TColumnIndex; var Result: Integer);
var d1, d2: PSampleData;
begin
  d1:= Node1.GetData;
  d2:= Node2.GetData;
  case Column of
    0: Result:= CompareText(d1.Col1, d2.Col1);
    1: Result:= d1.Level - d2.Level;
  end;
end;

procedure TForm1.VirtualStringTree1FreeNode(Sender: TBaseVirtualTree;
  Node: PVirtualNode);
var Data: PSampleData;
begin
  Data := Sender.GetNodeData(Node);
  // Explicitely free the string, the VCL cannot know that there is one but needs to free
  // it nonetheless. For more fields in such a record which must be freed use Finalize(Data^) instead touching
  // every member individually.
  Finalize(Data^);
end;

procedure TForm1.VirtualStringTree1GetText(Sender: TBaseVirtualTree;
  Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
  var CellText: string);
var Data: PSampleData;
begin
  Data := Sender.GetNodeData(Node);
  if Assigned(Data) then
    case Column of
      0: CellText := Data.Col1;
      1: CellText := IntToStr(Data.Level);
    end;
end;

procedure TForm1.VirtualStringTree1HeaderClick(Sender: TVTHeader;
  HitInfo: TVTHeaderHitInfo);
begin
  if HitInfo.Button = mbLeft then
  begin
    with Sender do
    begin
      //toggle direction if same column clicked
      if SortColumn = HitInfo.Column then
      begin
        if SortDirection = sdAscending
          then SortDirection:= sdDescending
          else  SortDirection:= sdAscending;
      end
      else begin
        SortColumn:= HitInfo.Column;
        SortDirection:= sdAscending; //sort ascending by default;
      end;
      Treeview.SortTree(SortColumn, SortDirection, False);
    end;
  end;
end;

procedure TForm1.VirtualStringTree1InitNode(Sender: TBaseVirtualTree;
  ParentNode, Node: PVirtualNode; var InitialStates: TVirtualNodeInitStates);
var Data: PSampleData;
begin
  with Sender do
  begin
    Data := GetNodeData(Node);
    // Construct a node caption. This event is triggered once for each node but
    // appears asynchronously, which means when the node is displayed not when it is added.
    Data.Col1 := Format('Level %d, Index %d', [GetNodeLevel(Node), Node.Index]);
    Data.Level:= Random(40);
  end;
end;

end.

Open in new window


Here is the form:
object Form1: TForm1
  Left = 0
  Top = 0
  Caption = 'Form1'
  ClientHeight = 290
  ClientWidth = 554
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  OnCreate = FormCreate
  PixelsPerInch = 96
  TextHeight = 13
  object VirtualStringTree1: TVirtualStringTree
    Left = 0
    Top = 0
    Width = 554
    Height = 290
    Align = alClient
    Header.AutoSizeIndex = 0
    Header.Font.Charset = DEFAULT_CHARSET
    Header.Font.Color = clWindowText
    Header.Font.Height = -11
    Header.Font.Name = 'Tahoma'
    Header.Font.Style = []
    Header.Options = [hoColumnResize, hoDrag, hoShowSortGlyphs, hoVisible]
    TabOrder = 0
    OnCompareNodes = VirtualStringTree1CompareNodes
    OnFreeNode = VirtualStringTree1FreeNode
    OnGetText = VirtualStringTree1GetText
    OnHeaderClick = VirtualStringTree1HeaderClick
    OnInitNode = VirtualStringTree1InitNode
    Columns = <
      item
        Position = 0
        Width = 200
        WideText = 'Col1'
      end
      item
        Position = 1
        Width = 200
        WideText = 'Col2'
      end>
  end
end

Open in new window

0

Featured Post

Free Tool: Postgres Monitoring System

A PHP and Perl based system to collect and display usage statistics from PostgreSQL databases.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

Title # Comments Views Activity
MS Access from Delphi 31 81
Output in PHP throwing alignment of data off issue 12 57
storing csv file in table variable in Python 2 64
IDE for Python 5 71
This is an explanation of a simple data model to help parse a JSON feed
If you’re thinking to yourself “That description sounds a lot like two people doing the work that one could accomplish,” you’re not alone.
In this fourth video of the Xpdf series, we discuss and demonstrate the PDFinfo utility, which retrieves the contents of a PDF's Info Dictionary, as well as some other information, including the page count. We show how to isolate the page count in a…
In this fifth video of the Xpdf series, we discuss and demonstrate the PDFdetach utility, which is able to list and, more importantly, extract attachments that are embedded in PDF files. It does this via a command line interface, making it suitable …

733 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question