Есть ли в Delphi чувствительная к регистру функция естественной сортировки?

Question

Я хочу заказать список строк с различными опциями. Варианты:

1. Сортировка по алфавиту или логическая сортировка
2. с учетом регистра или без учета регистра
3. по возрастанию или по убыванию

У меня есть все ветки, кроме:

С учетом регистра, Логическая сортировка.
(В значительной степени NatSort от php)

Теперь я пытаюсь найти функцию, которая делает то, что мне нужно.

Чтобы получить логический порядок без учета регистра, я реализовал вызов функции StrCmpLogicalW в shlwapi.dll

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

Однако я не могу найти регистрозависимый эквивалент StrCmpLogicalW.

Я скопировал функцию, которая казалась многообещающей, с другой онлайн-доски и поиграл с флагами.

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; 

От: 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")

UPDATE:

Я выполнил первое и очень простое решение для естественной сортировки с учетом регистра.

Причина, по которой я это делаю, заключается в том, что я хочу отсортировать Stringgrid по нескольким столбцам с разными параметрами для каждого указанного столбца.

Чтобы реализовать нацорт, я разбиваю строки на части символов и числовые части и сохраняю каждую часть в списке строк.

оба списка следуют шаблону («символьная часть», «числовая часть», «символьная часть», ... и т. Д.).

после разделения строк я сравниваю записи списка друг с другом. - числовые части вычитаются друг из друга (num1-num2) - для сравнения строк я использую CompareStr, а не AnsiCompareStr, поскольку он выдает тот же результат, что и функция php-natsort, с которой я связан выше.

если в любой момент результат сравнения отличается от 0, то дальнейшее сравнение не требуется, и я избегаю цикла.

На мой взгляд, решение еще не завершено, поскольку тема естественной сортировки очень широка, по крайней мере, распознавание отрицательных чисел все еще необходимо реализовать.

Как только я закончу, я опубликую свой код здесь для всех, кто хочет иметь возможность сортировки Stringgrids по нескольким столбцам и с различными опциями для каждого столбца, поскольку я пока не смог найти такой код в Интернете.

Я не могу полагаться на сторонние инструменты, такие как RegEx для этого. Моя главная точка отсчета в настоящее время эта ссылка:

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

Answer 1

Я закончил решение, которое может обрабатывать положительные и отрицательные числа Но не все функции natsort реализованы так, как вам нужно для решения Unicode, но этого должно быть достаточно для сортировки общего назначения.

Код:

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;

Не очень доволен всеми подпроцедурами, но каждый может сделать из этого то, что хочет.