3

I recently got help for sorting a TListView's columns based on columns data type.

Here is the code:

procedure TfrmFind.lvwTagsColumnClick(Sender: TObject; Column: TListColumn);
begin
 ColumnToSort := Column.Index;
 (Sender as TCustomListView).AlphaSort;
end;

procedure TfrmFind.lvwTagsCompare(Sender: TObject; Item1, Item2: TListItem;
  Data: Integer; var Compare: Integer);
var
 ix: Integer;
 begin
 if ColumnToSort = 0 then
  Compare := CompareText(Item1.Caption,Item2.Caption)
 else
 if ColumnToSort = 1 then
  Compare := CompareTextAsInteger(Item1.subitems[0],Item2.subitems[0])
 else
if ColumnToSort = 2 then
  Compare := CompareTextAsDateTime(Item1.subitems[1],Item2.subitems[1])
 else
 begin
 ix := ColumnToSort - 1;
 Compare := CompareText(Item1.SubItems[ix],Item2.SubItems[ix]);
 end;
end;

I would like to add the capability to sort ascending and descending if it is possible?

User clicks once to sort ascending, then a second time to sort descending

Can I do this from the code I currently have?

What about adding a glyph to the left column to show the type of sort (ascending vs descending)?

******************************************************************************

Modifications based on experts answers: 03/25/2013

procedure TfrmFind.lvwTagsColumnClick(Sender: TObject; Column: TListColumn);
begin
 ColumnToSort := Column.Index;
 Column.Tag:= Column.Tag * -1;
 if Column.Tag = 0 then Column.Tag:=1;
 (Sender as TCustomListView).AlphaSort;
end;

procedure TfrmFind.lvwTagsCompare(Sender: TObject; Item1, Item2: TListItem;
  Data: Integer; var Compare: Integer);
begin
Case ColumnToSort of
    0:  Compare := TRzListView(Sender).Tag * CompareText(Item1.Caption, Item2.Caption);
    1:  Compare := TRzListView(Sender).Tag * CompareTextAsInteger(Item1.subitems[0],Item2.subitems[0]);
    2:  Compare := TRzListView(Sender).Tag * CompareTextAsDateTime(Item1.subitems[1],Item2.subitems[1]);
    else
    Compare := TRzListView(Sender).Tag * CompareText(Item1.Caption, Item2.Caption);
  End;
end;
6
  • 3
    Just a hint, use case ColumnToSort of instead of that long if else statement. To your question. Have a variable storing the order which will have value either 1 or -1 and multiply the Compare value by this value.
    – TLama
    Mar 25, 2013 at 0:00
  • @David, looking at your (currently deleted) answer. The overall solution will become unreadable (not talking about the limit for only one control instance) and I would consider (to suggest) a list view descendant instead of this series of procedures.
    – TLama
    Mar 25, 2013 at 8:17
  • @TLama I don't agree. Putting the code in a derived class doesn't change the amount of code you have. I always prefer composition to inheritance where it is plausible. The helper functions stand alone and can be understood one at a time. They serve clear and simple purpose. The UI and the sorting have been decoupled. Different aspects are kept separate so future enhancements can be added with little impact on the design. Mar 25, 2013 at 9:09
  • @David, I don't like to have single purpose standalone procedures usable with the only single class. This is clearly the case, when they should become methods. But it's a matter of taste...
    – TLama
    Mar 25, 2013 at 9:18
  • @TLama They wouldn't be like that in real code. They would live in shared code for re-use. I'd implement a class helper for TListColumn and put GetListHeaderSortState, SetListHeaderSortState and ListViewFromColumn in it. Most of the other code is specific to this particular form and so belongs there. The code that isn't, I suppose is TfrmFind.Sort and TfrmFind.ListViewCompare. That could usefully live in a list view descendent. I don't want to do that with this particular answer because it makes it yet more complex and as we know from previous questions that might not help JH. Mar 25, 2013 at 9:22

3 Answers 3

