Sorting ListView columns with arrows

Question

I am using Delphi 6 and want to add the functionality of sorting a ListView, like it is done in Windows Explorer.

In a first test, I have (quick&dirty) copied a few source codes from a few sources, and done some small adjustments:

This is what I have so far (only quick&dirty for now):

uses
  CommCtrls;

var
  Descending: Boolean;
  SortedColumn: Integer;

const
  { For Windows >= XP }
  {$EXTERNALSYM HDF_SORTUP}
  HDF_SORTUP              = $0400;
  {$EXTERNALSYM HDF_SORTDOWN}
  HDF_SORTDOWN            = $0200;

procedure ShowArrowOfListViewColumn(ListView1: TListView; ColumnIdx: integer; Descending: boolean);
var
  Header: HWND;
  Item: THDItem;
begin
  Header := ListView_GetHeader(ListView1.Handle);
  ZeroMemory(@Item, SizeOf(Item));
  Item.Mask := HDI_FORMAT;
  Header_GetItem(Header, ColumnIdx, Item);
  Item.fmt := Item.fmt and not (HDF_SORTUP or HDF_SORTDOWN);//remove both flags
  if Descending then
    Item.fmt := Item.fmt or HDF_SORTDOWN
  else
    Item.fmt := Item.fmt or HDF_SORTUP;//include the sort ascending flag
  Header_SetItem(Header, ColumnIdx, Item);
end;

procedure TUD2MainForm.ListView3Compare(Sender: TObject; Item1,
  Item2: TListItem; Data: Integer; var Compare: Integer);
begin
  if SortedColumn = 0 then
    Compare := CompareText(Item1.Caption, Item2.Caption)
  else
    Compare := CompareText(Item1.SubItems[SortedColumn-1], Item2.SubItems[SortedColumn-1]);
  if Descending then Compare := -Compare;
end;

procedure TUD2MainForm.ListView3ColumnClick(Sender: TObject;
  Column: TListColumn);
begin
  TListView(Sender).SortType := stNone;
  if Column.Index<>SortedColumn then
  begin
    SortedColumn := Column.Index;
    Descending := False;
  end
  else
    Descending := not Descending;
  ShowArrowOfListViewColumn(TListView(Sender), column.Index, Descending);
  TListView(Sender).SortType := stText;
end;

The colums can be sorted up- and downwards, but I can't see arrows.

According to this question , my function ShowArrowOfListViewColumn() should have solved the problem.

Is it possible that Delphi 6 does not support this feature, or is there a problem in my code? On the other hand, ListView is IIRC a Windows control, and therefore I expect that the WinAPI renders the arrow graphics, and not the (very old) VCL.

I read at a German website that the arrow graphics have to be added manually, but the solution of that website has the requirement to change CommCtrl.pas of Delphi (because of a glitch when resizing column). But I really dislike modifing the VCL source, especially since I develop OpenSource, and I do not want that other developers change/recompile their Delphi Sources.

Note that I didn't add a XP manifest to my binary, so the app looks like Win9x.

Malpractice

Are you using comctl v6, i.e. XP themes? That requires Mike Lischke's theme manager. – Icelandic

I didn't add a XP manifest to my binary, so the app looks like Win9x. – Malpractice

Answer 1

HDF_SORTDOWN and HDF_SORTUP require comctl32 v6. This is stated in the documentation for HDITEM:

HDF_SORTDOWN Version 6.00 and later. Draws a down-arrow on this item. This is typically used to indicate that information in the current window is sorted on this column in descending order. This flag cannot be combined with HDF_IMAGE or HDF_BITMAP.

HDF_SORTUP Version 6.00 and later. Draws an up-arrow on this item. This is typically used to indicate that information in the current window is sorted on this column in ascending order. This flag cannot be combined with HDF_IMAGE or HDF_BITMAP.

As you explained in your comments, you did not include the comctl32 v6 manifest. That explains what you observe.

Solutions include:

• Adding the comctl32 v6 manifest, or
• Custom drawing header arrows.

Icelandic

Hello, thank you very much for this hint. I actually read "requires Windows XP", but I forgot that Windows will use a fallback version of ComCtl32, if no manifest is provided. -- I am still a bit surprised about this, because the arrows exist since Windows 95. Did Microsoft kept this feature disclosed until Windows XP, or did the Windows 95 Explorer use a different control than the ListView ? – Malpractice

For completeness, I have created a VCL - which also solves the problem with the arrows vanishing on each column resize: viathinksoft.de/~daniel-marschall/code/delphi/vcl/… . But I fear that I have re-invented the wheel. – Malpractice

