使用箭头对ListView列进行排序

Question

我正在使用Delphi 6，并想要为ListView添加类似Windows资源管理器中排序的功能。

在第一次测试中，我（草率地）从几个来源复制了一些源代码，并进行了一些小的调整：

目前我只有以下内容（仅限草率版）：

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;

这些列可以向上和向下排序，但我看不到箭头。

根据这个问题，我的ShowArrowOfListViewColumn()函数应该解决了这个问题。

是否可能Delphi 6不支持此功能，或者我的代码有问题？另一方面，ListView是一个Windows控件，因此我希望WinAPI渲染箭头图形，而不是（非常古老的）VCL。

我在德语网站上读到，箭头图形必须手动添加，但该网站的解决方案要求更改Delphi的CommCtrl.pas（因为调整列大小时出现故障）。但我真的不喜欢修改VCL源代码，特别是因为我开发OpenSource，并且不希望其他开发人员更改/重新编译其Delphi源代码。

请注意，我没有将XP清单添加到我的二进制文件中，因此该应用程序看起来像Win9x。

- Daniel Marschall

---

你是否正在使用comctl v6，即XP主题？这需要Mike Lischke的主题管理器。 - David Heffernan

我没有为我的二进制文件添加XP清单，所以应用程序看起来像Win9x。 - Daniel Marschall

Answer 1

HDF_SORTDOWN和HDF_SORTUP需要comctl32 v6。这在HDITEM的文档中已经说明：

HDF_SORTDOWN 版本6.00及更高版本。在此项上绘制向下箭头。通常用于指示当前窗口中的信息按该列进行降序排序。此标志不能与HDF_IMAGE或HDF_BITMAP组合使用。

HDF_SORTUP 版本6.00及更高版本。在此项上绘制向上箭头。通常用于指示当前窗口中的信息按该列进行升序排序。此标志不能与HDF_IMAGE或HDF_BITMAP组合使用。

根据您在评论中的解释，您没有包含comctl32 v6清单。这就解释了您观察到的结果。

解决方案包括：

• 添加comctl32 v6清单，或
• 自定义绘制标题箭头。

- David Heffernan

---

你好，非常感谢这个提示。我确实看到了“需要Windows XP”，但我忘记了如果没有提供清单文件，Windows会使用ComCtl32的回退版本。——我仍然有些惊讶，因为箭头自Windows 95以来就存在了。微软是一直保留这个功能直到Windows XP发布才公开吗，还是Windows 95资源管理器使用的控件与ListView不同？ - Daniel Marschall

为了完整性，我创建了一个VCL - 它也解决了每次调整列大小时箭头消失的问题：http://www.viathinksoft.de/~daniel-marschall/code/delphi/vcl/VTSListView.pas。但我担心我重新发明了轮子。 - Daniel Marschall

Win 95中的Prob Explorer使用了不同的控件，或自定义绘制了箭头。 - David Heffernan

Answer 2

您不必更改VCL源代码来遵循德语示例，只需在运行时修补代码即可。

免责声明 我想在Delphi 6上测试我的代码，但今天早上我的Delphi 6安装程序无法启动，因此它仅在Delphi XE上进行了测试！

但我猜它也可以在Delphi 6上工作。

首先，您需要一个类来在运行时修补方法：

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.

然后我们需要使用它，把一个列表视图放在窗体上，然后添加这段代码：

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.

正如您在我的演示中看到的那样，我受到了您发布的代码的很大启发。我只是删除了全局变量。在我的示例中，我仅调用原始过程，但您当然必须从德国示例中调用代码。

因此，基本上我只是想向您展示如何在不编辑原始源代码的情况下更改VCL。这应该能帮助您入门。

- Jens Borrisholt

---

你不需要像这样进行黑客攻击。你可以使用我在那里回答的代码，而不需要在你的回答中使用任何恶意攻击。 - David Heffernan

你是指 TListView = class(ComCtrls.TListView) 这部分还是 patch 部分被称为恶意黑客攻击？ - Jens Borrisholt

绕路是不必要的。无论如何，你已经错过了重点。问题已经告诉你，我其他答案中的代码没有任何效果。你需要解释为什么会这样。缺乏XP主题是真正的原因。 - David Heffernan