unit VTSListView;

interface

// This ListView adds support for sorting arrows

// Recommended usage for the OnCompare event:
(*
procedure TForm1.ListViewCompare(Sender: TObject; Item1,
  Item2: TListItem; Data: Integer; var Compare: Integer);
var
  ListView: TVTSListView;
begin
  ListView := Sender as TVTSListView;
  if ListView.CurSortedColumn = 0 then
  begin
    Compare := CompareText(Item1.Caption, Item2.Caption);
  end
  else
  begin
    Compare := CompareText(Item1.SubItems[ListView.CurSortedColumn-1],
                           Item2.SubItems[ListView.CurSortedColumn-1]);
  end;
  if ListView.CurSortedDesc then Compare := -Compare;
end;
*)

uses
  Windows, Messages, SysUtils, Classes, Controls, ComCtrls, CommCtrl;

type
  TVTSListView = class(TListView)
  private
    FDescending: Boolean;
    FSortedColumn: Integer;
    procedure WMNotifyMessage(var msg: TWMNotify); message WM_NOTIFY;
  protected
    procedure ShowArrowOfListViewColumn;
    procedure ColClick(Column: TListColumn); override;
  public
    constructor Create(AOwner: TComponent); override;
  published
    property CurSortedColumn: integer read FSortedColumn;
    property CurSortedDesc: boolean read FDescending;
  end;

procedure Register;

implementation

// The arrows require a XP Manifest

{$IF not Declared(HDF_SORTUP)}
const
  { For Windows >= XP }
  {$EXTERNALSYM HDF_SORTUP}
  HDF_SORTUP              = $0400;
  {$EXTERNALSYM HDF_SORTDOWN}
  HDF_SORTDOWN            = $0200;
{$IFEND}

{ TVTSListView }

constructor TVTSListView.Create(AOwner: TComponent);
begin
  inherited;
  FSortedColumn := -1;
end;

procedure TVTSListView.ShowArrowOfListViewColumn;
var
  Header: HWND;
  Item: THDItem;
  i: integer;
begin
  Header := ListView_GetHeader(Handle);
  ZeroMemory(@Item, SizeOf(Item));
  Item.Mask := HDI_FORMAT;

  // Remove arrows
  for i := 0 to Columns.Count-1 do
  begin
    Header_GetItem(Header, i, Item);
    Item.fmt := Item.fmt and not (HDF_SORTUP or HDF_SORTDOWN);
    Header_SetItem(Header, i, Item);
  end;

  // Add arrow
  Header_GetItem(Header, FSortedColumn, Item);
  if FDescending then
    Item.fmt := Item.fmt or HDF_SORTDOWN
  else
    Item.fmt := Item.fmt or HDF_SORTUP;
  Header_SetItem(Header, FSortedColumn, Item);
end;

procedure TVTSListView.WMNotifyMessage(var msg: TWMNotify);
begin
  inherited;
  if (Msg.NMHdr^.code = HDN_ENDTRACK) and (FSortedColumn > -1) then
  begin
    ShowArrowOfListViewColumn;
  end;
end;

procedure TVTSListView.ColClick(Column: TListColumn);
begin
  if not Assigned(OnCompare) then Exit;
  SortType := stNone;
  if Column.Index <> FSortedColumn then
  begin
    FSortedColumn := Column.Index;
    FDescending := False;
  end
  else
  begin
    FDescending := not FDescending;
  end;
  ShowArrowOfListViewColumn;
  SortType := stText;
  inherited;
end;

procedure Register;
begin
  RegisterComponents('ViaThinkSoft', [TVTSListView]);
end;

end.