使用箭头对 ListView 列进行排序

Question

我正在使用 Delphi 6 并希望添加对 ListView 进行排序的功能，就像在 Windows Explorer 中所做的那样。

在第一次测试中，我（快速&肮脏地）从几个来源复制了一些源代码，并做了一些小的调整：

这是我目前所拥有的（目前只是快速和肮脏的）：

uses
  CommCtrls;

var
  Descending: Boolean;
  SortedColumn: Integer;

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

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;

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

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

有没有可能是Delphi6不支持这个功能，还是我的代码有问题？另一方面，ListView 是 IIRC Windows control，因此我希望 WinAPI 呈现箭头图形，而不是（非常旧的）VCL。

我在German website看到箭头图形必须手动添加，但是该网站的解决方案要求将CommCtrl.pas更改为Delphi（因为a调整列大小时出现故障）。但我真的不喜欢修改 VCL 源代码，尤其是因为我开发了 OpenSource，而且我不希望其他开发人员 change/recompile 他们的 Delphi 源代码。

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

Answer 1

您无需更改 VCL 源代码即可仿效德语示例，只需修补代码运行时即可。

DISCALMER 我想在 Delphi 6 上测试我的代码，但是我的 Delphi 6 安装今天早上不会开始，所以它只是在 Delphi XE!

上测试

但我想它也适用于 Delphi 6。

首先你需要一个class来修补方法运行时：

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.

如您所见，我的演示深受您发布的代码的启发。我刚刚删除了全局变量。在我的示例中，除了调用原始过程外，我什么都不做，但您将不得不调用 Geraman 示例中的代码。

基本上我只是想向您展示如何在不编辑原始源代码的情况下更改 VCL。这应该让你去。

Answer 2

HDF_SORTDOWN 和 HDF_SORTUP 需要 comctl32 v6。 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.

正如您在评论中所解释的那样，您没有包含 comctl32 v6 清单。这解释了你所观察到的。

解决方案包括：

添加 comctl32 v6 清单，或
自定义绘图 header 箭头。

使用箭头对 ListView 列进行排序

Sorting ListView columns with arrows

delphi

winapi

delphi-6