当前位置 : 主页 > 编程语言 > delphi >

delphi – 对TListView列进行排序 – 续. (升序降序)

来源：互联网 收集：自由互联 发布时间：2021-06-23
我最近得到了 sorting a TListView’s columns based on columns data type的帮助. 这是代码： procedure TfrmFind.lvwTagsColumnClick(Sender: TObject; Column: TListColumn);begin ColumnToSort := Column.Index; (Sender as TCustomListVi
我最近得到了 sorting a TListView’s columns based on columns data type的帮助.

这是代码：

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;

如果有可能,我想添加升序和降序排序功能吗？

用户单击一次以升序排序,然后再次单击降序排序

我可以从我目前的代码中执行此操作吗？

如何在左列添加一个字形以显示排序类型(升序与降序)？

******************************************************************************

基于专家的修改答案：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;
你现在要做的事情现在相当复杂.为了能够掌握这一点,我建议你构建一套精心设计的低级辅助例程.然后,您可以使用简短明了的方法编写高级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;

我从这个答案中获取了这段代码：How to show the sort arrow on a TListView column?

接下来我会创建一个记录来保存排序规范.理想情况下,这将在其Data参数中到达sort compare函数.但遗憾的是,VCL框架错过了将该参数用于其预期目的的机会.因此,我们需要以拥有列表视图的形式存储活动排序的规范.

type
  TSortSpecification = record
    Column: TListColumn;
    Ascending: Boolean;
    CompareItems: function(const s1, s2: string): Integer;
  end;

然后在表单本身中,您将声明一个字段来保存其中一个：

type
  TfrmFind = class(...)
  private
    ....
    FSortSpecification: TSortSpecification;
    ....
  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;

此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;

为了完整起见,这是一个实现这些想法的完整单元：

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.
上一篇：delphi – 解决来自csrss.exe的应用程序错误
下一篇：delphi – 类EVariantTypeCastError,消息’无法将类型(String)的变体转换为类型(Double)
网友评论
相关栏目
最近更新
热门文章