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. |