source: branches/AS8051toC/Packages/TemplateGenerics/Generic/GenericListObject.inc

Last change on this file was 26, checked in by chronos, 12 years ago
  • Upraveno: Překlad rozdělen do fáze zpracování maker a druhé fáze zpracování instrukcí.
File size: 2.5 KB
Line 
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
45function TGListObject.AddNew(NewObject: TGListItem = nil): TGListItem;
46begin
47 if Assigned(NewObject) then Result := NewObject
48 else Result := TGListItem.Create;
49 Add(Result);
50end;
51
52function TGListObject.InsertNew(Index: TGListIndex;
53 NewObject: TGListItem = nil): TGListItem;
54begin
55 if Assigned(NewObject) then Result := NewObject
56 else Result := TGListItem.Create;
57 Insert(Index, Result);
58end;
59
60procedure TGListObject.Assign(Source: TGList);
61begin
62 Clear;
63 OwnsObjects := False;
64 inherited;
65end;
66
67procedure TGListObject.Put(Index: TGListIndex; const AValue: TGListItem);
68begin
69 if OwnsObjects and (FItems[Index] <> AValue) then FItems[Index].Free;
70 inherited Put(Index, AValue);
71end;
72
73procedure TGListObject.Delete(Index: TGListObjectIndex);
74begin
75 if OwnsObjects then FItems[Index].Free;
76 inherited Delete(Index);
77end;
78
79procedure TGListObject.SetCount(const AValue: TGListIndex);
80var
81 I: TGListObjectIndex;
82begin
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;
91end;
92
93constructor TGListObject.Create;
94begin
95 inherited;
96 OwnsObjects := True;
97end;
98
99destructor TGListObject.Destroy;
100begin
101 Clear;
102 inherited;
103end;
104
105{$UNDEF IMPLEMENTATION}
106{$ENDIF}
Note: See TracBrowser for help on using the repository browser.