Author: Tomas Rutkauskas
How to sort a TStringList using the Quicksort algorithm
Answer:
Here is a complete example, which uses a rather tricky type case to gain access to
some private data of the TStringList. It does provide a method for you to use as
many custom sort routines as you like in one descendant class. One thing to note is
that only swaps pointers and not data so it is extremely fast even with 10000
entrys.
1 unit sslistu;
2
3 interface
4
5 uses
6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7 StdCtrls;
8
9 type
10 TForm1 = class(TForm)
11 Button1: TButton;
12 ListBox1: TListBox;
13 procedure Button1Click(Sender: TObject);
14 private
15 { Private declarations }
16 public
17 { Public declarations }
18 end;
19
20 var
21 Form1: TForm1;
22
23 implementation
24
25 {$R *.DFM}
26
27 type
28 TStringListCompare = function(var X, Y: TStringItem): integer;
29 TStringListCracker = class(TStrings)
30 private
31 FList: PStringItemList;
32 FCount: Integer;
33 FCapacity: Integer;
34 FSorted: Boolean;
35 end;
36
37 TcStringList = class(TStringList)
38 private
39 FListptr: PStringItemList;
40 procedure ExchangeItems(Index1, Index2: Integer);
41 procedure QuickSort(L, R: Integer; Compare: TStringListCompare);
42 procedure SetSorted(Value: Boolean);
43 public
44 procedure Sort(Compare: TStringListCompare); {Hide not Override}
45 end;
46
47 procedure TcStringList.SetSorted(Value: Boolean);
48 begin
49 if Sorted <> Value then
50 TStringListCracker(Self).FSorted := value;
51 end;
52
53 procedure TcStringList.ExchangeItems(Index1, Index2: Integer);
54 var
55 Temp: Integer;
56 Item1, Item2: PStringItem;
57 begin
58 Item1 := @FListPtr^[Index1];
59 Item2 := @FListPtr^[Index2];
60 Temp := Integer(Item1^.FString);
61 Integer(Item1^.FString) := Integer(Item2^.FString);
62 Integer(Item2^.FString) := Temp;
63 Temp := Integer(Item1^.FObject);
64 Integer(Item1^.FObject) := Integer(Item2^.FObject);
65 Integer(Item2^.FObject) := Temp;
66 end;
67
68 procedure TcStringList.QuickSort(L, R: Integer; Compare: TStringListCompare);
69 var
70 I, J: Integer;
71 P: TStringItem;
72 begin
73 repeat
74 I := L;
75 J := R;
76 P := FListPtr^[(L + R) shr 1];
77 repeat
78 while Compare(FListPtr^[I], P) < 0 do
79 Inc(I);
80 while Compare(FListPtr^[J], P) > 0 do
81 Dec(J);
82 if I <= J then
83 begin
84 ExchangeItems(I, J);
85 Inc(I);
86 Dec(J);
87 end;
88 until
89 I > J;
90 if L < J then
91 QuickSort(L, J, Compare);
92 L := I;
93 until
94 I >= R;
95 end;
96
97 procedure TcStringList.Sort(Compare: TStringListCompare);
98 begin
99 {trick to gain access to private data}
100 FListptr := TStringListCracker(Self).FList;
101 QuickSort(0, Count - 1, Compare);
102 end;
103
104 function Example1(var X, Y: TStringItem): integer;
105 begin
106 Result := CompareStr(X.FString, Y.FString);
107 end;
108
109 function Example2(var X, Y: TStringItem): integer;
110 begin
111 Result := CompareStr(copy(X.FString, 2, 5), copy(Y.FString, 2, 5));
112 end;
113
114 function Example3(var X, Y: TStringItem): integer;
115 begin
116 if integer(X.FObject) > integer(Y.FObject) then
117 result := 1
118 else if integer(X.FObject) < integer(Y.FObject) then
119 result := -1
120 else
121 result := 0;
122 end;
123
124 procedure TForm1.Button1Click(Sender: TObject);
125 var
126 fSList: TcStringList;
127 I, J, K, L: integer;
128 s: string;
129 begin
130 fSList := TcStringList.create;
131 for I := 0 to 10000 do
132 begin
133 s := '';
134 for K := 10 to Random(20) + 10 do
135 s := s + char(random(26) + 65);
136 L := random(20000);
137 fSList.addobject(s, pointer(L));
138 end;
139 listbox1.items.add('Sorting');
140 application.processmessages;
141 fSList.addobject('Dennis', pointer(10000));
142 fSList.Sorted := false; {disable default Sort}
143 fSList.Sort(Example1); {replacement Alpha sort}
144 fSList.Sorted := true; {enable Binary searching}
145 listbox1.items.add('Done');
146 application.processmessages;
147 {if ByStringPosdata then
148 fSList.Sort(Example2);
149 if ByObjectValue then
150 fSList.Sort(Example3);}
151 listbox1.items.assign(fSList);
152 showmessage('Dennis is at line number #' + inttostr(fSList.Indexof('Dennis')));
153 fSList.free;
154 end;
155
156 end.
|