delphi - Delphi中有区分大小写的自然排序函数吗？

Question

我想订购具有不同选项的字符串列表。选项有:

1. 按字母顺序排序或逻辑排序
2. 区分大小写或不区分大小写
3. 升序或降序

我涵盖了所有分支，除了:

区分大小写，逻辑排序。
(几乎来自 php 的 NatSort)

现在我正在尝试找到一个可以满足我需要的函数。

为了获得不区分大小写的逻辑顺序，我在 shlwapi.dll 中实现了对 StrCmpLogicalW-Function 的调用

https://learn.microsoft.com/en-us/windows/desktop/api/shlwapi/nf-shlwapi-strcmplogicalw

但是，我找不到与 StrCmpLogicalW 等效的区分大小写的内容。

我从另一个在线板上复制了一个看起来很有前途的功能，并使用了 Flags。

原始功能:

  function NatCompareText(const S1, S2: WideString): Integer;
  begin
    SetLastError(0);
    Result:=CompareStringW(LOCALE_USER_DEFAULT,
                           NORM_IGNORECASE or
                           NORM_IGNORENONSPACE or
                           NORM_IGNORESYMBOLS,
                           PWideChar(S1),
                           Length(S1),
                           PWideChar(S2),
                           Length(S2)) - 2;
    case GetLastError of
      0: ;
      //some ErrorCode-Handling
    else
      RaiseLastOSError;
    end;
  end; 

来自: https://www.delphipraxis.net/29910-natuerliche-sortierungen-von-strings.html

我尝试删除 Ignore-Case 标志，但无济于事。

这就是我想要的结果: http://php.fnlist.com/array/natsort

   Input:   array("Img12.png", "iMg10.png", "Img2.png", "Img1.png")
   Output:  array("Img1.png", "Img2.png", "Img12.png", "iMg10.png")

相对于: http://php.fnlist.com/array/natcasesort

   Input:   array("Img12.png", "iMg10.png", "Img2.png", "Img1.png")
   Output:  array("Img1.png", "Img2.png", "iMg10.png", "Img12.png")

更新:

我已经完成了第一个非常简单的区分大小写自然排序的解决方案。

我这样做的原因是因为我想对多个列上的 Stringgrid 进行排序，并为每个指定的列使用不同的选项。

为了实现 natsort，我将字符串分解为字符部分和数字部分，并将每个部分存储在字符串列表中。

两个列表都遵循模式(“字符部分”、“数字部分”、“字符部分”...等等)。

分割字符串后，我将列表条目相互比较。- 数字部分相互减去(num1-num2)- 对于字符串比较，我使用 CompareStr 而不是 AnsiCompareStr，因为它产生与上面链接的 php-natsort-function 相同的输出。

如果在任何时候，比较结果不同于 0，则不需要进一步比较，并且我会退出循环。

在我看来，解决方案还没有完成，因为自然排序的主题非常广泛，至少仍然需要实现识别负数。

一旦我完成，我将在这里发布我的代码，供任何希望能够在多个列上对 Stringgrids 进行排序并为每列提供不同选项的人，因为我还无法在网上找到这样的代码。

我不能依赖 RegEx 等第三方工具来实现此目的。目前我的主要引用点是这个链接:

https://natsort.readthedocs.io/en/master/howitworks.html

Answer 1

我完成了一个可以处理正数和负数的解决方案。但并非所有 Unicode 解决方案所需的 natsort 功能都已实现，但它应该足以满足通用排序的需要。

代码:

unit MySortUnit;

interface
uses
  Grids
  ,System
  ,Classes
  ,Windows
  ,SysUtils;

type
  TSortOrder=(soAscending,soDescending);     
  TSortOption=record                         
    SortOrder:TSortOrder;  //Determines SortOrder in a TSortOption-Record, can be replaced with a Boolean, but I prefer Enums
    CaseSensitive:Boolean;
    SortLogical:Boolean;
  end;
  TSortOptions=Array of TSortOption;


