8

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

どんな助けでも大歓迎です。

4

4 に答える 4

21

Explorerが使用するのと同じ比較関数、つまりを使用できます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;
于 2013-03-06T20:52:36.500 に答える
7

正確な状況に合わせて調整された軽量ソリューションは次のとおりです。

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;
于 2013-03-06T20:58:26.577 に答える
2

AndreasRejbrandからの回答は大丈夫でした。ただし、この比較関数を一般的な用途に使用することをお勧めします。

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;
于 2015-09-26T17:35:25.260 に答える
1

私はここに答えとして数年前にこれを書きました。少し長いですが、うまくいきます。

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が導入されたバージョンです。

于 2013-03-06T20:57:17.107 に答える