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

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)

Dav*_*nan 8

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


bum*_*mmi 5

您可以使用您的代码.只需将标签转换为切换排序即可

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)

  • 您可以简单地分配给`Tag`变量值1或-1,并将`Compare`值乘以`Compare:= Tag*CompareText(Item1.Caption,Item2.Caption)`.那将*切换*比较的结果. (4认同)