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://learn.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

Ki

This question has a windows-xp tag? :O – Brien

@Brien had a windows-xp tag. – Hyperaemia

If it weren't Delphi 7 - more recent versions of Delphi have TStringHelper.Compare taking TCompareOptions with f.i. coDigitAsNumbers, coIgnoreCase and some others. – Prokopyevsk

What about a flag like SORT_DIGITSASNUMBERS and removing the NORM_IGNORECASE? Not sure if these work properly in XP, though. – Meritocracy

Maybe you can write a compare function that first calls StrCmpLogicalW to apply the natural sorting, and if the result is that the strings are equal according to this comparison, call a second, case sensitive comparison method that doesn't have natural sorting. It may give undesired results when on a specific string position in both strings are different diacritics of the same character and having a different case, but those exceptional cases aside, this should get you very close to what you want. – Heall

@RudyVelthuis I tried to find "SORT_DIGITSASNUMBERS" as a flag but haven't found it. After that I noticed that the value of the flags goes 1,2,4,8 and so forth and I just tried to add 256 to the flags, didn't help either. – Ki

@Viktor: they are probably new and not in Windows.pas for your Delphi version yet. You can of course translate them yourself (the value is $0008), after downloading the appropriate SDK. But I doubt it works in XP anyway. So you'll probably have to find a 3rd party solution. No big help from the OS, I guess. – Meritocracy

SORT_DIGITSASNUMBERS was new in Windows Vista (or Windows 7), AFAIK. – Meritocracy

I don't seem to be able to make StringCompareW ignore the case. It always sorts 'iMG10.png' < 'Img12.png', even if the NORM_IGNORECASE flag is not used. – Meritocracy

@Rudy Velthuis, I could try GolezTrol suggestion. I'm not very familiar with the fringe-cases he mentioned but I guess I could do a case-insensitive comparison first and every time the comparison returns 0, I iterate through all the letters and compare the difference between Ordinal-Values. – Ki

@Heall Tried that, the problem is that "iMG10" and "img12" are already different strings. StrCmpLogicalW therefore returns -1. Your suggestion could work when "iMg10" and "IMG10" were to be compared. – Ki

@Viktor: I would probably write a function for this myself. Should be doable. – Meritocracy

@RudyVelthuis I have written a function now, however, the natural sorting-topic is much more complex than I first anticipated. For now it works very simplistic. I still need to cover a lot of cases like signed numbers, real numbers, diacritics, filepaths, unicode-normalization, number abbreviations, locale-charactersets and so on. Most of which will most likely never be needed, but it would be nice to return to the code someday and fix it up when needed without much hassle, the whole thing could become so big that it would warrant it's own unit. – Ki

@Viktor: very good. Kudos! I don't think real numbers are necessary though. Only sequences of digits 0..9. – Meritocracy

@RudyVelthuis I edited the post to include my complete Code, in case you were interested – Ki

@Viktor: thanks, very interesting. – Meritocracy

Adding the solution to the question is inappropriate. If you want to share the solution with others, write an answer in the space below to do so - see Can I answer my own question?. I'll give you some time to copy and paste your text into an answer before I roll back your edit. – Lunalunacy

After allowing 8 hours for you to remove the solution and write an answer instead, I've rolled back your edit to remove the problem solution. – Lunalunacy

function StrCmpLogicalW(psz1, psz2: PWideChar): Integer; stdcall; external 'shlwapi.dll'; { Natural compare two filenames. Digits in the strings are considered as numerical content rather than text. This test is not case-sensitive. Use it like this: StrCmpLogicalW(PChar(s1), PChar(s2)); see: #1025015 } – Gmt

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.

Ki