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
TString Super Sort Class (Descending,Ignore Case and other) 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
01-Nov-02
Category
Object Pascal-Strings
Language
Delphi 5.x
Views
155
User Rating
No Votes
# Votes
0
Replies
0
Publisher:
DSP, Administrator
Reference URL:
DKB
			Author: Mike Heydon

TStringList has a Sort method and a Sorted property. This feature is not available 
in it's useful descendant TStrings. This class allows sorting of TString objects 
with extra functionality ala UNIX style parameters. (Yes I know UNIX is a four 
letter word but they do have some neat features). The SORT algorythm utilizes the 
QUICK SORT method.

Answer:

The features I have implemented are

  Options
    SORT DESCENDING                  				- srtDescending
    TREAT SORT FIELD AS NUMERIC      	- srtEvalNumeric
    IGNORE LEADING BLANKS IN FIELD  	- srtIgnoreBlank
    IGNORE CASE OF FIELD             				- srtIgnoreCase

  Switches
    -k Start,End position of substring for search
    -f Field number of a delimited string (Zero column based)
    -d Character delimiter for -f switch (Default = SPACE)

In it's simplest form it just sorts the TStrings ascending
eg.  SuperSort.SortStrings(Memo1.Lines,[]);

Assume a semi-colon delimited list like ..
    'Mike;34;Green'
    'harry;25;Red'
    'Jackie;6;Black'
    'Bazil;9,Pink'
    'john;52;Blue'

To sort this list DESCENDING on AGE (Field 1) and ignore case
     SuperSort(MyStrings, ['-f 1','-d ;'], 
[srtDescending,srtEvalNumeric,srtIgnoreCase]);

Assume a string list of ...
    '1999 12 20 AA432 Comment 1'
    '2002 10 12 SWA12 Some other words'
    '1998 09 11 BDS65 And so on and so on'

To sort this list on ITEM CODE (Positions 12 to 17) with no options
     SuperSort(MyStrings,['-k 12,17']);


