1 | {$IFDEF INTERFACE}
|
---|
2 |
|
---|
3 | {$DEFINE TGListIndex := TGListObjectIndex}
|
---|
4 | {$DEFINE TGListItem := TGListObjectItem}
|
---|
5 | {$DEFINE TGList := TGListObjectList}
|
---|
6 | {$DEFINE INTERFACE}
|
---|
7 | {$I 'GenericList.inc'}
|
---|
8 |
|
---|
9 | // TGListObject<TListObjectIndex, TListObjectItem> = class(TGList)
|
---|
10 | TGListObject = class(TGList)
|
---|
11 | protected
|
---|
12 | procedure Put(Index: TGListIndex; const AValue: TGListItem); override;
|
---|
13 | procedure SetCount(const AValue: TGListIndex); override;
|
---|
14 | public
|
---|
15 | OwnsObjects: Boolean;
|
---|
16 | function AddNew(NewObject: TGListItem = nil): TGListItem;
|
---|
17 | function InsertNew(Index: TGListIndex; NewObject: TGListItem = nil): TGListItem;
|
---|
18 | procedure Delete(Index: TGListObjectIndex); override;
|
---|
19 | procedure Assign(Source: TGList); override;
|
---|
20 | constructor Create; override;
|
---|
21 | destructor Destroy; override;
|
---|
22 | end;
|
---|
23 |
|
---|
24 | {$UNDEF INTERFACE}
|
---|
25 | {$ENDIF}
|
---|
26 |
|
---|
27 | {$IFDEF IMPLEMENTATION_USES}
|
---|
28 |
|
---|
29 | {$DEFINE IMPLEMENTATION_USES}
|
---|
30 | {$I 'GenericList.inc'}
|
---|
31 |
|
---|
32 | {$UNDEF IMPLEMENTATION_USES}
|
---|
33 | {$ENDIF}
|
---|
34 |
|
---|
35 | {$IFDEF IMPLEMENTATION}
|
---|
36 |
|
---|
37 | {$DEFINE TGListIndex := TGListObjectIndex}
|
---|
38 | {$DEFINE TGListItem := TGListObjectItem}
|
---|
39 | {$DEFINE TGList := TGListObjectList}
|
---|
40 | {$DEFINE IMPLEMENTATION}
|
---|
41 | {$I 'GenericList.inc'}
|
---|
42 |
|
---|
43 | { TGListObject }
|
---|
44 |
|
---|
45 | function TGListObject.AddNew(NewObject: TGListItem = nil): TGListItem;
|
---|
46 | begin
|
---|
47 | if Assigned(NewObject) then Result := NewObject
|
---|
48 | else Result := TGListItem.Create;
|
---|
49 | Add(Result);
|
---|
50 | end;
|
---|
51 |
|
---|
52 | function TGListObject.InsertNew(Index: TGListIndex;
|
---|
53 | NewObject: TGListItem = nil): TGListItem;
|
---|
54 | begin
|
---|
55 | if Assigned(NewObject) then Result := NewObject
|
---|
56 | else Result := TGListItem.Create;
|
---|
57 | Insert(Index, Result);
|
---|
58 | end;
|
---|
59 |
|
---|
60 | procedure TGListObject.Assign(Source: TGList);
|
---|
61 | begin
|
---|
62 | Clear;
|
---|
63 | OwnsObjects := False;
|
---|
64 | inherited;
|
---|
65 | end;
|
---|
66 |
|
---|
67 | procedure TGListObject.Put(Index: TGListIndex; const AValue: TGListItem);
|
---|
68 | begin
|
---|
69 | if OwnsObjects and (FItems[Index] <> AValue) then FItems[Index].Free;
|
---|
70 | inherited Put(Index, AValue);
|
---|
71 | end;
|
---|
72 |
|
---|
73 | procedure TGListObject.Delete(Index: TGListObjectIndex);
|
---|
74 | begin
|
---|
75 | if OwnsObjects then FItems[Index].Free;
|
---|
76 | inherited Delete(Index);
|
---|
77 | end;
|
---|
78 |
|
---|
79 | procedure TGListObject.SetCount(const AValue: TGListIndex);
|
---|
80 | var
|
---|
81 | I: TGListObjectIndex;
|
---|
82 | begin
|
---|
83 | if OwnsObjects then begin
|
---|
84 | I := FCount - 1;
|
---|
85 | while I >= AValue do begin
|
---|
86 | FItems[I].Free;
|
---|
87 | I := I - 1;
|
---|
88 | end;
|
---|
89 | end;
|
---|
90 | inherited;
|
---|
91 | end;
|
---|
92 |
|
---|
93 | constructor TGListObject.Create;
|
---|
94 | begin
|
---|
95 | inherited;
|
---|
96 | OwnsObjects := True;
|
---|
97 | end;
|
---|
98 |
|
---|
99 | destructor TGListObject.Destroy;
|
---|
100 | begin
|
---|
101 | Clear;
|
---|
102 | inherited;
|
---|
103 | end;
|
---|
104 |
|
---|
105 | {$UNDEF IMPLEMENTATION}
|
---|
106 | {$ENDIF}
|
---|