Question

我试图在Delphi中对文件列表进行排序（它们存储为字符串列表），其名称如下所示

a_1.xml
a_20.xml
a_10.xml
a_2.XML

当我使用快速排序sort文件名时，它会对文件名进行排序，如下所示

a_1.xml
a_10.xml
a_2.xml
a_20.XML

但是，我希望文件名以下面的方式排序

a_1.xml
a_2.xml
a_10.xml
a_20.XML

非常感谢任何帮助。

Answer 1

您可以使用资源管理器使用的相同比较功能，即StrCmpLogicalW。

function StrCmpLogicalW(psz1, psz2: PWideChar): Integer; stdcall;
  external 'shlwapi.dll';

function StrCmpLogical(const s1, s2: string): Integer;
begin
  Result := StrCmpLogicalW(PChar(s1), PChar(s2));
end;

如果您的字符串位于TStringList实例中，则可以使用其CustomSort方法。这需要这种形式的比较函数：

TStringListSortCompare = function(List: TStringList; 
  Index1, Index2: Integer): Integer;

所以，喂CustomSort这个函数：

function StringListCompareLogical(List: TStringList; 
  Index1, Index2: Integer): Integer;
begin
  Result := StrCmpLogical(List[Index1], List[Index2]);
end;

Answer 2

根据您的具体情况调整的轻量级解决方案如下：

function compare(List: TStringList; Index1, Index2: Integer): Integer;
var
  n1, n2: integer;
begin
  n1 := StrToInt(Copy(List[Index1], 3, Length(List[Index1]) - 6));
  n2 := StrToInt(Copy(List[Index2], 3, Length(List[Index2]) - 6));
  result := n1 - n2;
end;

var
  sl: TStringList;

procedure AddAndSort;
begin
  sl := TStringList.Create;
  sl.Add('a_1.xml');
  sl.Add('a_20.xml');
  sl.Add('a_10.xml');
  sl.Add('a_2.XML');
  sl.CustomSort(compare);
end;

Answer 3

Andreas Rejbrand的答案还可以。但更好的是你将比较功能用于一般用途：

function compare(List: TStringList; Index1, Index2: Integer): Integer;
begin
  if Length(List[Index1]) = Length(List[Index2]) then
    begin
      if List[Index1] = List[Index2] then
        result := 0
      else
        if List[Index1] < List[Index2] then
          result := -1
        else
          result := 1;
    end
  else
    if Length(List[Index1]) < Length(List[Index2]) then
      result := -1
    else
      result := 1;
end;

//------------------------------------------------------------------

var sl: TStringList;

procedure AddAndSort;
begin
  sl := TStringList.Create;
  sl.Add('a_1.xml');
  sl.Add('a_20.xml');
  sl.Add('a_10.xml');
  sl.Add('a_2.XML');
  sl.CustomSort(compare);
end;

Answer 4

几年前我用answer here写了这篇文章。它有点冗长，但它可以解决问题。

function GTSmartCompare(List: TStringList; Index1, Index2: Integer): Integer;

  procedure ExtractPart(var s: string; out Result: string; out Numbers: Boolean);
  var
    n: integer;
  begin
    Numbers := False;
    n := 1;
    while (s[n] in ['0'..'9']) and (n <= Length(s)) do
      Inc(n);

    { n > 1 if there were digits at the start of the string}
    if n > 1 then
    begin
      Result := Copy(s, 1, n - 1);
      Delete(s, 1, n - 1);
      Numbers := True;
    end
    else
    begin
      { No digits }
      n := 1;
      while (not (s[n] in ['0'..'9']) ) and (n <= Length(s)) do
        Inc(n);

      if n > 1 then
      begin
        Result := Copy(s, 1, n - 1);
        Delete(s, 1, n - 1);
      end
    end;
  end; //ExtractPart()


  function CompareNextPart(var s1, s2: string): Integer;
  var
    n1, n2: Boolean;
    p1, p2: string;
  begin
    { Extract the next part for comparison }
    ExtractPart(s1, p1, n1);
    ExtractPart(s2, p2, n2);

    { Both numbers? The do a numerical comparison, otherwise alfabetical }
    if n1 and n2 then
      Result := StrToInt(p1) - StrToInt(p2)
    else
      Result := StrIComp(PChar(p1), PChar(p2));
  end; //CompareNextPart()

var
  str1, str2, ext1, ext2: string;

begin
  Result := 0;
  { For 'normal' comparison
    str2 := List[Index1];
    str2 := List[Index2];
    For comparing file names }

  ext1 := ExtractFileExt(List[Index1]);
  ext2 := ExtractFileExt(List[Index2]);
  str1 := ChangeFileExt(List[Index1], '');
  str2 := ChangeFileExt(List[Index2], '');

  while (str1 <> '') and (str2 <> '') and (Result = 0) do
    Result := CompareNextPart(str1, str2);

  { Comparing found no numerical differences, so repeat with a 'normal' compare. }

  if Result = 0 then
    Result := StrIComp(PChar(List[Index1]), PChar(List[Index2]));

  { Still no differences? Compare file extensions. }

  if Result = 0 then
    Result := StrIComp(PChar(ext1), PChar(ext2));

end;

[编辑]

但大卫清醒时为何会烦恼。：p在我的辩护中，当时许多人没有Windows XP，这是引入StrCmpLogicalW的版本。

Delphi中的自定义排序方法对字符串列表进行排序

4 个答案: