Jak*_*ays 3 delphi delphi-2010
我最近得到了帮助,根据列数据类型对TListView的列进行排序.
这是代码:
procedure TfrmFind.lvwTagsColumnClick(Sender: TObject; Column: TListColumn);
begin
ColumnToSort := Column.Index;
(Sender as TCustomListView).AlphaSort;
end;
procedure TfrmFind.lvwTagsCompare(Sender: TObject; Item1, Item2: TListItem;
Data: Integer; var Compare: Integer);
var
ix: Integer;
begin
if ColumnToSort = 0 then
Compare := CompareText(Item1.Caption,Item2.Caption)
else
if ColumnToSort = 1 then
Compare := CompareTextAsInteger(Item1.subitems[0],Item2.subitems[0])
else
if ColumnToSort = 2 then
Compare := CompareTextAsDateTime(Item1.subitems[1],Item2.subitems[1])
else
begin
ix := ColumnToSort - 1;
Compare := CompareText(Item1.SubItems[ix],Item2.SubItems[ix]);
end;
end;
Run Code Online (Sandbox Code Playgroud)
如果有可能,我想添加升序和降序排序功能吗?
用户单击一次以升序排序,然后再次单击降序排序
我可以从我目前的代码中执行此操作吗?
如何在左列添加一个字形以显示排序类型(升序与降序)?
******************************************************************************
Run Code Online (Sandbox Code Playgroud)
基于专家的修改答案:2013年3月25日
procedure TfrmFind.lvwTagsColumnClick(Sender: TObject; Column: TListColumn);
begin
ColumnToSort := Column.Index;
Column.Tag:= Column.Tag * -1;
if Column.Tag = 0 then Column.Tag:=1;
(Sender as TCustomListView).AlphaSort;
end;
procedure TfrmFind.lvwTagsCompare(Sender: TObject; Item1, Item2: TListItem;
Data: Integer; var Compare: Integer);
begin
Case ColumnToSort of
0: Compare := TRzListView(Sender).Tag * CompareText(Item1.Caption, Item2.Caption);
1: Compare := TRzListView(Sender).Tag * CompareTextAsInteger(Item1.subitems[0],Item2.subitems[0]);
2: Compare := TRzListView(Sender).Tag * CompareTextAsDateTime(Item1.subitems[1],Item2.subitems[1]);
else
Compare := TRzListView(Sender).Tag * CompareText(Item1.Caption, Item2.Caption);
End;
end;
Run Code Online (Sandbox Code Playgroud)
你现在要做的事情现在相当复杂.为了能够掌握这一点,我建议你构建一套精心设计的低级辅助例程.然后,您可以使用简短明了的方法编写高级UI代码.
首先,让我们有一些获取和设置列表标题排序状态的例程.这是列表视图标题控件中的向上/向下排序图标.
function ListViewFromColumn(Column: TListColumn): TListView;
begin
Result := (Column.Collection as TListColumns).Owner as TListView;
end;
type
THeaderSortState = (hssNone, hssAscending, hssDescending);
function GetListHeaderSortState(Column: TListColumn): THeaderSortState;
var
Header: HWND;
Item: THDItem;
begin
Header := ListView_GetHeader(ListViewFromColumn(Column).Handle);
ZeroMemory(@Item, SizeOf(Item));
Item.Mask := HDI_FORMAT;
Header_GetItem(Header, Column.Index, Item);
if Item.fmt and HDF_SORTUP<>0 then
Result := hssAscending
else if Item.fmt and HDF_SORTDOWN<>0 then
Result := hssDescending
else
Result := hssNone;
end;
procedure SetListHeaderSortState(Column: TListColumn; Value: THeaderSortState);
var
Header: HWND;
Item: THDItem;
begin
Header := ListView_GetHeader(ListViewFromColumn(Column).Handle);
ZeroMemory(@Item, SizeOf(Item));
Item.Mask := HDI_FORMAT;
Header_GetItem(Header, Column.Index, Item);
Item.fmt := Item.fmt and not (HDF_SORTUP or HDF_SORTDOWN);//remove both flags
case Value of
hssAscending:
Item.fmt := Item.fmt or HDF_SORTUP;
hssDescending:
Item.fmt := Item.fmt or HDF_SORTDOWN;
end;
Header_SetItem(Header, Column.Index, Item);
end;
Run Code Online (Sandbox Code Playgroud)
我从这个答案中获取了这段代码:如何在TListView列上显示排序箭头?
接下来我会创建一个记录来保存排序规范.理想情况下,这将在其Data参数中得到排序比较函数.但遗憾的是,VCL框架错过了将该参数用于其预期目的的机会.因此,我们需要以拥有列表视图的形式存储活动排序的规范.
type
TSortSpecification = record
Column: TListColumn;
Ascending: Boolean;
CompareItems: function(const s1, s2: string): Integer;
end;
Run Code Online (Sandbox Code Playgroud)
然后在表单本身中,您将声明一个字段来保存其中一个:
type
TfrmFind = class(...)
private
....
FSortSpecification: TSortSpecification;
....
end;
Run Code Online (Sandbox Code Playgroud)
比较函数使用规范.这很简单:
procedure TfrmFind.ListViewCompare(Sender: TObject; Item1, Item2: TListItem;
Data: Integer; var Compare: Integer);
var
Index: Integer;
s1, s2: string;
begin
Index := FSortSpecification.Column.Index;
if Index=0 then
begin
s1 := Item1.Caption;
s2 := Item2.Caption;
end else
begin
s1 := Item1.SubItems[Index-1];
s2 := Item2.SubItems[Index-1];
end;
Compare := FSortSpecification.CompareItems(s1, s2);
if not FSortSpecification.Ascending then
Compare := -Compare;
end;
Run Code Online (Sandbox Code Playgroud)
接下来我们将实现一个排序功能.
procedure TfrmFind.Sort(Column: TListColumn; Ascending: Boolean);
var
ListView: TListView;
begin
FSortSpecification.Column := Column;
FSortSpecification.Ascending := Ascending;
case Column.Index of
1:
FSortSpecification.CompareItems := CompareTextAsInteger;
2:
FSortSpecification.CompareItems := CompareTextAsDateTime;
else
FSortSpecification.CompareItems := CompareText;
end;
ListView := ListViewFromColumn(Column);
ListView.OnCompare := ListViewCompare;
ListView.AlphaSort;
end;
Run Code Online (Sandbox Code Playgroud)
此Sort函数与OnClick处理程序分离.这将允许您独立于用户的UI操作对列进行排序.例如,您可能希望在首次显示表单时对特定列的控件进行排序.
最后,OnClick处理程序可以调用sort函数:
procedure TfrmFind.lvwTagsColumnClick(Sender: TObject; Column: TListColumn);
var
i: Integer;
Ascending: Boolean;
State: THeaderSortState;
begin
Ascending := GetListHeaderSortState(Column)<>hssAscending;
Sort(Column, Ascending);
for i := 0 to ListView.Columns.Count-1 do
begin
if ListView.Column[i]=Column then
if Ascending then
State := hssAscending
else
State := hssDescending
else
State := hssNone;
SetListHeaderSortState(ListView.Column[i], State);
end;
end;
Run Code Online (Sandbox Code Playgroud)
为了完整起见,这是一个实现这些想法的完整单元:
unit uFind;
interface
uses
Windows, Messages, SysUtils, Classes, Math, DateUtils, Controls, Forms, Dialogs, ComCtrls, CommCtrl;
type
TSortSpecification = record
Column: TListColumn;
Ascending: Boolean;
CompareItems: function(const s1, s2: string): Integer;
end;
TfrmFind = class(TForm)
ListView: TListView;
procedure lvwTagsColumnClick(Sender: TObject; Column: TListColumn);
private
FSortSpecification: TSortSpecification;
procedure ListViewCompare(Sender: TObject; Item1, Item2: TListItem;
Data: Integer; var Compare: Integer);
procedure Sort(Column: TListColumn; Ascending: Boolean);
end;
var
frmFind: TfrmFind;
implementation
{$R *.dfm}
function CompareTextAsInteger(const s1, s2: string): Integer;
begin
Result := CompareValue(StrToInt(s1), StrToInt(s2));
end;
function CompareTextAsDateTime(const s1, s2: string): Integer;
begin
Result := CompareDateTime(StrToDateTime(s1), StrToDateTime(s2));
end;
function ListViewFromColumn(Column: TListColumn): TListView;
begin
Result := (Column.Collection as TListColumns).Owner as TListView;
end;
type
THeaderSortState = (hssNone, hssAscending, hssDescending);
function GetListHeaderSortState(Column: TListColumn): THeaderSortState;
var
Header: HWND;
Item: THDItem;
begin
Header := ListView_GetHeader(ListViewFromColumn(Column).Handle);
ZeroMemory(@Item, SizeOf(Item));
Item.Mask := HDI_FORMAT;
Header_GetItem(Header, Column.Index, Item);
if Item.fmt and HDF_SORTUP<>0 then
Result := hssAscending
else if Item.fmt and HDF_SORTDOWN<>0 then
Result := hssDescending
else
Result := hssNone;
end;
procedure SetListHeaderSortState(Column: TListColumn; Value: THeaderSortState);
var
Header: HWND;
Item: THDItem;
begin
Header := ListView_GetHeader(ListViewFromColumn(Column).Handle);
ZeroMemory(@Item, SizeOf(Item));
Item.Mask := HDI_FORMAT;
Header_GetItem(Header, Column.Index, Item);
Item.fmt := Item.fmt and not (HDF_SORTUP or HDF_SORTDOWN);//remove both flags
case Value of
hssAscending:
Item.fmt := Item.fmt or HDF_SORTUP;
hssDescending:
Item.fmt := Item.fmt or HDF_SORTDOWN;
end;
Header_SetItem(Header, Column.Index, Item);
end;
procedure TfrmFind.ListViewCompare(Sender: TObject; Item1, Item2: TListItem;
Data: Integer; var Compare: Integer);
var
Index: Integer;
s1, s2: string;
begin
Index := FSortSpecification.Column.Index;
if Index=0 then
begin
s1 := Item1.Caption;
s2 := Item2.Caption;
end else
begin
s1 := Item1.SubItems[Index-1];
s2 := Item2.SubItems[Index-1];
end;
Compare := FSortSpecification.CompareItems(s1, s2);
if not FSortSpecification.Ascending then
Compare := -Compare;
end;
procedure TfrmFind.Sort(Column: TListColumn; Ascending: Boolean);
var
ListView: TListView;
begin
FSortSpecification.Column := Column;
FSortSpecification.Ascending := Ascending;
case Column.Index of
1:
FSortSpecification.CompareItems := CompareTextAsInteger;
2:
FSortSpecification.CompareItems := CompareTextAsDateTime;
else
FSortSpecification.CompareItems := CompareText;
end;
ListView := ListViewFromColumn(Column);
ListView.OnCompare := ListViewCompare;
ListView.AlphaSort;
end;
procedure TfrmFind.lvwTagsColumnClick(Sender: TObject; Column: TListColumn);
var
i: Integer;
Ascending: Boolean;
State: THeaderSortState;
begin
Ascending := GetListHeaderSortState(Column)<>hssAscending;
Sort(Column, Ascending);
for i := 0 to ListView.Columns.Count-1 do
begin
if ListView.Column[i]=Column then
if Ascending then
State := hssAscending
else
State := hssDescending
else
State := hssNone;
SetListHeaderSortState(ListView.Column[i], State);
end;
end;
end.
Run Code Online (Sandbox Code Playgroud)
您可以使用您的代码.只需将标签转换为切换排序即可
procedure TfrmFind.lvwTagsColumnClick(Sender: TObject; Column: TListColumn);
begin
ColumnToSort := Column.Index;
if Column.Tag = 0 then Column.Tag := 1 else Column.Tag := 0;
(Sender as TCustomListView).AlphaSort;
end;
Run Code Online (Sandbox Code Playgroud)
并在你的比较中
Case ColumnToSort of
0:begin
if TListView(Sender).Column[ColumnToSort].Tag = 0 then
Compare := CompareText(Item1.Caption, Item2.Caption)
else
Compare := CompareText(Item2.Caption, Item1.Caption);
end;
1:begin
........................
end;
End;
Run Code Online (Sandbox Code Playgroud)
或建议的bettes是TLama
procedure TfrmFind.lvwTagsColumnClick(Sender: TObject; Column: TListColumn);
begin
ColumnToSort := Column.Index;
Column.Tag := Column.Tag * -1;
if Column.Tag = 0 then Column.Tag := 1;
(Sender as TCustomListView).AlphaSort;
end;
Run Code Online (Sandbox Code Playgroud)
与比较
Case ColumnToSort of
0: Compare := TListView(Sender).Column[ColumnToSort].Tag * CompareText(Item1.Caption, Item2.Caption);
1: ........................
End;
Run Code Online (Sandbox Code Playgroud)