What you are attempting to do is now rather complex. To be able to keep on top of this I would recommend that you build a well-factored set of low-level helper routines. Then you can compose the high-level UI code in short, clear methods.
To start with, lets have some routines that get and set list header sort state. That's the up/down sort icon in the list view's header control.
function ListViewFromColumn(Column: TListColumn): TListView;
begin
Result := (Column.Collection as TListColumns).Owner as TListView;
end;
type
THeaderSortState = (hssNone, hssAscending, hssDescending);
function GetListHeaderSortState(Column: TListColumn): THeaderSortState;
var
Header: HWND;
Item: THDItem;
begin
Header := ListView_GetHeader(ListViewFromColumn(Column).Handle);
ZeroMemory(@Item, SizeOf(Item));
Item.Mask := HDI_FORMAT;
Header_GetItem(Header, Column.Index, Item);
if Item.fmt and HDF_SORTUP<>0 then
Result := hssAscending
else if Item.fmt and HDF_SORTDOWN<>0 then
Result := hssDescending
else
Result := hssNone;
end;
procedure SetListHeaderSortState(Column: TListColumn; Value: THeaderSortState);
var
Header: HWND;
Item: THDItem;
begin
Header := ListView_GetHeader(ListViewFromColumn(Column).Handle);
ZeroMemory(@Item, SizeOf(Item));
Item.Mask := HDI_FORMAT;
Header_GetItem(Header, Column.Index, Item);
Item.fmt := Item.fmt and not (HDF_SORTUP or HDF_SORTDOWN);//remove both flags
case Value of
hssAscending:
Item.fmt := Item.fmt or HDF_SORTUP;
hssDescending:
Item.fmt := Item.fmt or HDF_SORTDOWN;
end;
Header_SetItem(Header, Column.Index, Item);
end;
I took this code from this answer: How to show the sort arrow on a TListView column?
Next up I would make a record to hold the sort specification. Ideally this would arrive at the sort compare function in its Data parameter. But sadly the VCL framework missed the opportunity to use that parameter for its intended purpose. So instead we will need to store the specification for the active sort in the form that owns the list view.
type
TSortSpecification = record
Column: TListColumn;
Ascending: Boolean;
CompareItems: function(const s1, s2: string): Integer;
end;
And then in the form itself you'll declare a field to hold one of these:
type
TfrmFind = class(...)
private
....
FSortSpecification: TSortSpecification;
....
end;
The compare function uses the specification. It's very simple:
procedure TfrmFind.ListViewCompare(Sender: TObject; Item1, Item2: TListItem;
Data: Integer; var Compare: Integer);
var
Index: Integer;
s1, s2: string;
begin
Index := FSortSpecification.Column.Index;
if Index=0 then
begin
s1 := Item1.Caption;
s2 := Item2.Caption;
end else
begin
s1 := Item1.SubItems[Index-1];
s2 := Item2.SubItems[Index-1];
end;
Compare := FSortSpecification.CompareItems(s1, s2);
if not FSortSpecification.Ascending then
Compare := -Compare;
end;
Next up we'll implement a sort function.
procedure TfrmFind.Sort(Column: TListColumn; Ascending: Boolean);
var
ListView: TListView;
begin
FSortSpecification.Column := Column;
FSortSpecification.Ascending := Ascending;
case Column.Index of
1:
FSortSpecification.CompareItems := CompareTextAsInteger;
2:
FSortSpecification.CompareItems := CompareTextAsDateTime;
else
FSortSpecification.CompareItems := CompareText;
end;
ListView := ListViewFromColumn(Column);
ListView.OnCompare := ListViewCompare;
ListView.AlphaSort;
end;
This Sort function is decoupled from the OnClick handler. That will allow you to sort columns independently from the user's UI actions. For example, perhaps you want to sort the control on a particular column when you first show the form.
Finally, the OnClick handler can then call the sort function:
procedure TfrmFind.lvwTagsColumnClick(Sender: TObject; Column: TListColumn);
var
i: Integer;
Ascending: Boolean;
State: THeaderSortState;
begin
Ascending := GetListHeaderSortState(Column)<>hssAscending;
Sort(Column, Ascending);
for i := 0 to ListView.Columns.Count-1 do
begin
if ListView.Column[i]=Column then
if Ascending then
State := hssAscending
else
State := hssDescending
else
State := hssNone;
SetListHeaderSortState(ListView.Column[i], State);
end;
end;
For the sake of completeness, here is a complete unit that implements these ideas:
unit uFind;
interface
uses
Windows, Messages, SysUtils, Classes, Math, DateUtils, Controls, Forms, Dialogs, ComCtrls, CommCtrl;
type
TSortSpecification = record
Column: TListColumn;
Ascending: Boolean;
CompareItems: function(const s1, s2: string): Integer;
end;
TfrmFind = class(TForm)
ListView: TListView;
procedure lvwTagsColumnClick(Sender: TObject; Column: TListColumn);
private
FSortSpecification: TSortSpecification;
procedure ListViewCompare(Sender: TObject; Item1, Item2: TListItem;
Data: Integer; var Compare: Integer);
procedure Sort(Column: TListColumn; Ascending: Boolean);
end;
var
frmFind: TfrmFind;
implementation
{$R *.dfm}
function CompareTextAsInteger(const s1, s2: string): Integer;
begin
Result := CompareValue(StrToInt(s1), StrToInt(s2));
end;
function CompareTextAsDateTime(const s1, s2: string): Integer;
begin
Result := CompareDateTime(StrToDateTime(s1), StrToDateTime(s2));
end;
function ListViewFromColumn(Column: TListColumn): TListView;
begin
Result := (Column.Collection as TListColumns).Owner as TListView;
end;
type
THeaderSortState = (hssNone, hssAscending, hssDescending);
function GetListHeaderSortState(Column: TListColumn): THeaderSortState;
var
Header: HWND;
Item: THDItem;
begin
Header := ListView_GetHeader(ListViewFromColumn(Column).Handle);
ZeroMemory(@Item, SizeOf(Item));
Item.Mask := HDI_FORMAT;
Header_GetItem(Header, Column.Index, Item);
if Item.fmt and HDF_SORTUP<>0 then
Result := hssAscending
else if Item.fmt and HDF_SORTDOWN<>0 then
Result := hssDescending
else
Result := hssNone;
end;
procedure SetListHeaderSortState(Column: TListColumn; Value: THeaderSortState);
var
Header: HWND;
Item: THDItem;
begin
Header := ListView_GetHeader(ListViewFromColumn(Column).Handle);
ZeroMemory(@Item, SizeOf(Item));
Item.Mask := HDI_FORMAT;
Header_GetItem(Header, Column.Index, Item);
Item.fmt := Item.fmt and not (HDF_SORTUP or HDF_SORTDOWN);//remove both flags
case Value of
hssAscending:
Item.fmt := Item.fmt or HDF_SORTUP;
hssDescending:
Item.fmt := Item.fmt or HDF_SORTDOWN;
end;
Header_SetItem(Header, Column.Index, Item);
end;
procedure TfrmFind.ListViewCompare(Sender: TObject; Item1, Item2: TListItem;
Data: Integer; var Compare: Integer);
var
Index: Integer;
s1, s2: string;
begin
Index := FSortSpecification.Column.Index;
if Index=0 then
begin
s1 := Item1.Caption;
s2 := Item2.Caption;
end else
begin
s1 := Item1.SubItems[Index-1];
s2 := Item2.SubItems[Index-1];
end;
Compare := FSortSpecification.CompareItems(s1, s2);
if not FSortSpecification.Ascending then
Compare := -Compare;
end;
procedure TfrmFind.Sort(Column: TListColumn; Ascending: Boolean);
var
ListView: TListView;
begin
FSortSpecification.Column := Column;
FSortSpecification.Ascending := Ascending;
case Column.Index of
1:
FSortSpecification.CompareItems := CompareTextAsInteger;
2:
FSortSpecification.CompareItems := CompareTextAsDateTime;
else
FSortSpecification.CompareItems := CompareText;
end;
ListView := ListViewFromColumn(Column);
ListView.OnCompare := ListViewCompare;
ListView.AlphaSort;
end;
procedure TfrmFind.lvwTagsColumnClick(Sender: TObject; Column: TListColumn);
var
i: Integer;
Ascending: Boolean;
State: THeaderSortState;
begin
Ascending := GetListHeaderSortState(Column)<>hssAscending;
Sort(Column, Ascending);
for i := 0 to ListView.Columns.Count-1 do
begin
if ListView.Column[i]=Column then
if Ascending then
State := hssAscending
else
State := hssDescending
else
State := hssNone;
SetListHeaderSortState(ListView.Column[i], State);
end;
end;
end.
