使用箭头对ListView列进行排序

时间:2015-09-28 03:56:02

标签: delphi winapi delphi-6

我正在使用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;

colums可以上下排序,但我看不到箭头。

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

Delphi 6是否可能不支持此功能,或者我的代码中是否存在问题?另一方面,ListView是IIRC Windows control,因此我希望WinAPI呈现箭头图形,而不是(非常旧的)VCL。

我在German website读到必须手动添加箭头图形,但该网站的解决方案需要更改Delphi的CommCtrl.pas(因为调整列大小时出现故障)。但我真的不喜欢修改VCL源代码,特别是因为我开发了OpenSource,而且我不希望其他开发人员改变/重新编译他们的Delphi源代码。

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

2 个答案:

答案 0 :(得分:4)

HDF_SORTDOWNHDF_SORTUP需要comctl32 v6。这在HDITEM的文档中说明:

  

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

     

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

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

解决方案包括:

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

答案 1 :(得分:-1)

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

DISCALMER 我想在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.

然后我们需要使用它。 Pau表格上的列表视图然后是这段代码:

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。这应该让你去。