8

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.
18
  • I added this. Although I got no errors, it did not sort ascending/descending....as a matter of fact, a couple columns didn't sort at all
    – JakeSays
    Mar 25, 2013 at 16:13
  • In fact the code works fine. I tested it. The tested unit is what I pasted at the end of the answer. Mar 25, 2013 at 16:16
  • Anyway, over here (stackoverflow.com/questions/15579935/…) you had a personal go at me. I think that was out of order. As I said there, I've answered loads of your questions. Can you imagine how much effort I put into the answer here? I mean, it was fun, don't get me wrong. And note that I've also debugged @bummi's answer. And shown you how to add the up/down icons on the column headers. Do you still have a problem with my answers here? Mar 25, 2013 at 16:45
  • David, I don't force you to answer my questions, and I surely don't expect you too. Please ignore my questions if you feel bad about my response to your post.
    – JakeSays
    Mar 25, 2013 at 19:55
  • I enjoy answering good questions. This was a good question. I was just upset by your posts at your last question. I consider them to be ungrateful. Mar 25, 2013 at 19:57
5

You can use your code. Just take tag to toggle sorting

procedure TfrmFind.lvwTagsColumnClick(Sender: TObject; Column: TListColumn);
begin
 ColumnToSort := Column.Index;
 if Column.Tag = 0 then Column.Tag := 1 else Column.Tag := 0; 
 (Sender as TCustomListView).AlphaSort;
end;

and in your compare

  Case ColumnToSort of
    0:begin
        if TListView(Sender).Column[ColumnToSort].Tag = 0 then
          Compare := CompareText(Item1.Caption, Item2.Caption)
        else
          Compare := CompareText(Item2.Caption, Item1.Caption);
      end;
    1:begin
      ........................
    end;
  End;

or bettes as suggested be TLama

procedure TfrmFind.lvwTagsColumnClick(Sender: TObject; Column: TListColumn);
begin
 ColumnToSort := Column.Index;
 Column.Tag := Column.Tag * -1;
 if Column.Tag = 0 then Column.Tag := 1; 
 (Sender as TCustomListView).AlphaSort;
end;

with compare

  Case ColumnToSort of
    0:  Compare := TListView(Sender).Column[ColumnToSort].Tag * CompareText(Item1.Caption, Item2.Caption);
    1: ........................

  End;
4
  • 4
    You might simply assign to your Tag variable value 1 or -1 and multiply the Compare value like Compare := Tag * CompareText(Item1.Caption, Item2.Caption). That will switch the result of the comparison.
    – TLama
    Mar 25, 2013 at 0:16
  • 1
    +1. As @TLama said, change your lvwTagsColumnClick code to: if Column.Tag = -1 then Column.Tag := 1 else Column.Tag := -1; TCustomListView(Sender).AlphaSort;. (The block for Tag toggles it properly, and the (Sender as TCustomListView) isn't needed, because the Sender of the lvwTagsColumnClick event should always be the ListView holding the column).
    – Ken White
    Mar 25, 2013 at 1:41
  • Made changes based on experts answer and it still does not work. As a matter of fact, I get no sort whatsoever now. See my edited post. - Thanks
    – JakeSays
    Mar 25, 2013 at 15:13
  • The error in this code is that it writes to Column.Tag but reads from TListView(Sender).Tag. This is one of the things that happens when you use Tag. The compiler cannot locate such silly mistakes. Mar 25, 2013 at 16:33
0

I think there is a simple way. I've tested it in C++Builder and it is working properly.

Note: initialize FColSorted = -1.

1.Create the following helper method.

void 
TFormFind::SetSortCol(int ASortCol)
{
  FColToSort = ASortCol;
  //If new column: ascending sort. Else: toggle sort order.
  FSortToggle = (FColSorted != FColToSort) ? +1 : -1*FSortToggle;
  ListView->AlphaSort();
  FColSorted = FColToSort;
}

2.Use the helper method with OnColumnClick event.

void __fastcall
TFormFind::ListViewColumnClick(TObject* Sender, TListColumn* Column)
{
  SetSortCol(Column->Index);
}

3.Use FSortToggle with your Compare logic.

void __fastcall
TFormFind::ListViewCompare(TObject* Sender, 
  TListItem* Item1, TListItem* Item2, int Data, int& Compare)
{
  //Your Compare logic here.
  //...
  Compare = FSortToggle * Compare; 
}

Best,

Marcelo.

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.