Methods :
1   
2   procedure SortStrings(StringList : TStrings;  Switches : array of string;  
3                                        Options : TSuperSortOptionSet = []);
4   
5      Switches is a string array of -k,-d and -f settings. if it is set to empty array 
6   [] then NO switches are active.
7   
8      Options is an OPTIONAL set of 
9   [srtDescending,srtIgnoreCase,srtIgnoreBlank,srtEvalNumeric]
10     The default is empty set []
11  
12  //Properties :
13  
14  SortTime : TDateTime;
15  
16    // Returns the time taken for the sort for stats purposes.
17  
18  //Usage Example :
19  
20  uses SuperSort;
21  
22  procedure TForm1.Test;
23  var
24    Srt: TSuperSort
25  begin
26    Srt := TSuperSort.Create;
27    Srt.SortStrings(Memo1.Lines, [], [srtIgnoreBlank]);
28    Label1.Caption := 'Time : ' + FormatDateTine('hh:nn:ss:zzz',Srt.SortTime);
29    Srt.Free;
30  end;
31  
32  unit TSuperSort:
33  
34  unit SuperSort;
35  interface
36  uses Classes, SysUtils;
37  
38  // =============================================================================
39  // Class TSuperSort
40  // Mike Heydon Nov 2002
41  //
42  // Sort class that implements Unix style sorts including ..
43  //
44  // SWITCHES
45  // --------
46  // -k [StartPos,EndPos]  - Keyfield to sort on. Start and End pos in string
47  // -d [Field Delimiter]  - Delimter to use with -f switch. default = SPACE
48  // -f [FieldNumber]      - Zero based field number delimeted by -d
49  //
50  // OPTIONS SET
51  // ============
52  // srtDescending         - Sort descending
53  // srtIgnoreCase         - Ignore case when sorting
54  // srtIgnoreBlank        - Ignore leading blanks
55  // srtEvalNumeric        - Treat sort items as NUMERIC
56  //
57  // =============================================================================
58  
59  type
60    // Sort Options
61    TSuperSortOptions = (srtDescending, srtIgnoreCase,
62      srtIgnoreBlank, srtEvalNumeric);
63    TSuperSortOptionSet = set of TSuperSortOptions;
64  
65    // ============
66    // TSuperSort
67    // ============
68    TSuperSort = class(TObject)
69    protected
70      function GetKeyString(const Line: string): string;
71      procedure QuickSortStrA(SL: TStrings);
72      procedure QuickSortStrD(SL: TStrings);
73      procedure ResolveSwitches(Switches: array of string);
74    private
75      FSortTime: TDateTime;
76      FIsSwitches,
77        FIsPositional,
78        FIsDelimited,
79        FDescending,
80        FIgnoreCase,
81        FIgnoreBlank,
82        FEvalDateTime,
83        FEvalNumeric: boolean;
84      FFieldNum,
85        FStartPos, FEndPos: integer;
86      FDelimiter: char;
87    public
88      procedure SortStrings(StringList: TStrings;
89        Switches: array of string;
90        Options: TSuperSortOptionSet = []);
91      property SortTime: TDateTime read FSortTime;
92    end;
93  
94    // -----------------------------------------------------------------------------
95  implementation
96  
97  const
98    BLANK = -1;
99    EMPTYSTR = '';
100 
101   // ================================================
102   // INTERNAL CALL
103   // Resolve switches and set internal variables
104   // ================================================
105 
106 procedure TSuperSort.ResolveSwitches(Switches: array of string);
107 var
108   i: integer;
109   Sw, Data: string;
110 begin
111   FStartPos := BLANK;
112   FEndPos := BLANK;
113   FFieldNum := BLANK;
114   FDelimiter := ' ';
115   FIsPositional := false;
116   FIsDelimited := false;
117 
118   for i := Low(Switches) to High(Switches) do
119   begin
120     Sw := trim(Switches[i]);
121     Data := trim(copy(Sw, 3, 1024));
122     Sw := UpperCase(copy(Sw, 1, 2));
123 
124     // Delimiter
125     if Sw = '-D' then
126     begin
127       if length(Data) > 0 then
128         FDelimiter := Data[1];
129     end;
130 
131     // Field Number
132     if Sw = '-F' then
133     begin
134       FIsSwitches := true;
135       FIsDelimited := true;
136       FFieldNum := StrToIntDef(Data, BLANK);
137       Assert(FFieldNum <> BLANK, 'Invalid -f Switch');
138     end;
139 
140     // Positional Key
141     if Sw = '-K' then
142     begin
143       FIsSwitches := true;
144       FIsPositional := true;
145       FStartPos := StrToIntDef(trim(copy(Data, 1, pos(',', Data) - 1)), BLANK);
146       FEndPos := StrToIntDef(trim(copy(Data, pos(',', Data) + 1, 1024)), BLANK);
147       Assert((FStartPos <> BLANK) and (FEndPos <> Blank), 'Invalid -k Switch');
148     end;
149 
150   end;
151 end;
152 
153 // ====================================================
154 // INTERNAL CALL
155 // Resolve the Sort Key part of the string based on
156 // the Switches parameters
157 // ====================================================
158 
159 function TSuperSort.GetKeyString(const Line: string): string;
160 var
161   Key: string;
162   Numvar: double;
163   DCount, i, DPos: integer;
164   Tmp: string;
165 begin
166   // Default
167   Key := Line;
168   // Extract Key from switches -k takes precedence
169   if FIsPositional then
170     Key := copy(Key, FStartPos, FEndPos)
171   else if FIsDelimited then
172   begin
173     DPos := 0;
174     DCount := 0;
175     for i := 1 to length(Key) do
176     begin
177       if Key[i] = FDelimiter then
178         inc(DCount);
179       if DCount = FFieldNum then
180       begin
181         if FFieldNum = 0 then
182           DPos := 1
183         else
184           DPos := i + 1;
185         break;
186       end;
187     end;
188 
189     if DCount < FFieldNum then
190       // No such Field Number
191       Key := EMPTYSTR
192     else
193     begin
194       Tmp := copy(Key, DPos, 4096);
195       DPos := pos(FDelimiter, Tmp);
196       if DPos = 0 then
197         Key := Tmp
198       else
199         Key := copy(Tmp, 1, DPos - 1);
200     end;
201   end;
202 
203   // Resolve Options
204   if FEvalNumeric then
205   begin
206     Key := trim(Key);
207     // Strip any commas
208     for i := length(Key) downto 1 do
209       if Key[i] = ',' then
210         delete(Key, i, 1);
211     try
212       Numvar := StrToFloat(Key);
213     except
214       Numvar := 0.0;
215     end;
216     Key := FormatFloat('############0.000000', Numvar);
217     // Leftpad num string
218     Key := StringOfChar('0', 20 - length(Key)) + Key;
219   end;
220 
221   // Ignores N/A for Numeric and DateTime
222   if not FEvalNumeric and not FEvalDateTime then
223   begin
224     if FIgnoreBlank then
225       Key := trim(Key);
226     if FIgnoreCase then
227       Key := UpperCase(Key);
228   end;
229 
230   Result := Key;
231 end;
232 
233 // ==============================================
234 // INTERNAL CALL
235 // Recursive STRING quick sort routine ASCENDING.
236 // ==============================================
237 
238 procedure TSuperSort.QuickSortStrA(SL: TStrings);
239 
240   procedure Sort(l, r: integer);
241   var
242     i, j: integer;
243     x, Tmp: string;
244   begin
245     i := l;
246     j := r;
247     x := GetKeyString(SL[(l + r) div 2]);
248 
249     repeat
250       while GetKeyString(SL[i]) < x do
251         inc(i);
252       while x < GetKeyString(SL[j]) do
253         dec(j);
254       if i <= j then
255       begin
256         Tmp := SL[j];
257         SL[j] := SL[i];
258         SL[i] := Tmp;
259         inc(i);
260         dec(j);
261       end;
262     until i > j;
263 
264     if l < j then
265       Sort(l, j);
266     if i < r then
267       Sort(i, r);
268   end;
269 
270 begin
271   if SL.Count > 0 then
272   begin
273     SL.BeginUpdate;
274     Sort(0, SL.Count - 1);
275     SL.EndUpdate;
276   end;
277 end;
278 
279 // ==============================================
280 // INTERNAL CALL
281 // Recursive STRING quick sort routine DECENDING
282 // ==============================================
283 
284 procedure TSuperSort.QuickSortStrD(SL: TStrings);
285   procedure Sort(l, r: integer);
286   var
287     i, j: integer;
288     x, Tmp: string;
289   begin
290     i := l;
291     j := r;
292     x := GetKeyString(SL[(l + r) div 2]);
293 
294     repeat
295       while GetKeyString(SL[i]) > x do
296         inc(i);
297       while x > GetKeyString(SL[j]) do
298         dec(j);
299       if i <= j then
300       begin
301         Tmp := SL[j];
302         SL[j] := SL[i];
303         SL[i] := Tmp;
304         inc(i);
305         dec(j);
306       end;
307     until i > j;
308 
309     if l < j then
310       Sort(l, j);
311     if i < r then
312       Sort(i, r);
313   end;
314 
315 begin
316   if SL.Count > 0 then
317   begin
318     SL.BeginUpdate;
319     Sort(0, SL.Count - 1);
320     SL.EndUpdate;
321   end;
322 end;
323 
324 // ====================
325 // Sort a stringlist
326 // ====================
327 
328 procedure TSuperSort.SortStrings(StringList: TStrings;
329   Switches: array of string;
330   Options: TSuperSortOptionSet = []);
331 var
332   StartTime: TDateTime;
333 begin
334   StartTime := Now;
335   FDescending := (srtDescending in Options);
336   FIgnoreCase := (srtIgnoreCase in Options);
337   FIgnoreBlank := (srtIgnoreBlank in Options);
338   FEvalNumeric := (srtEvalNumeric in Options);
339   ResolveSwitches(Switches);
340 
341   if FDescending then
342     QuickSortStrD(StringList)
343   else
344     QuickSortStrA(StringList);
345 
346   FSortTime := Now - StartTime;
347 end;
348 
349 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