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