Sort TListView columns by date or time

Problem/Question/Abstract:

Is there any way to sort columns in a TListView by date or time when a user clicks on the header of the column?

Answer:

Solve 1:

LV1 is a TListView with vsReport.

function CustomDateSortProc(Item1, Item2: TListItem; ParamSort: integer): integer;
  stdcall;
begin
  result := 0;
  if StrToDateTime(item1.SubItems[0]) > StrToDateTime(item2.SubItems[0]) then
    Result := 1
  else if StrToDateTime(item1.SubItems[0]) < StrToDateTime(item2.SubItems[0]) then
    Result := -1;
end;

function CustomNameSortProc(Item1, Item2: TListItem; ParamSort: integer): integer;
  stdcall;
begin
  Result := CompareText(Item1.Caption, Item2.Caption);
end;

procedure TForm1.GetFilesClick(Sender: TObject);
var
  sr: TSearchRec;
  Item: TListItem;
begin
  if FindFirst('e:\*.*', faAnyFile, sr) = 0 then
    repeat
      if (sr.Attr and faDirectory) <> sr.Attr then
      begin
        item := LV1.items.add;
        item.Caption := sr.name;
        Item.SubItems.Add(DateTimeToStr(filedatetodatetime(sr.time)));
      end;
    until
      FindNext(sr) <> 0;
  FindClose(sr);
end;

procedure TForm1.LV1ColumnClick(Sender: TObject; Column: TListColumn);
begin
  if column = LV1.columns[0] then
    LV1.CustomSort(@CustomNameSortProc, 0)
  else
    LV1.CustomSort(@CustomDateSortProc, 0)
end;


Solve 2:

Open a new Delphi application project. Drop a listview (ListView1) onto the default form. Paste in the attached code. Hook up the FormCreate and ListView1ColumnClick event handlers.

The custom sort procedure (and the callback) save the day. There are some limits and drawbacks to this approach though. Since the listview is inherently unaware of data types, you have to bolt that onto the outside. This extra thrashing can represent a performance hit if you're doing something funky in the callback. This example uses up the TListView.Tag, TListColumn.Tag and TListItem.Data properties. This might clash with a scheme in place, or may sicken you because of its bold-faced greed. This system only allows for single-column sorts. This can easily be extended, though, by a reinterpretation of TListView.Tag into sort column_s_. No graphics in the column headers.

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ComCtrls;

type
  TForm1 = class(TForm)
    ListView1: TListView;
    procedure FormCreate(Sender: TObject);
    procedure ListView1ColumnClick(Sender: TObject; Column: TListColumn);
  private
  public
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

function UnformatText(const Text: string; const VarType: Integer): Variant;
begin
  {This is an ambitious function, in simple form. The standard text to type
        variable conversion is fairly weak, so this function is a good place to
        canonize that thinking.}
  if Length(Text) = 0 then
    Result := Null
  else
  begin
    case VarType of
      varBoolean:
        if CompareText(Text, 'True') = 0 then
          Result := True
        else if CompareText(Text, 'False') = 0 then
          Result := False
        else if CompareText(Text, 'Yes') = 0 then
          Result := True
        else if CompareText(Text, 'No') = 0 then
          Result := False
        else
        begin
          Result := Null;
        end;
    else
      {use the default handler}
      Result := VarAsType(Text, VarType);
    end;
  end;
end;

function LVItemValue(const Item: TListItem; const Col, VarType: Integer): Variant;
begin
  {get the indicated "cell's" text, return an empty string if either index is out of range}
  if Item = nil then
    Result := Null
  else if Col < 0 then
    Result := Null
  else if Col > Item.SubItems.Count then
    Result := Null
  else if Col = 0 then
    Result := UnformatText(Item.Caption, VarType)
  else
  begin
    Result := UnformatText(Item.SubItems[Col - 1], VarType);
  end;
end;

function LVSort(lParam1, lParam2: Integer; lParamSort: Integer): Integer; stdcall;
const
  NULL_COMPARE = -1; {-1 floats nulls to top, +1, to bottom}
var
  oLV: TListView;
  iSortCol: Integer;
  bSortAsc: Boolean;
  iSortVarType: Integer;
  vData1: Variant;
  vData2: Variant;
