Is there a Case-Sensitive Natural-Sorting-Function in Delphi?

Question

I want to order a List of Strings with different Options. Options are:

1. Alphabetical Sort or Logical Sort
2. Case-Sensitive or not Case-Sensitive
3. Ascending or Descending

I have all branches covered except for:

Case-Sensitive, Logical-Sort.
(Pretty much NatSort from php)

Now I am trying to find a Function that does what I need.

In order to get a not-case-sensitive logical order I implemented a call to the StrCmpLogicalW-Function in the shlwapi.dll

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

However, I can not find a Case-Sensitive equivalent to StrCmpLogicalW.

I have copied a function that seemed promising from another onlineboard and played around with the Flags.

Original-Function:

  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; 

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

I tried to remove the Ignore-Case flag, but to no avail.

This is what I want as a result: 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")

as opposed to: 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")

UPDATE:

I have completed a first and very simple solution for case-sensitive natural sorting.

The reason I'm doing this is because I want to sort a Stringgrid on multiple Columns with different options for each Column specified.

In order to realize the natsort I am dissecting the strings into character parts and numerical parts and store each part in a stringlist.

both lists follow the pattern ('character-part','Numerical part','Character part',... and so on).

after splitting the strings I compare the list entries with each other. - numerical-parts are subtracted from each other (num1-num2) - for string-comparison I use CompareStr as opposed to AnsiCompareStr since it produces the same output as the php-natsort-function I linked to above.

if, at any point, the result of the comparison is different from 0 then no further comparison is needed and I escape the loop.

In my view, the solution is not completed yet since the topic of natural sorting is very broad, at the very least recognizing negative numbers still needs to be implemented.

Once I'm finished I will post my Code here for anyone who wants to be able to sort Stringgrids on multiple Columns and with different options for each column, since I wasn't able to find such code online yet.

I can not rely on 3rd-Party tools like RegEx for this. My main point of reference is currently this link:

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

Answer 1

I finished a solution that can handle positive and negative numbers. But not all the natsort-features are implemented that you'd need for a Unicode solution, but it should suffice for a general purpose sorting.

Code:

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;

Not very happy about all the subprocedures but everyone can make of it what they want.