Prob explorer in win 95 used a different control, or custom drew the arrows – Icelandic

Answer 2

You don't have to change the VCL source to follow the german example, you can just patch the code runtime.

DISCALMER I wanted to test my code on Delphi 6, but my Delphi 6 installation wouldn't start this morning, so it is only tested on Delphi XE!

But I guess it would work on Delphi 6 as well.

First you need a class to Patch a method runtime:

unit PatchU;

interface

type
  pPatchEvent = ^TPatchEvent;

  // "Asm" opcode hack to patch an existing routine
  TPatchEvent = packed record
    Jump: Byte;
    Offset: Integer;
  end;

  TPatchMethod = class
  private
    PatchedMethod, OriginalMethod: TPatchEvent;
    PatchPositionMethod: pPatchEvent;
  public
    constructor Create(const aSource, aDestination: Pointer);
    destructor Destroy; override;
    procedure Restore;
    procedure Hook;
  end;

implementation

uses
  Windows, Sysutils;

{ TPatchMethod }

constructor TPatchMethod.Create(const aSource, aDestination: Pointer);
var
  OldProtect: Cardinal;
begin
  PatchPositionMethod := pPatchEvent(aSource);
  OriginalMethod := PatchPositionMethod^;
  PatchedMethod.Jump := $E9;
  PatchedMethod.Offset := PByte(aDestination) - PByte(PatchPositionMethod) - SizeOf(TPatchEvent);

  if not VirtualProtect(PatchPositionMethod, SizeOf(TPatchEvent), PAGE_EXECUTE_READWRITE, OldProtect) then
    RaiseLastOSError;

  Hook;
end;

destructor TPatchMethod.Destroy;
begin
  Restore;
  inherited;
end;

procedure TPatchMethod.Hook;
begin
  PatchPositionMethod^ := PatchedMethod;
end;

procedure TPatchMethod.Restore;
begin
  PatchPositionMethod^ := OriginalMethod;
end;

end.

Then we need to use it. Pau a listview on a form an then this code:

unit Unit1;

interface

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

type
  TListView = class(ComCtrls.TListView)
  protected
    procedure ColClick(Column: TListColumn); override;
  end;

  TForm1 = class(TForm)
    ListView1: TListView;
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

uses
  CommCtrl;

var
  ListView_UpdateColumn_Patch: TPatchMethod;

type
  THooked_ListView = class(TListView)
    procedure HookedUpdateColumn(AnIndex: Integer);
  end;

  { TListView }

procedure TListView.ColClick(Column: TListColumn);
var
  Header: HWND;
  Item: THDItem;
  NewFlag: DWORD;
begin
  Header := ListView_GetHeader(Handle);
  ZeroMemory(@Item, SizeOf(Item));
  Item.Mask := HDI_FORMAT;
  Header_GetItem(Header, Column.Index, Item);

  if Item.fmt and HDF_SORTDOWN <> 0 then
    NewFlag := HDF_SORTUP
  else
    NewFlag := HDF_SORTDOWN;

  Item.fmt := Item.fmt and not(HDF_SORTUP or HDF_SORTDOWN); // remove both flags
  Item.fmt := Item.fmt or NewFlag;
  Header_SetItem(Header, Column.Index, Item);

  inherited;
end;

{ THooked_ListView }

procedure THooked_ListView.HookedUpdateColumn(AnIndex: Integer);
begin
  ListView_UpdateColumn_Patch.Restore;
  try
    UpdateColumn(AnIndex);
  finally
    ListView_UpdateColumn_Patch.Hook;
  end;
end;

initialization

ListView_UpdateColumn_Patch := TPatchMethod.Create(@TListView.UpdateColumn, @THooked_ListView.HookedUpdateColumn);

finalization

ListView_UpdateColumn_Patch.Free;

end.

As you see then my demo i heavly inspired by the code you published. I just removed the global vars. In my example I do nothing but calling the original procedure, but you'll ofcause have to call the code from the Geraman example.

So basically I just wanted to show you how you could change the VCL with out editing the original source code. This should get you going.

Zymolysis

You don't need to hack like this. You can use the code from my answer there without any of the nasty hacks in your answer here. – Icelandic

It it the TListView = class(ComCtrls.TListView) part or the patch part you call a nasty hack? – Zymolysis

The detour is needless. In anycase, you have missed the point. The question already told you that the code in my other answer is having no effect. You need to explain why that would be so. Lack of XP themes is the real reason. – Icelandic