begin
  try
    {resolve the reference to the listview being sorted}
    oLV := TListView(lParamSort);
    {is "no sort" being requested?}
    if oLV.Tag = 0 then
    begin
      {not a very economic use of the data property...}
      Result := Integer(TListItem(lParam1).Data) - Integer(TListItem(lParam2).Data);
      exit;
    end;
    iSortCol := Abs(oLV.Tag) - 1;
    bSortAsc := oLV.Tag >= 0;
    {determine the data type}
    if iSortCol < 0 then
      iSortVarType := varString
    else if iSortCol >= oLV.Columns.Count then
      iSortVarType := varString
    else
    begin
      iSortVarType := oLV.Columns[iSortCol].Tag;
    end;
    {get the data of interest}
    vData1 := LVItemValue(TListItem(lParam1), iSortCol, iSortVarType);
    vData2 := LVItemValue(TListItem(lParam2), iSortCol, iSortVarType);
    {do some "null" handling that supercedes typed comparisons}
    if VarIsNull(vData1) and VarIsNull(vData2) then
      Result := 0 {they're both null}
    else if VarIsNull(vData1) then
      Result := NULL_COMPARE
    else if VarIsNull(vData2) then
      Result := -NULL_COMPARE
    else if vData1 > vData2 then
      Result := 1
    else if vData1 < vData2 then
      Result := -1
    else
    begin
      Result := 0;
    end;
    if not bSortAsc then
      Result := -Result;
  except
    Result := 0;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);

  function RandomNull(const Text: string): string;
  begin
    if Random(8) < 1 then
      Result := ''
    else
    begin
      Result := Text;
    end;
  end;

var
  oCol: TListColumn;
  oItem: TListItem;
  iItem: Integer;
begin
  Randomize;
  {set listview properties}
  with ListView1 do
  begin
    Items.Clear;
    Columns.Clear;
    Align := alClient;
    ReadOnly := True;
    SortType := stNone;
    Tag := 0;
    ViewStyle := vsReport;
  end;
  {default columns of different types}
  oCol := ListView1.Columns.Add;
  oCol.Caption := 'varDate';
  oCol.Tag := varDate;
  oCol.Width := 100;
  oCol := ListView1.Columns.Add;
  oCol.Caption := 'varBoolean';
  oCol.Tag := varBoolean;
  oCol.Width := 100;
  oCol := ListView1.Columns.Add;
  oCol.Caption := 'varInteger';
  oCol.Tag := varInteger;
  oCol.Width := 100;
  oCol := ListView1.Columns.Add;
  oCol.Caption := 'varCurrency';
  oCol.Tag := varCurrency;
  oCol.Width := 100;
  oCol := ListView1.Columns.Add;
  oCol.Caption := 'varString';
  oCol.Tag := varString;
  oCol.Width := 100;
  {add items to the listview}
  for iItem := 0 to 100 + Random(100) do
  begin
    {data property stores "original index" info}
    oItem := ListView1.Items.Add;
    oItem.Data := Pointer(iItem); {using this more like a Tag property}
    {plug in some fake data}
    oItem.Caption := RandomNull(FormatDateTime('dd-mmm-yyyy', Now() - Random(1000)));
    if Random(2) < 1 then
      oItem.SubItems.Add(RandomNull('Yes'))
    else
    begin
      oItem.SubItems.Add(RandomNull('No'));
    end;
    oItem.SubItems.Add(RandomNull(FloatToStr(0.01 * Random(100000))));
    oItem.SubItems.Add(RandomNull(IntToStr(Random(10000))));
    oItem.SubItems.Add(RandomNull(Char(65 + Random(26)) + Char(65 + Random(26)) +
      Char(65 + Random(26)) + Char(65 + Random(26)) + Char(65 + Random(26))));
  end;
end;

procedure TForm1.ListView1ColumnClick(Sender: TObject; Column: TListColumn);
begin
  {sort the sort column and order into the listview's tag}
  if ListView1.Tag = Column.Index + 1 then
    ListView1.Tag := -ListView1.Tag {desc sort}
  else if ListView1.Tag = -(Column.Index + 1) then
    ListView1.Tag := 0 {no sort}
  else
  begin
    ListView1.Tag := Column.Index + 1; {asc sort}
  end;
  {pass the listview such that it will be sent to the sort procedure}
  ListView1.CustomSort(LVSort, Integer(ListView1));
end;

end.