procedure SortGridByColumns(Grid:TStringGrid; Columns:array of Integer; Options:TSortOptions);

implementation

type TMoveSG=class(TCustomGrid);                                            //Deriving the TCustomGrid grants access to "StringGrid.MoveRow(..)".
procedure SortGridByColumns(Grid:TStringGrid; Columns:array of Integer; Options:TSortOptions);
type
  TshlwapiStrCmpLogicalW=function(psz1, psz2: PWideChar):Integer; stdcall;  //Declare new Functiontype so I can use variables of that type, naming-convention T+{Dll-Name}+{Procedure-Name in DLL}
var
  i,j:Integer;
  InternalColumns:Array of Integer;
  InternalOptions:TSortOptions;
  Sorted:Boolean;
  shlwapi:HMODULE;
  StrCmpLogicalW:TshlwapiStrCmpLogicalW;  //Get Procedure from DLL at runtime

////////////////////////////////////////////////////////////////////////////////
  function StringCompareLogicalCaseInsensitiveASC(const String1,String2:String):Integer;
  begin
    Result:=StrCmpLogicalW(PWideChar(WideString(String1)),PWideChar(WideString(String2)));
  end;

  function StringCompareLogicalCaseInsensitiveDESC(const String1,String2:String):Integer;
  begin
    Result:=-1*StrCmpLogicalW(PWideChar(WideString(String1)),PWideChar(WideString(String2)));
  end;


  function StringCompareCaseInsensitiveASC(const String1,String2:String):Integer;
  begin
    Result:=AnsiCompareText(String1,String2);
  end;

  function StringCompareCaseInsensitiveDESC(const String1,String2:String):Integer;
  begin
    Result:=-1*AnsiCompareText(String1,String2);
  end;




  function StringCompareCaseSensitiveASC(const String1,String2:String):Integer;
  begin
    Result:=AnsiCompareStr(String1,String2);
  end;

  function StringCompareCaseSensitiveDESC(const String1,String2:String):Integer;
  begin
    Result:=-1*AnsiCompareStr(String1,String2);
  end;


  function StringCompareLogicalCaseSensitiveASC(const String1,String2:String):Integer;
  const
    Digits:set of char=['0'..'9'];
    Signs:set of char=['-','+'];
  var
    i,l1,l2:Integer;
    ASign,c:Char;
    Int1,Int2:Integer;
    sl1,sl2:TStringList;
    s:String;
  begin
    l1:=length(String1);
    l2:=length(String2);

    sl1:=TStringList.Create();
    sl2:=TStringList.Create();
    try
      for i:=1 to l1 do
      begin
        c:=String1[i];

        if (c in Digits) and (sl1.Count=0) then
        begin
          sl1.Add('');
          sl1.Add(c);
        end
        else if not(c in Digits) and (sl1.Count=0) then sl1.Add(c)
        else
        begin

          if c in Digits then
          begin
            s:=sl1[sl1.Count-1];
            if s[length(s)] in Signs then
            begin
              ASign:=s[length(s)];
              Delete(s,length(s),1);
            end
            else ASign:=#0;

            if TryStrToInt(sl1[sl1.Count-1],Int1)=True then sl1[sl1.Count-1]:=sl1[sl1.Count-1]+c
            else
            begin
              sl1[sl1.Count-1]:=s;
              if ASign=#0 then sl1.Add(c) else sl1.Add(ASign+c);
            end;
          end
          else
          begin
            if TryStrToInt(sl1[sl1.Count-1],Int1)=false then sl1[sl1.Count-1]:=sl1[sl1.Count-1]+c else sl1.Add(c)
          end;
        end;
      end;

      for i:=1 to l2 do
      begin
        c:=String2[i];

        if (c in Digits) and (sl2.Count=0) then
        begin
          sl2.Add('');
          sl2.Add(c);
        end
        else if not(c in Digits) and (sl2.Count=0) then sl2.Add(c)
        else
        begin

          if c in Digits then
          begin
            s:=sl2[sl2.Count-1];
            if s[length(s)] in Signs then
            begin
              ASign:=s[length(s)];
              Delete(s,length(s),1);
            end
            else ASign:=#0;

            if TryStrToInt(sl2[sl2.Count-1],Int1)=True then sl2[sl2.Count-1]:=sl2[sl2.Count-1]+c
            else
            begin
              sl2[sl2.Count-1]:=s;
              if ASign=#0 then sl2.Add(c) else sl2.Add(ASign+c);
            end;
          end
          else
          begin
            if TryStrToInt(sl2[sl2.Count-1],Int1)=false then sl2[sl2.Count-1]:=sl2[sl2.Count-1]+c else sl2.Add(c)
          end;
        end;
      end;

      for i:=0 to Min(sl1.Count,sl2.Count)-1 do
      begin
        if (TryStrToInt(sl1[i],Int1)=True) and (TryStrToInt(sl2[i],Int2)=True)
        then Result:=Int1-Int2
        else Result:=CompareStr(sl1[i],sl2[i]);

        if Result<>0 then break;
      end;
    finally
      sl1.Free();
      sl2.Free();
    end;
  end;

  function StringCompareLogicalCaseSensitiveDESC(const String1,String2:String):Integer;
  begin
    Result:=-1*StringCompareLogicalCaseSensitiveASC(String1,String2);
  end;
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
  //Determines the Sorting-Function based on the Option provided and returns its result
  function ExecuteSortLogic(StringRow1,StringRow2:String; ColumOption:TSortOption):Integer;
  begin
    if ColumOption.SortLogical=true then                                        //recognize Numbers in String as numbers?
    begin
      if ColumOption.CaseSensitive=True then                                    //Does Case-Sensitivity matter?
      begin
        if ColumOption.SortOrder=soAscending                                    //Do you want to order ascending or descending?
        then Result:=StringCompareLogicalCaseSensitiveASC(StringRow1,StringRow2)
        else Result:=StringCompareLogicalCaseSensitiveDESC(StringRow1,StringRow2);
      end
      else
      begin
        if ColumOption.SortOrder=soAscending
        then Result:=StringCompareLogicalCaseInsensitiveASC(StringRow1,StringRow2)
        else Result:=StringCompareLogicalCaseInsensitiveDESC(StringRow1,StringRow2);
      end;
    end
    else
    begin
      if ColumOption.CaseSensitive=True then
      begin
        if ColumOption.SortOrder=soAscending
        then Result:=StringCompareCaseSensitiveASC(StringRow1,StringRow2)
        else Result:=StringCompareCaseSensitiveDESC(StringRow1,StringRow2)
      end
      else
      begin
        if ColumOption.SortOrder=soAscending
        then Result:=StringCompareCaseInsensitiveASC(StringRow1,StringRow2)
        else Result:=StringCompareCaseInsensitiveDESC(StringRow1,StringRow2);
      end;
    end;
  end;

  //The Sort-Controller-Functions, shifts through the passed columns and sorts as long as Result=0 and the final column of the columns array has not been exceeded
  function Sort(Row1,Row2:Integer; SortOptions:TSortOptions):Integer;
  var
    C:Integer;
  begin
    C:=0;
    Result:=ExecuteSortLogic(Grid.Cols[InternalColumns[C]][Row1],Grid.Cols[InternalColumns[C]][Row2],Options[C]);
    if Result=0 then
    begin
      Inc(C);
      while (C<=High(InternalColumns)) and (Result=0) do
      begin
        Result:=ExecuteSortLogic(Grid.Cols[InternalColumns[C]][Row1],Grid.Cols[InternalColumns[C]][Row2],Options[C]);
        Inc(C);
      end;
    end;
  end;
