Details | Last modification | View Log | RSS feed
| Rev | Author | Line No. | Line |
|---|---|---|---|
| 232 | daniel-mar | 1 | unit SortStrings; |
| 2 | |||
| 3 | interface |
||
| 4 | |||
| 5 | uses Classes; |
||
| 6 | |||
| 7 | procedure SortSL(sl: TStrings); |
||
| 8 | |||
| 9 | implementation |
||
| 10 | |||
| 11 | uses |
||
| 12 | Math; |
||
| 13 | |||
| 14 | function CompareStr(Str1,Str2: string):Integer; // Source: https://www.experts-exchange.com/questions/23086281/Natural-Order-String-Sort-Compare-in-Delphi.html |
||
| 15 | var Num1,Num2:Double; |
||
| 16 | pStr1,pStr2:PChar; |
||
| 17 | Function IsNumber(ch:Char):Boolean; |
||
| 18 | begin |
||
| 19 | Result:=ch in ['0'..'9']; |
||
| 20 | end; |
||
| 21 | Function GetNumber(var pch:PChar):Double; |
||
| 22 | var FoundPeriod:Boolean; |
||
| 23 | Count:Integer; |
||
| 24 | begin |
||
| 25 | FoundPeriod:=False; |
||
| 26 | Result:=0; |
||
| 27 | While (pch^<>#0) and (IsNumber(pch^) or ((not FoundPeriod) and (pch^='.'))) do |
||
| 28 | begin |
||
| 29 | if pch^='.' then |
||
| 30 | begin |
||
| 31 | FoundPeriod:=True; |
||
| 32 | Count:=0; |
||
| 33 | end |
||
| 34 | else |
||
| 35 | begin |
||
| 36 | if FoundPeriod then |
||
| 37 | begin |
||
| 38 | Inc(Count); |
||
| 39 | Result:=Result+(ord(pch^)-ord('0'))*Power(10,-Count); |
||
| 40 | end |
||
| 41 | else Result:=Result*10+ord(pch^)-ord('0'); |
||
| 42 | end; |
||
| 43 | Inc(pch); |
||
| 44 | end; |
||
| 45 | end; |
||
| 46 | begin |
||
| 47 | pStr1:=@Str1[1]; pStr2:=@Str2[1]; |
||
| 48 | Result:=0; |
||
| 49 | While not ((pStr1^=#0) or (pStr2^=#0)) do |
||
| 50 | begin |
||
| 51 | if IsNumber(pStr1^) and IsNumber(pStr2^) then |
||
| 52 | begin |
||
| 53 | Num1:=GetNumber(pStr1); Num2:=GetNumber(pStr2); |
||
| 54 | if Num1<Num2 then Result:=-1 |
||
| 55 | else if Num1>Num2 then Result:=1; |
||
| 56 | Dec(pStr1);Dec(pStr2); |
||
| 57 | end |
||
| 58 | else if pStr1^<>pStr2^ then |
||
| 59 | begin |
||
| 60 | if pStr1^<pStr2^ then Result:=-1 else Result:=1; |
||
| 61 | end; |
||
| 62 | if Result<>0 then Break; |
||
| 63 | Inc(pStr1); Inc(pStr2); |
||
| 64 | end; |
||
| 65 | Num1:=length(Str1); Num2:= length(Str2); |
||
| 66 | if (Result=0) and (Num1<>Num2) then |
||
| 67 | begin |
||
| 68 | if Num1<Num2 then Result:=-1 else Result:=1; |
||
| 69 | end; |
||
| 70 | end; |
||
| 71 | |||
| 72 | function BubbleSort( list: TStrings ): TStrings; // Source: https://delphi.fandom.com/wiki/Bubble_sort |
||
| 73 | var |
||
| 74 | i, j: Integer; |
||
| 75 | temp: string; |
||
| 76 | begin |
||
| 77 | for i := 0 to list.Count - 1 do begin |
||
| 78 | for j := 0 to ( list.Count - 1 ) - i do begin |
||
| 79 | // Condition to handle i=0 & j = 9. j+1 tries to access x[10] which |
||
| 80 | // is not there in zero based array |
||
| 81 | if ( j + 1 = list.Count ) then |
||
| 82 | continue; |
||
| 83 | if CompareStr(list.Strings[j], list.Strings[j+1]) > 0 then |
||
| 84 | begin |
||
| 85 | temp := list.Strings[j]; |
||
| 86 | list.Strings[j] := list.Strings[j+1]; |
||
| 87 | list.Strings[j+1] := temp; |
||
| 88 | end; // endif |
||
| 89 | end; // endwhile |
||
| 90 | end; // endwhile |
||
| 91 | Result := list; |
||
| 92 | end; |
||
| 93 | |||
| 94 | procedure SortSL(sl: TStrings); |
||
| 95 | var |
||
| 96 | sl2: TStringList; |
||
| 97 | begin |
||
| 98 | if sl.Count > 1 then |
||
| 99 | begin |
||
| 100 | sl2 := TStringList.Create; |
||
| 101 | sl2.Assign(BubbleSort(sl)); |
||
| 102 | sl2.Assign(sl); |
||
| 103 | sl2.Free; |
||
| 104 | end; |
||
| 105 | end; |
||
| 106 | |||
| 107 | end. |