I want to order a List of Strings with different Options. Options are:
- Alphabetical Sort or Logical Sort
- Case-Sensitive or not Case-Sensitive
- 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:
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.
来源：https://stackoverflow.com/questions/54078871/is-there-a-case-sensitive-natural-sorting-function-in-delphi