////////////////////////////////////////////////////////////////////////////////
  //A function to determine if AnInt is already in AnArray, necessary to weed out duplicate Columns
  function IsIntegerInArray(AnInt:Integer; AnArray:Array of Integer):Boolean;
  var
    i:Integer;
  begin
    Result:=false;
    for i:=0 to High(AnArray) do
    begin
      Result:=(AnArray[i]=AnInt);
      if Result=True then break;
    end;
  end;
////////////////////////////////////////////////////////////////////////////////
begin
  //no columns? no Sorting!
  if length(columns)=0 then exit;

  //Load External Windows Library, shlwapi.dll functions may change in the future
  shlwapi:=LoadLibrary('shlwapi.dll');
  try
    if shlwapi<>0 then  //Loading of Library successfull?
    begin
      @StrCmpLogicalW:=GetProcAddress(shlwapi,'StrCmpLogicalW'); //Load Function from the DLL
      if (@StrCmpLogicalW=nil) then exit;  //Loading of Function successfull?
    end
    else exit;

    //Check that every element inside the Columns-Array has a corresponding TSortOption-Record, if "Options" is shorter than "Columns", default-options are supplied, if "Options" is longer than "columns", we cut them off
    if High(Columns)>High(Options) then
    begin
      i:=length(Options);
      setLength(Options,length(Columns));
      for j:=i to High(Options) do
      begin
        Options[i].SortOrder:=soAscending;
        Options[i].CaseSensitive:=false;
        Options[i].SortLogical:=false;
      end;
    end
    else if High(Columns)<High(Options) then
    begin
      setLength(Options,length(Columns));
    end;
    ///////////////////////////////////////////////////////////////////

    //We remove duplicate and invalid Columns and their corresponding TSortOption-record
    for i:=0 to High(Columns) do
    begin
      if (Columns[i]>=0) and (Columns[i]<Grid.ColCount) then                    //Iss column inside the Column-Range?
      begin
        if (IsIntegerInArray(Columns[i],InternalColumns)=false) then //Add each column only once           
        begin
          setLength(InternalColumns,length(InternalColumns)+1);
          setLength(InternalOptions,length(InternalOptions)+1);
          InternalColumns[High(InternalColumns)]:=Columns[i];
          InternalOptions[High(InternalOptions)]:=Options[i];
        end;
      end;
    end;
    ///////////////////////////////////////////////////////////////////

    //Make sure the freshly created InternalColumns does neither exceed ColCount nor fall below 1, if length=0 then exit
    if (High(InternalColumns)>Grid.ColCount-1) then setLength(InternalColumns,Grid.ColCount)
    else if (length(InternalColumns)=0) then exit;

    //Translating InternalOptions back into Options so I don't have to write the functions with InternalOptions, the same does not work for InternalColumns for some reason
    SetLength(Options,length(InternalColumns));
    for i:=0 to High(InternalColumns) do Options[i]:=InternalOptions[i];

    j:=0;    //secondary termination condition, should not be necessary
    repeat
      Inc(j);
      Sorted:=True;  //Main termination condition

      for i:=Grid.FixedRows to Grid.RowCount-2 do   //Start at row "FixedRows" since FixedRows nicht bewegt werden können und die Eigenschaft nur Werte >=0 haben kann.
      begin
        if Sort(i,i+1,Options)>0 then               //Schaut ob Reihe i>als Reihe i+1 ist, falls ja muss i an die Stelle i+1 verschoben werden, das Grid ist also noch nicht sortiert.
        begin
          TMoveSG(Grid).MoveRow(i+1,i);
          Sorted:=False;
        end;
      end;
    until Sorted or (j=1000);
  finally
    Grid.Repaint;
    if shlwapi<>0 then FreeLibrary(shlwapi);        //Speicher freigeben
    @StrCmpLogicalW:=nil;
  end;
end;

对所有子过程不是很满意，但每个人都可以按照自己的意愿进行操作。