source: Generics/TemplateGenerics/Specialized/SpecializedList.pas

Last change on this file was 574, checked in by chronos, 5 months ago
  • Modified: Removed U prefix from unit names.
File size: 8.7 KB
Line 
1unit SpecializedList;
2
3interface
4
5uses
6 Classes, SysUtils;
7
8type
9{$MACRO ON}
10
11// TListInteger<Integer, Integer>
12{$DEFINE TGListIndex := Integer}
13{$DEFINE TGListItem := Integer}
14{$DEFINE TGList := TListInteger}
15{$DEFINE INTERFACE}
16{$I 'GenericList.inc'}
17
18// TListBoolean<Integer, Boolean>
19{$DEFINE TGListIndex := Integer}
20{$DEFINE TGListItem := Boolean}
21{$DEFINE TGList := TListBoolean}
22{$DEFINE INTERFACE}
23{$I 'GenericList.inc'}
24
25// TListSmallInt<Integer, SmallInt>
26{$DEFINE TGListIndex := Integer}
27{$DEFINE TGListItem := SmallInt}
28{$DEFINE TGList := TListSmallInt}
29{$DEFINE INTERFACE}
30{$I 'GenericList.inc'}
31
32// TListDouble<Integer, Double>
33{$DEFINE TGListIndex := Integer}
34{$DEFINE TGListItem := Double}
35{$DEFINE TGList := TListDouble}
36{$DEFINE INTERFACE}
37{$INCLUDE '..\Generic\GenericList.inc'}
38
39// TListPointer<Integer, Pointer>
40{$DEFINE TGListIndex := Integer}
41{$DEFINE TGListItem := Pointer}
42{$DEFINE TGList := TListPointer}
43{$DEFINE INTERFACE}
44{$I 'GenericList.inc'}
45
46// TListString<Integer, string>
47{$DEFINE TGListStringIndex := Integer}
48{$DEFINE TGListStringItem := string}
49{$DEFINE TGListString := TListString}
50{$DEFINE INTERFACE}
51{$I 'GenericListString.inc'}
52
53// TListByte<Integer, Byte>
54{$DEFINE TGListIndex := Integer}
55{$DEFINE TGListItem := Byte}
56{$DEFINE TGList := TListByteBase}
57{$DEFINE INTERFACE}
58{$I 'GenericList.inc'}
59
60TListByte = class(TListByteBase)
61 procedure WriteToStream(Stream: TStream);
62 procedure WriteToStreamPart(Stream: TStream; ItemIndex, ItemCount: TGListIndex);
63 procedure ReplaceStream(Stream: TStream);
64 procedure ReplaceStreamPart(Stream: TStream; ItemIndex, ItemCount: TGListIndex);
65 procedure AddStream(Stream: TStream);
66 procedure AddStreamPart(Stream: TStream; ItemCount: TGListIndex);
67end;
68
69// TListChar<Integer, Char>
70{$DEFINE TGListIndex := Integer}
71{$DEFINE TGListItem := Char}
72{$DEFINE TGList := TListCharBase}
73{$DEFINE INTERFACE}
74{$I 'GenericList.inc'}
75
76// TListObject<Integer, TObject>
77{$DEFINE TGListObjectIndex := Integer}
78{$DEFINE TGListObjectItem := TObject}
79{$DEFINE TGListObjectList := TListObjectList}
80{$DEFINE TGListObject := TListObject}
81{$DEFINE INTERFACE}
82{$I 'GenericListObject.inc'}
83
84
85{ TListChar }
86
87// TListByte<Integer, Char>
88TListChar = class(TListCharBase)
89 procedure UpperCase;
90 procedure LowerCase;
91 procedure Trim;
92 procedure TrimLeft;
93 procedure TrimRight;
94end;
95
96// TListMethodBase<Integer, TMethod>
97{$DEFINE TGListIndex := Integer}
98{$DEFINE TGListItem := TMethod}
99{$DEFINE TGList := TListMethodBase}
100{$DEFINE INTERFACE}
101{$I 'GenericList.inc'}
102
103// TListMethod<Integer, TMethod>
104TListMethod = class(TListMethodBase)
105 procedure CallAll;
106end;
107
108// TListNotifyEventBase<Integer, TNotifyEvent>
109{$DEFINE TGListIndex := Integer}
110{$DEFINE TGListItem := TNotifyEvent}
111{$DEFINE TGList := TListNotifyEventBase}
112{$DEFINE INTERFACE}
113{$I 'GenericList.inc'}
114
115// TListNotifyEvent<Integer, TNotifyEvent>
116TListNotifyEvent = class(TListNotifyEventBase)
117 procedure CallAll(Sender: TObject);
118end;
119
120
121TBaseEvent = procedure of object;
122
123// TListSimpleEventBase<Integer, TBaseEvent>
124{$DEFINE TGListIndex := Integer}
125{$DEFINE TGListItem := TBaseEvent}
126{$DEFINE TGList := TListSimpleEventBase}
127{$DEFINE INTERFACE}
128{$I 'GenericList.inc'}
129
130// TListSimpleEvent<Integer, TSimpleEvent>
131TListSimpleEvent = class(TListSimpleEventBase)
132 procedure CallAll;
133end;
134
135
136// TFileListByte<Integer, Byte>
137{$DEFINE TGFileListIndex := Integer}
138{$DEFINE TGFileListItem := Byte}
139{$DEFINE TGFileListList := TFileListListByte}
140{$DEFINE TGFileList := TFileListByte}
141{$DEFINE INTERFACE}
142{$I 'GenericFileList.inc'}
143
144function StrToStr(Value: string): string;
145
146
147
148
149
150implementation
151
152{$DEFINE IMPLEMENTATION_USES}
153{$I 'GenericList.inc'}
154
155// TListInteger<Integer, Integer>
156{$DEFINE TGListIndex := Integer}
157{$DEFINE TGListItem := Integer}
158{$DEFINE TGList := TListInteger}
159{$DEFINE IMPLEMENTATION}
160{$I 'GenericList.inc'}
161
162// TListSmallInt<Integer, SmallInt>
163{$DEFINE TGListIndex := Integer}
164{$DEFINE TGListItem := SmallInt}
165{$DEFINE TGList := TListSmallInt}
166{$DEFINE IMPLEMENTATION}
167{$I 'GenericList.inc'}
168
169// TListBoolean<Integer, Boolean>
170{$DEFINE TGListIndex := Integer}
171{$DEFINE TGListItem := Boolean}
172{$DEFINE TGList := TListBoolean}
173{$DEFINE IMPLEMENTATION}
174{$I 'GenericList.inc'}
175
176// TListDouble<Integer, Double>
177{$DEFINE TGListIndex := Integer}
178{$DEFINE TGListItem := Double}
179{$DEFINE TGList := TListDouble}
180{$DEFINE IMPLEMENTATION}
181{$I 'GenericList.inc'}
182
183// TListPointer<Integer, Pointer>
184{$DEFINE TGListIndex := Integer}
185{$DEFINE TGListItem := Pointer}
186{$DEFINE TGList := TListPointer}
187{$DEFINE IMPLEMENTATION}
188{$I 'GenericList.inc'}
189
190// TListString<Integer, string>
191{$DEFINE TGListStringIndex := Integer}
192{$DEFINE TGListStringItem := string}
193{$DEFINE TGListString := TListString}
194{$DEFINE IMPLEMENTATION}
195{$I 'GenericListString.inc'}
196
197// TListByte<Integer, Byte>
198{$DEFINE TGListIndex := Integer}
199{$DEFINE TGListItem := Byte}
200{$DEFINE TGList := TListByteBase}
201{$DEFINE IMPLEMENTATION}
202{$I 'GenericList.inc'}
203
204// TListByte<Integer, Char>
205{$DEFINE TGListIndex := Integer}
206{$DEFINE TGListItem := Char}
207{$DEFINE TGList := TListCharBase}
208{$DEFINE IMPLEMENTATION}
209{$I 'GenericList.inc'}
210
211// TListObject<Integer, TObject>
212{$DEFINE TGListObjectIndex := Integer}
213{$DEFINE TGListObjectItem := TObject}
214{$DEFINE TGListObjectList := TListObjectList}
215{$DEFINE TGListObject := TListObject}
216{$DEFINE IMPLEMENTATION}
217{$I 'GenericListObject.inc'}
218
219// TListMethod<Integer, TMethod>
220{$DEFINE TGListIndex := Integer}
221{$DEFINE TGListItem := TMethod}
222{$DEFINE TGList := TListMethodBase}
223{$DEFINE IMPLEMENTATION}
224{$I 'GenericList.inc'}
225
226// TListNotifyEventBase<Integer, TNotifyEvent>
227{$DEFINE TGListIndex := Integer}
228{$DEFINE TGListItem := TNotifyEvent}
229{$DEFINE TGList := TListNotifyEventBase}
230{$DEFINE IMPLEMENTATION}
231{$I 'GenericList.inc'}
232
233// TListSimpleEventBase<Integer, TBaseEvent>
234{$DEFINE TGListIndex := Integer}
235{$DEFINE TGListItem := TBaseEvent}
236{$DEFINE TGList := TListSimpleEventBase}
237{$DEFINE IMPLEMENTATION}
238{$I 'GenericList.inc'}
239
240// TFileListByte<Integer, Byte>
241{$DEFINE TGFileListIndex := Integer}
242{$DEFINE TGFileListItem := Byte}
243{$DEFINE TGFileListList := TFileListListByte}
244{$DEFINE TGFileList := TFileListByte}
245{$DEFINE IMPLEMENTATION}
246{$I 'GenericFileList.inc'}
247
248
249function StrToStr(Value: string): string;
250begin
251 Result := Value;
252end;
253
254{ TListSimpleEvent }
255
256procedure TListSimpleEvent.CallAll;
257var
258 I: TGListIndex;
259begin
260 I := 0;
261 while (I < Count) do begin
262 TBaseEvent(Items[I])();
263 I := I + 1;
264 end;
265end;
266
267
268{ TListChar }
269
270procedure TListChar.UpperCase;
271var
272 I: TGListIndex;
273begin
274 for I := 0 to Count - 1 do
275 if (FItems[I] in ['a'..'z']) then
276 FItems[I] := Char(Byte(FItems[I]) - 32);
277end;
278
279procedure TListChar.LowerCase;
280var
281 I: TGListIndex;
282begin
283 for I := 0 to Count - 1 do
284 if (FItems[I] in ['A'..'Z']) then
285 FItems[I] := Char(Byte(FItems[I]) + 32);
286end;
287
288procedure TListChar.Trim;
289begin
290 TrimLeft;
291 TrimRight;
292end;
293
294procedure TListChar.TrimLeft;
295var
296 I: TGListIndex;
297begin
298 I := 0;
299 while (I < Count) and (FItems[I] = ' ') do
300 I := I + 1;
301 if I < Count then
302 DeleteItems(0, I);
303end;
304
305procedure TListChar.TrimRight;
306var
307 I: TGListIndex;
308begin
309 I := Count - 1;
310 while (I >= 0) and (FItems[I] = ' ') do
311 I := I - 1;
312 if I >= 0 then
313 DeleteItems(I + 1, Count - I - 1);
314end;
315
316procedure TListMethod.CallAll;
317var
318 I: TGListIndex;
319begin
320 I := 0;
321 while (I < Count) do begin
322 Items[I];
323 I := I + 1;
324 end;
325end;
326
327procedure TListNotifyEvent.CallAll(Sender: TObject);
328var
329 I: TGListIndex;
330begin
331 I := Count - 1;
332 while (I >= 0) do begin
333 TNotifyEvent(Items[I])(Sender);
334 I := I - 1;
335 end;
336end;
337
338{ TListByte }
339
340procedure TListByte.WriteToStream(Stream: TStream);
341var
342 I: Integer;
343begin
344 Stream.Position := 0;
345 I := 0;
346 while I < Count do begin
347 Stream.WriteByte(Items[I]);
348 I := I + 1;
349 end;
350end;
351
352procedure TListByte.WriteToStreamPart(Stream: TStream; ItemIndex, ItemCount: Integer);
353var
354 I: Integer;
355begin
356 I := ItemIndex;
357 while I < ItemCount do begin
358 Stream.WriteByte(Items[I]);
359 I := I + 1;
360 end;
361end;
362
363procedure TListByte.ReplaceStream(Stream: TStream);
364var
365 I: Integer;
366begin
367 Stream.Position := 0;
368 I := 0;
369 while I < Count do begin
370 Items[I] := Stream.ReadByte;
371 I := I + 1;
372 end;
373end;
374
375procedure TListByte.ReplaceStreamPart(Stream: TStream; ItemIndex,
376 ItemCount: Integer);
377var
378 I: Integer;
379begin
380 I := ItemIndex;
381 while I < ItemCount do begin
382 Items[I] := Stream.ReadByte;
383 I := I + 1;
384 end;
385end;
386
387procedure TListByte.AddStream(Stream: TStream);
388var
389 I: Integer;
390begin
391 Stream.Position := 0;
392 I := Count;
393 Count := Count + Stream.Size;
394 while I < Count do begin
395 Items[I] := Stream.ReadByte;
396 I := I + 1;
397 end;
398end;
399
400procedure TListByte.AddStreamPart(Stream: TStream; ItemCount: Integer);
401var
402 I: Integer;
403begin
404 I := Count;
405 Count := Count + ItemCount;
406 while I < Count do begin
407 Items[I] := Stream.ReadByte;
408 I := I + 1;
409 end;
410end;
411
412
413end.
Note: See TracBrowser for help on using the repository browser.