Sort ListView columns with arrows

Question

I am using Delphi 6 and want to add ListView sorting functionality, as is done in Windows Explorer.

In the first test, I (quickly and dirty) copied several source codes from several sources and made a few small settings:

This is what I still have (just quick and dirty):

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; 

Cola can be sorted up and down, but I do not see the arrow.

In accordance with this question, my ShowArrowOfListViewColumn () task should solve the problem.

Is it possible that Delphi 6 does not support this function, or is there a problem in my code? ListView, on the other hand, is IIRC a Windows control , and so I expect WinAPI to display arrow graphics rather than the (very old) VCL.

I read on a German website that arrow graphics need to be added manually, but solving this website requires changing CommCtrl.pas from Delphi (due to a failure when resizing a column). But I really don’t like modifying the VCL source, especially since I am developing OpenSource, and I do not want other developers to change / recompile their Delphi sources.

Please note that I did not add the XP manifest to my binary, so the application looks like Win9x.

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 usually used to indicate that the information in the current window is sorted by 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 usually used to indicate that the information in the current window is sorted in 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 specify the comctl32 v6 manifest. This explains what you are observing.

Solutions include:

• Adding a comctl32 v6 manifest or
• Custom drawing caption arrows.

Answer 2

You do not need to change the source of the VCL to follow the German example; you can simply fix the code execution time.

DISCALMER I wanted to test my code on Delphi 6, but my installation of Delphi 6 did not start this morning, so it is tested only on Delphi XE!

But I think this will work on Delphi 6 as well.

First you need a class to fix the execution time of the method:

 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 listview on the form and then on 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 can see, my demo is very inspired by the code you posted. I just deleted global vars. In my example, I do nothing but call the original procedure, but you must call the code from the Geraman example.

So basically I just wanted to show you how you can change the VCL without editing the source code. That should make you go.