德尔福是否存在区分大小写的自然排序功能?

时间:2019-01-07 17:14:28

标签: delphi delphi-7 case-sensitive natural-sort

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

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

我覆盖了所有分支机构,除了:

区分大小写,逻辑排序。
(相当多来自php的NatSort)

现在,我正试图找到一个满足我需要的功能。

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

https://docs.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

我试图删除“忽略大小写”标志,但无济于事。

这就是我想要的结果:        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

1 个答案:

答案 0 :(得分:2)

我完成了一个可以处理正数和负数的解决方案。但是,并非所有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;

对所有子过程都不是很满意,但是每个人都可以按照自己的意愿来做。