降序列表框项目 Delphi XE8

Question

我正在查看有关如何按降序对列表框项目进行排序的一些问题。似乎默认且唯一的顺序是升序。我们确实有可用的字符串集合（TStringList）。

在我看来，如果我们将排序目标插入到集合列表中，执行排序（按升序）但按降序访问已排序的项目，并在键被剥离后将它们添加到未排序的列表框项目中，我们会收到所需的下降效果。

procedure TBCSLBDemoC.DescendLZB(var lb: TListBox);
var
  sc: TStringList;
  i: Integer;
  rdt: TDateTime;
  buf : string;
begin
  sc := TStringList.Create;
  i := 0;
  repeat
    rdt := TFile.GetLastAccessTime(lb.Items[i]);
    sc.Add(FormatDateTime('YYYYMMDDHHMMSS', rdt) + ' ' + lb.Items[i]);
    Inc(i);
  until (i > (lb.Count - 1));
  sc.Sort;
  lb.Sorted := false;
  lb.Items.Clear;
  i := sc.Count - 1;
  repeat
    buf := sc[i];
    Delete(buf, 1, 15);
    lb.Items.Add(buf);
    dec(i);
  until (i < 0);
  sc.Free;
end;

这些结果对我来说似乎很有效，但我的问题是如何改进这项技术？我相信我忽略了一些东西。，

Answer 1

有很多不同的方法可以解决这个问题。您已经展示了一种方法。您可以切换到虚拟列表框并将数据存储在您保持有序的数据结构中。您可以就地对列表进行排序。

就我个人而言，看到您创建一个新列表来执行排序的代码，我感到有些不安。使用时间戳的文本表示更令人反感。如果列表中有大量项目，那么虚拟模式更有效。

但是，我将演示一种非常灵活的方法来对列表进行就地排序。让我们从我的回答中的代码开始：https://*.com/a/21702570/505088。为了自成一体，让我们在这里重现代码，稍作修改以使用参考程序：

type
  TCompareIndicesFunction = reference to function(Index1, Index2: Integer): Integer;
  TExchangeIndicesProcedure = reference to procedure(Index1, Index2: Integer);

procedure QuickSort(Count: Integer; Compare: TCompareIndicesFunction; 
  Exchange: TExchangeIndicesProcedure);

  procedure Sort(L, R: Integer);
  var
    I, J, P: Integer;
  begin
    repeat
      I := L;
      J := R;
      P := (L+R) div 2;
      repeat
        while Compare(I, P)<0 do inc(I); 
        while Compare(J, P)>0 do dec(J); 
        if I<=J then 
        begin
          if I<>J then 
          begin
            Exchange(I, J);
            //may have moved the pivot so we must remember which element it is
            if P=I then
              P := J
            else if P=J then
              P := I;
          end;
          inc(I);
          dec(J);
        end;
      until I>J;
      if L<J then 
        Sort(L, J); 
      L := I;
    until I>=R;
  end;

begin
  if Count>0 then
    Sort(0, Count-1);
end;

这里的关键思想是排序算法与数据存储分离。这就是为我们提供灵活性的原因。

接下来我们需要实现比较和交换功能。像这样：

var
  Compare: TCompareIndicesFunction;
  Exchange: TExchangeIndicesProcedure;

Compare := 
  function(Index1, Index2: Integer): Integer
  var
    dt1, dt2: TDateTime;
  begin
    dt1 := TFile.GetLastAccessTime(lb.Items[Index1]);
    dt2 := TFile.GetLastAccessTime(lb.Items[Index2]);
    if dt1=dt2 then begin
      Result := 0;
    end else if dt2<dt1 then begin
      Result := -1
    end else begin
      Result := 1;
    end;
  end;

Exchange := 
  procedure(Index1, Index2: Integer)
  begin
    lb.Items.Exchange(Index1, Index2);
  end;

请注意，我比较的是时间戳的数值，感觉更令人愉悦。如果我将顺序从前（我总是在排序比较函数中挣扎），那么如何反转它应该很明显。

最后我们可以这样排序：

QuickSort(lb.Count, Compare, Exchange);

此代码应放在您的DescendLZB 中，以便捕获列表框。此外，lb 参数不应是 var 参数，因为您不想修改其值。

全部加起来会是这样的：

procedure TBCSLBDemoC.DescendLZB(lb: TListBox);
var
  Compare: TCompareIndicesFunction;
  Exchange: TExchangeIndicesProcedure;
begin
  Compare := 
    function(Index1, Index2: Integer): Integer
    var
      dt1, dt2: TDateTime;
    begin
      dt1 := TFile.GetLastAccessTime(lb.Items[Index1]);
      dt2 := TFile.GetLastAccessTime(lb.Items[Index2]);
      if dt1=dt2 then begin
        Result := 0;
      end else if dt2<dt1 then begin
        Result := -1
      end else begin
        Result := 1;
      end;
    end;

  Exchange := 
    procedure(Index1, Index2: Integer)
    begin
      lb.Items.Exchange(Index1, Index2);
    end;
  end;

  QuickSort(lb.Count, Compare, Exchange);
end;