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
Dynamic arrays an approach 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
15-Jun-03
Category
OO-related
Language
Delphi 2.x
Views
120
User Rating
No Votes
# Votes
0
Replies
0
Publisher:
DSP, Administrator
Reference URL:
DKB
			Author: Ronald Buster

An approach to do dynamic arrays the easy way

Answer:

1   type
2     TDISIntArray = array of integer;
3   
4     TDISFindArrayMode = (famNone, famFirst, famNext, famPrior, famLast);
5     TDISSortArrayMode = (samAscending, samDescending);
6   
7     EDISArray = class(Exception);
8   
9     TDISIntegerArray = class(TObject)
10    private
11      fLastFindMode: TDISFindArrayMode;
12      fComma: Char;
13      fArray: TDISIntArray;
14      fItemCount: Integer;
15      fFindIndex: Integer;
16      fDuplicates: Boolean;
17      function GetArray(Index: integer): integer;
18      procedure SetArray(Index: integer; Value: integer);
19      procedure SetDuplicates(Value: Boolean);
20  
21      procedure Swap(var a, b: integer);
22      procedure QuickSort(Source: TDISIntArray; Mode: TDISSortArrayMode; left, right:
23        integer);
24  
25      procedure Copy(Source: TDISIntArray; var Dest: TDISIntArray);
26    protected
27    public
28      constructor Create;
29      destructor Destroy; override;
30  
31      procedure Clear;
32      function Add(Value: integer): boolean;
33      procedure Delete(Index: integer);
34      function Find(Value: integer; Mode: TDISFindArrayMode): integer;
35  
36      function Min: integer;
37      function Max: integer;
38      function Sum: integer;
39      function Average: integer;
40  
41      function Contains(Value: integer): Boolean;
42      function Commatext: string;
43  
44      procedure Sort(Mode: TDISSortArrayMode);
45  
46      procedure SaveToFile(FileName: string);
47      function LoadFromFile(FileName: string): boolean;
48  
49      property AddDuplicates: Boolean read fDuplicates write SetDuplicates;
50      property Items[Index: integer]: integer read GetArray write SetArray;
51      property Count: Integer read fItemCount;
52  
53      property CommaSeparator: Char read fComma write fComma;
54    end;
55  
56  implementation
57  
58  function ReplaceChars(value: string; v1, v2: char): string;
59  var
60    ts: string;
61    i: integer;
62  begin
63    ts := value;
64    for i := 1 to length(ts) do
65      if ts[i] = v1 then
66        ts[i] := v2;
67    result := ts;
68  end;
69  
70  ////////////////////////////////////////////////
71  // TDISIntegerArray
72  ////////////////////////////////////////////////
73  
74  constructor TDISIntegerArray.Create;
75  begin
76    fItemCount := 0;
77    fDuplicates := True;
78    fLastFindMode := famNone;
79    fComma := ',';
80  end;
81  
82  destructor TDISIntegerArray.Destroy;
83  begin
84    inherited Destroy;
85  end;
86  
87  function TDISIntegerArray.Min: integer;
88  var
89    TA: TDISIntArray;
90  begin
91    Copy(fArray, Ta);
92    QuickSort(Ta, samAscending, low(fArray), high(fArray));
93    Result := Ta[0];
94  end;
95  
96  function TDISIntegerArray.Max: integer;
97  var
98    TA: TDISIntArray;
99  begin
100   Copy(fArray, Ta);
101   QuickSort(Ta, samDescending, low(fArray), high(fArray));
102   Result := Ta[0];
103 end;
104 
105 function TDISIntegerArray.Sum: integer;
106 var
107   i: integer;
108 begin
109   Result := 0;
110   for i := low(fArray) to high(fArray) do
111     Result := Result + fArray[i];
112 end;
113 
114 function TDISIntegerArray.Average: integer;
115 begin
116   Result := Sum div fItemCount;
117 end;
118 
119 procedure TDISIntegerArray.SaveToFile(FileName: string);
120 var
121   Tl: TStringList;
122 begin
123   Tl := TStringList.Create;
124   Tl.Text := CommaText;
125   Tl.SaveToFile(FileName);
126   Tl.Free;
127 end;
128 
129 function TDISIntegerArray.LoadFromFile(FileName: string): boolean;
130 var
131   Tl: TStringList;
132   Ts: string;
133   j: integer;
134 begin
135   Result := False;
136   if FileExists(FileName) then
137   begin
138     Result := True;
139 
140     Tl := TStringList.Create;
141     Tl.LoadFromFile(FileName);
142 
143     Ts := ReplaceChars(Trim(Tl.Text), ';', ',');
144     Ts := ReplaceChars(Ts, '|', ',');
145     Ts := ReplaceChars(Ts, #9, ',');
146 
147     Clear;
148     while pos(',', Ts) > 0 do
149     begin
150       j := StrToIntDef(System.copy(Ts, 1, pos(',', Ts) - 1), 0);
151       Add(j);
152       System.Delete(Ts, 1, pos(',', Ts));
153     end;
154     Add(StrToIntDef(Ts, 0));
155 
156     Tl.Free;
157   end;
158 end;
159 
160 procedure TDISIntegerArray.Swap(var a, b: integer);
161 var
162   t: integer;
163 begin
164   t := a;
165   a := b;
166   b := t;
167 end;
168 
169 procedure TDISIntegerArray.QuickSort(Source: TDISIntArray; Mode: TDISSortArrayMode;
170   left, right: integer);
171 var
172   pivot: integer;
173   lower,
174     upper,
175     middle: integer;
176 begin
177   lower := left;
178   upper := right;
179   middle := (left + right) div 2;
180   pivot := Source[middle];
181   repeat
182     case Mode of
183       samAscending:
184         begin
185           while Source[lower] < pivot do
186             inc(lower);
187           while pivot < Source[upper] do
188             dec(upper);
189         end;
190       samDescending:
191         begin
192           while Source[lower] > pivot do
193             inc(lower);
194           while pivot > Source[upper] do
195             dec(upper);
196         end;
197     end;
198 
199     if lower <= upper then
200     begin
201       swap(Source[lower], Source[upper]);
202       inc(lower);
203       dec(upper);
204     end;
205   until lower > upper;
206 
207   if left < upper then
208     QuickSort(Source, Mode, left, upper);
209   if lower < right then
210     QuickSort(Source, Mode, lower, right);
211 end;
212 
213 procedure TDISIntegerArray.Clear;
214 var
215   i: integer;
216 begin
217   for i := low(fArray) to high(fArray) do
218     fArray[i] := 0;
219 
220   SetLength(fArray, 0);
221   fItemCount := 0;
222 end;
223 
224 function TDISIntegerArray.Commatext: string;
225 var
226   i: integer;
227 begin
228   Result := '';
229   for i := low(fArray) to high(fArray) do
230   begin
231     Result := Result + IntToStr(fArray[i]);
232     Result := Result + fComma;
233   end;
234   if Length(Result) > 0 then
235     System.Delete(Result, length(Result), 1);
236 end;
237 
238 procedure TDISIntegerArray.Sort(Mode: TDISSortArrayMode);
239 begin
240   QuickSort(fArray, Mode, low(fArray), high(fArray));
241 end;
242 
243 procedure TDISIntegerArray.SetDuplicates(Value: Boolean);
244 begin
245   fDuplicates := Value;
246 end;
247 
248 function TDISIntegerArray.Add(Value: integer): boolean;
249 begin
250   Result := True;
251 
252 if contains(Value) and (fDuplicates = False) then
253   begin
254     Result := False;
255     exit;
256   end;
257 
258 inc(fItemCount);
259 SetLength(fArray, fItemCount);
260 fArray[fItemCount - 1] := Value;
261 end;
262 
263 function TDISIntegerArray.Contains(Value: integer): Boolean;
264 var
265   i: integer;
266 begin
267   Result := False;
268   for i := low(fArray) to high(fArray) do
269   begin
270     if fArray[i] = Value then
271     begin
272       Result := True;
273       Break;
274     end;
275   end;
276 end;
277 
278 function TDISIntegerArray.Find(Value: integer; Mode: TDISFindArrayMode): integer;
279 var
280   i: integer;
281 begin
282   Result := -1;
283 
284   case Mode of
285     famNone, famFirst:
286       begin
287         fLastFindMode := Mode;
288         fFindIndex := -1;
289         for i := low(fArray) to high(fArray) do
290         begin
291           if fArray[i] = Value then
292           begin
293             if Mode = famFirst then
294               fFindIndex := i + 1;
295             Result := i;
296             Break;
297           end;
298         end;
299       end;
300     famNext:
301       begin
302 
303         if fLastFindMode = famPrior then
304           inc(fFindIndex, 2);
305 
306         fLastFindMode := Mode;
307 
308         for i := fFindIndex to high(fArray) do
309         begin
310           if fArray[i] = Value then
311           begin
312             fFindIndex := i + 1;
313             Result := i;
314             Break;
315           end;
316         end;
317       end;
318     famPrior:
319       begin
320 
321         if fLastFindMode = famNext then
322           dec(fFindIndex, 2);
323 
324         fLastFindMode := Mode;
325 
326         for i := fFindIndex downto low(fArray) do
327         begin
328           if fArray[i] = Value then
329           begin
330 
331             fFindIndex := i - 1;
332             Result := i;
333             Break;
334           end;
335         end;
336       end;
337     famLast:
338       begin
339         fFindIndex := -1;
340         fLastFindMode := Mode;
341         for i := high(fArray) downto low(fArray) do
342         begin
343           if fArray[i] = Value then
344           begin
345 
346             fFindIndex := i - 1;
347             Result := i;
348             Break;
349           end;
350         end;
351       end;
352   end;
353 end;
354 
355 procedure TDISIntegerArray.Copy(Source: TDISIntArray; var Dest: TDISIntArray);
356 var
357   i: integer;
358 begin
359   SetLength(Dest, 0);
360   SetLength(Dest, Length(Source));
361 
362   for i := low(Source) to high(Source) do
363     Dest[i] := Source[i];
364 
365 end;
366 
367 procedure TDISIntegerArray.Delete(Index: integer);
368 var
369   TA: TDISIntArray;
370   i: integer;
371 begin
372   if (Index >= Low(fArray)) and (Index <= high(fArray)) then
373   begin
374     Copy(fArray, Ta);
375     Clear;
376     for i := low(Ta) to high(Ta) do
377     begin
378       if i <> Index then
379         Add(Ta[i]);
380     end;
381     dec(fItemCount);
382   end;
383 end;
384 
385 function TDISIntegerArray.GetArray(Index: integer): integer;
386 begin
387   if (Index >= Low(fArray)) and (Index <= high(fArray)) then
388     Result := fArray[index]
389   else
390     raise EDISArray.Create(format('Index : %d is not valid index %d..%d.', [Index,
391       low(fArray), high(fArray)]));
392 end;
393 
394 procedure TDISIntegerArray.SetArray(Index: integer; Value: integer);
395 begin
396 
397 if contains(Value) and (fDuplicates = False) then
398   exit;
399 
400 if Index < 0 then
401   raise EDISArray.Create(format('Index : %d is not valid index.', [Index]))
402 else
403 begin
404   if Index + 1 > fItemCount then
405   begin
406     fItemCount := Index + 1;
407     SetLength(fArray, fItemCount);
408     fArray[fItemCount - 1] := Value;
409   end
410   else
411     fArray[Index] := Value;
412 end;
413 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