Articles   Members Online:
-Article/Tip Search
-News Group Search over 21 Million news group articles.
-Delphi/Pascal
-CBuilder/C++
-C#Builder/C#
-JBuilder/Java
-Kylix
Member Area
-Home
-Account Center
-Top 10 NEW!!
-Submit Article/Tip
-Forums Upgraded!!
-My Articles
-Edit Information
-Login/Logout
-Become a Member
-Why sign up!
-Newsletter
-Chat Online!
-Indexes NEW!!
Employment
-Build your resume
-Find a job
-Post a job
-Resume Search
Contacts
-Contacts
-Feedbacks
-Link to us
-Privacy/Disclaimer
Embarcadero
Visit Embarcadero
Embarcadero Community
JEDI
Links
How to sort a TStringList using the Quicksort algorithm Turn on/off line numbers in source code. Switch to Orginial background IDE or DSP color Comment or reply to this aritlce/tip for discussion. Bookmark this article to my favorite article(s). Print this article
27-Aug-02
Category
Object Pascal-Strings
Language
Delphi 2.x
Views
85
User Rating
No Votes
# Votes
0
Replies
0
Publisher:
DSP, Administrator
Reference URL:
DKB
			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.


			
Vote: How useful do you find this Article/Tip?
Bad Excellent
1 2 3 4 5 6 7 8 9 10

 

Advertisement
Share this page
Advertisement
Download from Google

Copyright © Mendozi Enterprises LLC