{ This file is part of the Free Component Library (FCL) Copyright (c) 1999-2000 by the Free Pascal development team See the file COPYING.FPC, included in this distribution, for details about the copyright. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. **********************************************************************} {****************************************************************************} {* TCollectionItem *} {****************************************************************************} function TCollectionItem.GetIndex: Integer; begin if FCollection<>nil then Result:=FCollection.FItems.IndexOf(Pointer(Self)) else Result:=-1; end; procedure TCollectionItem.SetCollection(Value: TCollection); begin IF Value<>FCollection then begin If FCollection<>Nil then FCollection.RemoveItem(Self); if Value<>Nil then Value.InsertItem(Self); FCollection:=Value; end; end; procedure TCollectionItem.Changed(AllItems: Boolean); begin If (FCollection<>Nil) and (FCollection.UpdateCount=0) then begin If AllItems then FCollection.Update(Nil) else FCollection.Update(Self); end; end; function TCollectionItem.GetNamePath: string; begin If FCollection<>Nil then Result:=FCollection.GetNamePath+'['+IntToStr(Index)+']' else Result:=ClassName; end; function TCollectionItem.GetOwner: TPersistent; begin Result:=FCollection; end; function TCollectionItem.GetDisplayName: string; begin Result:=ClassName; end; procedure TCollectionItem.SetIndex(Value: Integer); Var Temp : Longint; begin Temp:=GetIndex; If (Temp>-1) and (Temp<>Value) then begin FCollection.FItems.Move(Temp,Value); Changed(True); end; end; procedure TCollectionItem.SetDisplayName(const Value: string); begin Changed(False); end; constructor TCollectionItem.Create(ACollection: TCollection); begin Inherited Create; SetCollection(ACollection); end; destructor TCollectionItem.Destroy; begin SetCollection(Nil); Inherited Destroy; end; {****************************************************************************} {* TCollectionEnumerator *} {****************************************************************************} constructor TCollectionEnumerator.Create(ACollection: TCollection); begin inherited Create; FCollection := ACollection; FPosition := -1; end; function TCollectionEnumerator.GetCurrent: TCollectionItem; begin Result := FCollection.Items[FPosition]; end; function TCollectionEnumerator.MoveNext: Boolean; begin Inc(FPosition); Result := FPosition < FCollection.Count; end; {****************************************************************************} {* TCollection *} {****************************************************************************} function TCollection.Owner: TPersistent; begin result:=getowner; end; function TCollection.GetCount: Integer; begin If Assigned(FItems) Then Result:=FItems.Count else Result:=0; end; Procedure TCollection.SetPropName; Var TheOwner : TPersistent; PropList : PPropList; I, PropCount : Integer; begin FPropName:=''; TheOwner:=GetOwner; if (TheOwner=Nil) Or (TheOwner.Classinfo=Nil) Then Exit; // get information from the owner RTTI PropCount:=GetPropList(TheOwner, PropList); Try For I:=0 To PropCount-1 Do If (PropList^[i]^.PropType^.Kind=tkClass) And (GetObjectProp(TheOwner, PropList^[i], ClassType)=Self) Then Begin FPropName:=PropList^[i]^.Name; Exit; End; Finally FreeMem(PropList); End; end; function TCollection.GetPropName: string; Var TheOwner : TPersistent; begin Result:=FPropNAme; TheOwner:=GetOwner; If (Result<>'') or (TheOwner=Nil) Or (TheOwner.Classinfo=Nil) then exit; SetPropName; Result:=FPropName; end; procedure TCollection.InsertItem(Item: TCollectionItem); begin If Not(Item Is FitemClass) then exit; FItems.add(Pointer(Item)); Item.FID:=FNextID; inc(FNextID); SetItemName(Item); Notify(Item,cnAdded); Changed; end; procedure TCollection.RemoveItem(Item: TCollectionItem); begin Notify(Item,cnExtracting); FItems.Remove(Pointer(Item)); Item.FCollection:=Nil; Changed; end; function TCollection.GetAttrCount: Integer; begin Result:=0; end; function TCollection.GetAttr(Index: Integer): string; begin Result:=''; end; function TCollection.GetItemAttr(Index, ItemIndex: Integer): string; begin Result:=TCollectionItem(FItems.Items[ItemIndex]).DisplayName; end; function TCollection.GetEnumerator: TCollectionEnumerator; begin Result := TCollectionEnumerator.Create(Self); end; function TCollection.GetNamePath: string; var o : TObject; begin o:=getowner; if assigned(o) and (propname<>'') and (o IS TPersistent) then result:=TPersistent(o).getnamepath+'.'+propname else result:=classname; end; procedure TCollection.Changed; begin if FUpdateCount=0 then Update(Nil); end; function TCollection.GetItem(Index: Integer): TCollectionItem; begin Result:=TCollectionItem(FItems.Items[Index]); end; procedure TCollection.SetItem(Index: Integer; Value: TCollectionItem); begin TCollectionItem(FItems.items[Index]).Assign(Value); end; procedure TCollection.SetItemName(Item: TCollectionItem); begin end; procedure TCollection.Update(Item: TCollectionItem); begin end; constructor TCollection.Create(AItemClass: TCollectionItemClass); begin inherited create; FItemClass:=AItemClass; FItems:=TList.Create; end; destructor TCollection.Destroy; begin If Assigned(FItems) Then Clear; FItems.Free; Inherited Destroy; end; function TCollection.Add: TCollectionItem; begin Result:=FItemClass.Create(Self); end; procedure TCollection.Assign(Source: TPersistent); Var I : Longint; begin If Source is TCollection then begin Clear; For I:=0 To TCollection(Source).Count-1 do Add.Assign(TCollection(Source).Items[I]); exit; end else Inherited Assign(Source); end; procedure TCollection.BeginUpdate; begin inc(FUpdateCount); end; procedure TCollection.Clear; begin If Assigned(FItems) then While FItems.Count>0 do TCollectionItem(FItems.Last).Free; end; procedure TCollection.EndUpdate; begin dec(FUpdateCount); if FUpdateCount=0 then Changed; end; function TCollection.FindItemID(ID: Integer): TCollectionItem; Var I : Longint; begin For I:=0 to Fitems.Count-1 do begin Result:=TCollectionItem(FItems.items[I]); If Result.Id=Id then exit; end; Result:=Nil; end; procedure TCollection.Delete(Index: Integer); begin Notify(TCollectionItem(FItems[Index]),cnDeleting); TCollectionItem(FItems[Index]).Free; end; function TCollection.Insert(Index: Integer): TCollectionItem; begin Result:=Add; Result.Index:=Index; end; procedure TCollection.Notify(Item: TCollectionItem;Action: TCollectionNotification); begin end; procedure TCollection.Sort(Const Compare : TCollectionSortCompare); begin BeginUpdate; try FItems.Sort(TListSortCompare(Compare)); Finally EndUpdate; end; end; {****************************************************************************} {* TOwnedCollection *} {****************************************************************************} Constructor TOwnedCollection.Create(AOwner: TPersistent; AItemClass: TCollectionItemClass); Begin FOwner := AOwner; inherited Create(AItemClass); end; Function TOwnedCollection.GetOwner: TPersistent; begin Result:=FOwner; end;