function NaturalCompareStringUTF8(Str1, Str2: string): integer;
var
Num1, Num2 :Double;
pStr1, pStr2 :PChar;
Len1, Len2 :integer;
UTF8Char1, UTF8Char2 :string;
lang :string = '';
function RemoveDiacritics(const S: string): string;
// by SilvioProg
var
F: Boolean;
I: SizeInt;
PS, PD: PChar;
begin
SetLength(Result, Length(S));
PS := PChar(S);
PD := PChar(Result);
I := 0;
while PS^ <> #0 do
begin
F := PS^ = #195;
if F then
case PS[1] of
#128..#132: PD^ := #65;
#135: PD^ := #67; // letter Ç
#136..#139: PD^ := #69;
#140..#143: PD^ := #73;
#145: PD^ := #78; // letter Ñ
#146..#150: PD^ := #79;
#153..#156: PD^ := #85;
#157: PD^ := #89;
#160..#164: PD^ := #97;
#167: PD^ := #99; // letter ç
#168..#171: PD^ := #101;
#172..#175: PD^ := #105;
#177: PD^ := #110;
#178..#182: PD^ := #111; // letter o
#185..#188: PD^ := #117;
#189..#191: PD^ := #121;
else
F := False;
end;
if F then
Inc(PS)
else
PD^ := PS^;
Inc(I);
Inc(PD);
Inc(PS);
end;
SetLength(Result, I);
end;
function IsNumber(ch :Char): Boolean;
begin
Result := ch in ['0'..'9'];
end;
function GetNumber(var pch: PChar;var Len: Integer): Double;
var FoundPeriod:Boolean;
Count:Integer;
begin
FoundPeriod := False;
Result := 0;
While (pch^ <> #0) and
(IsNumber(pch^) or ((not FoundPeriod) and (pch^ = '.'))) do
begin
if pch^ = '.' then
begin
FoundPeriod := True;
Count := 0;
end
else
begin
if FoundPeriod then
begin
Inc(Count);
Result := Result + (ord(pch^) -ord('0'))*Power(10, -Count);
end
else Result := Result * 10 + ord(pch^) -ord('0');
end;
inc(Len);
Inc(pch);
end;
end;
begin
if (Str1<>'') and (Str2<>'') then
begin
pStr1 := @Str1[1];
pStr2 := @Str2[1];
Result := 0;
while not ((pStr1^ = #0) or (pStr2^ = #0)) do
begin
Len1:=0; Len2:=0;
while (pStr1^=' ') do
begin
Inc(pStr1);
Inc(Len1)
end;
while (pStr2^=' ') do
begin
Inc(pStr2);
Inc(Len2)
end;
if IsNumber(pStr1^) and IsNumber(pStr2^) then
begin
Num1 := GetNumber(pStr1, Len1);
Num2 := GetNumber(pStr2, Len2);
if Num1 < Num2 then Result := -1
else if Num1 > Num2 then Result := 1
else begin
if Len1 < Len2 then Result := -1
else if Len1 > Len2 then Result := 1;
end;
Dec(pStr1);
Dec(pStr2);
end
else
begin
// UTF8 chars
{$IFDEF WINDOWS}
if CodePage = 1252 then
{$ELSE}
{$IFDEF LINUX}
if Length(CodePageString) > 1 then
lang := CodePageString[1] + CodePageString[2];
if (lang = 'pt') or (lang = 'es') or (lang = 'fr') or (lang = 'it')
or (lang = 'gl' {galician}) or (lang = 'gn' {guarani})
or (lang = 'ay' {aymará}) then
{$ENDIF}
{$ENDIF}
begin
UTF8Char1 := RemoveDiacritics(UTF8Copy(pStr1, 1, 1));
UTF8Char2 := RemoveDiacritics(UTF8Copy(pStr2, 1, 1));
end
else
begin
UTF8Char1 := UTF8Copy(pStr1, 1, 1);
UTF8Char2 := UTF8Copy(pStr2, 1, 1);
end;
if UTF8Char1 <> UTF8Char2 then
if UTF8Char1 < UTF8Char2 then
Result := -1
else if UTF8Char1 > UTF8Char2 then
Result := 1;
end;
if Result <> 0 then Break;
Inc(pStr1);
Inc(pStr2);
end;
end;
Num1 := Length(Str1);
Num2 := Length(Str2);
if (Result = 0) and (Num1 <> Num2) then
begin
if Num1 < Num2 then Result := -1
else Result := 1;
end;
end;
Recent
