我正在使用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。
答案 0 :(得分:4)
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清单。这解释了你观察到的。
解决方案包括:
答案 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。这应该让你去。