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