{**************************************************************************************************} { WARNING: JEDI preprocessor generated unit. Do not edit. } {**************************************************************************************************} {**************************************************************************************************} { } { Project JEDI Code Library (JCL) } { } { The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } { you may not use this file except in compliance with the License. You may obtain a copy of the } { License at http://www.mozilla.org/MPL/ } { } { Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } { ANY KIND, either express or implied. See the License for the specific language governing rights } { and limitations under the License. } { } { The Original Code is JclTrees.pas. } { } { The Initial Developer of the Original Code is Florent Ouchet. Portions created by } { Florent Ouchet are Copyright (C) Florent Ouchet = class public Value: T; {$IFDEF BCB} Children: TDynObjectArray; {$ELSE ~BCB} Children: array of TJclTreeNode; {$ENDIF ~BCB} ChildrenCount: Integer; Parent: TJclTreeNode; function IndexOfChild(AChild: TJclTreeNode): Integer; function IndexOfValue(const AItem: T; const AEqualityComparer: IJclEqualityComparer): Integer; end; TJclPreOrderTreeIterator = class; TJclPostOrderTreeIterator = class; TJclTree = class(TJclAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable, IJclContainer, IJclEqualityComparer, IJclItemOwner, IJclCollection, IJclTree) protected type TTreeNode = TJclTreeNode; TPreOrderTreeIterator = TJclPreOrderTreeIterator; TPostOrderTreeIterator = TJclPostOrderTreeIterator; private FRoot: TTreeNode; FTraverseOrder: TJclTraverseOrder; protected procedure ExtractNode(var ANode: TTreeNode); procedure RemoveNode(var ANode: TTreeNode); function CloneNode(Node, Parent: TTreeNode): TTreeNode; function NodeContains(ANode: TTreeNode; const AItem: T): Boolean; procedure PackNode(ANode: TTreeNode); procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override; public constructor Create(AOwnsItems: Boolean); destructor Destroy; override; { IJclPackable } procedure Pack; override; procedure SetCapacity(Value: Integer); override; { IJclCollection } function Add(const AItem: T): Boolean; function AddAll(const ACollection: IJclCollection): Boolean; procedure Clear; function CollectionEquals(const ACollection: IJclCollection): Boolean; function Contains(const AItem: T): Boolean; function ContainsAll(const ACollection: IJclCollection): Boolean; function Extract(const AItem: T): Boolean; function ExtractAll(const ACollection: IJclCollection): Boolean; function First: IJclIterator; function IsEmpty: Boolean; function Last: IJclIterator; function Remove(const AItem: T): Boolean; function RemoveAll(const ACollection: IJclCollection): Boolean; function RetainAll(const ACollection: IJclCollection): Boolean; function Size: Integer; {$IFDEF SUPPORTS_FOR_IN} function GetEnumerator: IJclIterator; {$ENDIF SUPPORTS_FOR_IN} { IJclTree } function GetRoot: IJclTreeIterator; function GetTraverseOrder: TJclTraverseOrder; procedure SetTraverseOrder(Value: TJclTraverseOrder); property Root: IJclTreeIterator read GetRoot; property TraverseOrder: TJclTraverseOrder read GetTraverseOrder write SetTraverseOrder; end; TJclTreeIterator = class(TJclAbstractIterator, IJclIterator, IJclTreeIterator) protected FCursor: TJclTree.TTreeNode; FStart: TItrStart; FOwnTree: TJclTree; FEqualityComparer: IJclEqualityComparer; // keep a reference of tree interface procedure AssignPropertiesTo(Dest: TJclAbstractIterator); override; function GetNextCursor: TJclTree.TTreeNode; virtual; abstract; // return next node on the same level function GetNextSibling: TJclTree.TTreeNode; virtual; abstract; function GetPreviousCursor: TJclTree.TTreeNode; virtual; abstract; public constructor Create(OwnTree: TJclTree; ACursor: TJclTree.TTreeNode; AValid: Boolean; AStart: TItrStart); { IJclIterator } function Add(const AItem: T): Boolean; procedure Extract; function GetItem: T; function HasNext: Boolean; function HasPrevious: Boolean; function Insert(const AItem: T): Boolean; function IteratorEquals(const AIterator: IJclIterator): Boolean; function Next: T; function NextIndex: Integer; function Previous: T; function PreviousIndex: Integer; procedure Remove; procedure Reset; procedure SetItem(const AItem: T); {$IFDEF SUPPORTS_FOR_IN} function MoveNext: Boolean; property Current: T read GetItem; {$ENDIF SUPPORTS_FOR_IN} { IJclTreeIterator } function AddChild(const AItem: T): Boolean; function ChildrenCount: Integer; procedure DeleteChild(Index: Integer); procedure DeleteChildren; procedure ExtractChild(Index: Integer); procedure ExtractChildren; function GetChild(Index: Integer): T; function HasChild(Index: Integer): Boolean; function HasParent: Boolean; function IndexOfChild(const AItem: T): Integer; function InsertChild(Index: Integer; const AItem: T): Boolean; function Parent: T; procedure SetChild(Index: Integer; const AItem: T); end; TJclPreOrderTreeIterator = class(TJclTreeIterator, IJclIterator, IJclTreeIterator, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} IJclIntfCloneable, IJclCloneable) protected function CreateEmptyIterator: TJclAbstractIterator; override; function GetNextCursor: TJclTree.TTreeNode; override; function GetNextSibling: TJclTree.TTreeNode; override; function GetPreviousCursor: TJclTree.TTreeNode; override; end; TJclPostOrderTreeIterator = class(TJclTreeIterator, IJclIterator, IJclTreeIterator, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} IJclIntfCloneable, IJclCloneable) protected function CreateEmptyIterator: TJclAbstractIterator; override; function GetNextCursor: TJclTree.TTreeNode; override; function GetNextSibling: TJclTree.TTreeNode; override; function GetPreviousCursor: TJclTree.TTreeNode; override; end; // E = External helper to compare items for equality TJclTreeE = class(TJclTree, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} IJclIntfCloneable, IJclCloneable, IJclContainer, IJclItemOwner, IJclEqualityComparer, IJclCollection, IJclTree) private FEqualityComparer: IJclEqualityComparer; protected procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override; function CreateEmptyContainer: TJclAbstractContainerBase; override; public constructor Create(const AEqualityComparer: IJclEqualityComparer; AOwnsItems: Boolean); { IJclEqualityComparer } function ItemsEqual(const A, B: T): Boolean; override; property EqualityComparer: IJclEqualityComparer read FEqualityComparer write FEqualityComparer; end; // F = Function to compare items for equality TJclTreeF = class(TJclTree, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} IJclIntfCloneable, IJclCloneable, IJclContainer, IJclItemOwner, IJclEqualityComparer, IJclCollection, IJclTree) protected function CreateEmptyContainer: TJclAbstractContainerBase; override; public constructor Create(ACompare: TCompare; AOwnsItems: Boolean); end; // I = Items can compare themselves to an other for equality TJclTreeI> = class(TJclTree, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} IJclIntfCloneable, IJclCloneable, IJclContainer, IJclItemOwner, IJclEqualityComparer, IJclCollection, IJclTree) protected function CreateEmptyContainer: TJclAbstractContainerBase; override; public { IJclEqualityComparer } function ItemsEqual(const A, B: T): Boolean; override; end; {$ENDIF SUPPORTS_GENERICS} {$IFDEF UNITVERSIONING} const UnitVersioning: TUnitVersionInfo = ( RCSfile: '$URL: https://jcl.svn.sourceforge.net/svnroot/jcl/tags/JCL-2.1-Build3536/jcl/source/common/JclTrees.pas $'; Revision: '$Revision: 2997 $'; Date: '$Date: 2009-09-12 14:21:23 +0200 (sam., 12 sept. 2009) $'; LogPath: 'JCL\source\common'; Extra: ''; Data: nil ); {$ENDIF UNITVERSIONING} implementation uses SysUtils; //=== { TJclIntfTreeNode } ======================================================= function TJclIntfTreeNode.IndexOfChild(AChild: TJclIntfTreeNode): Integer; begin for Result := 0 to ChildrenCount - 1 do if Children[Result] = AChild then Exit; Result := -1; end; function TJclIntfTreeNode.IndexOfValue(const AInterface: IInterface; const AEqualityComparer: IJclIntfEqualityComparer): Integer; begin for Result := 0 to ChildrenCount - 1 do if AEqualityComparer.ItemsEqual(TJclIntfTreeNode(Children[Result]).Value, AInterface) then Exit; Result := -1; end; //=== { TJclIntfTree } ======================================================= constructor TJclIntfTree.Create(); begin inherited Create(); FTraverseOrder := toPreOrder; end; destructor TJclIntfTree.Destroy; begin FReadOnly := False; Clear; inherited Destroy; end; function TJclIntfTree.Add(const AInterface: IInterface): Boolean; var NewNode: TJclIntfTreeNode; begin if ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginWrite; try {$ENDIF THREADSAFE} Result := AllowDefaultElements or not ItemsEqual(AInterface, nil); if Result then begin if FRoot <> nil then begin Result := (not Contains(AInterface)) or CheckDuplicate; if Result then begin if FRoot.ChildrenCount = Length(FRoot.Children) then SetLength(FRoot.Children, CalcGrowCapacity(Length(FRoot.Children), FRoot.ChildrenCount)); if FRoot.ChildrenCount < Length(FRoot.Children) then begin NewNode := TJclIntfTreeNode.Create; NewNode.Value := AInterface; NewNode.Parent := FRoot; FRoot.Children[FRoot.ChildrenCount] := NewNode; Inc(FRoot.ChildrenCount); Inc(FSize); end else Result := False; end; end else begin FRoot := TJclIntfTreeNode.Create; FRoot.Value := AInterface; Inc(FSize); end; end; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndWrite; end; {$ENDIF THREADSAFE} end; function TJclIntfTree.AddAll(const ACollection: IJclIntfCollection): Boolean; var It: IJclIntfIterator; begin if ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginWrite; try {$ENDIF THREADSAFE} Result := False; if ACollection = nil then Exit; Result := True; It := ACollection.First; while It.HasNext do Result := Add(It.Next) and Result; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndWrite; end; {$ENDIF THREADSAFE} end; procedure TJclIntfTree.AssignDataTo(Dest: TJclAbstractContainerBase); var ADest: TJclIntfTree; ACollection: IJclIntfCollection; begin inherited AssignDataTo(Dest); if Dest is TJclIntfTree then begin ADest := TJclIntfTree(Dest); ADest.Clear; ADest.FSize := FSize; if FRoot <> nil then ADest.FRoot := CloneNode(FRoot, nil); end else if Supports(IInterface(Dest), IJclIntfCollection, ACollection) then begin ACollection.Clear; ACollection.AddAll(Self); end; end; procedure TJclIntfTree.AssignPropertiesTo(Dest: TJclAbstractContainerBase); begin inherited AssignPropertiesto(Dest); if Dest is TJclIntfTree then TJclIntfTree(Dest).FTraverseOrder := FTraverseOrder; end; procedure TJclIntfTree.Clear; begin if ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginWrite; try {$ENDIF THREADSAFE} if FRoot <> nil then RemoveNode(FRoot); FSize := 0; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndWrite; end; {$ENDIF THREADSAFE} end; function TJclIntfTree.CloneNode(Node, Parent: TJclIntfTreeNode): TJclIntfTreeNode; var Index: Integer; begin Result := TJclIntfTreeNode.Create; Result.Value := Node.Value; Result.Parent := Parent; SetLength(Result.Children, Node.ChildrenCount); Result.ChildrenCount := Node.ChildrenCount; for Index := 0 to Node.ChildrenCount - 1 do Result.Children[Index] := CloneNode(TJclIntfTreeNode(Node.Children[Index]), Result); // recursive call end; function TJclIntfTree.CollectionEquals(const ACollection: IJclIntfCollection): Boolean; var It, ItSelf: IJclIntfIterator; begin {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginRead; try {$ENDIF THREADSAFE} Result := False; if ACollection = nil then Exit; if FSize <> ACollection.Size then Exit; Result := True; It := ACollection.First; ItSelf := First; while ItSelf.HasNext do if not ItemsEqual(ItSelf.Next, It.Next) then begin Result := False; Break; end; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndRead; end; {$ENDIF THREADSAFE} end; function TJclIntfTree.Contains(const AInterface: IInterface): Boolean; begin {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginRead; try {$ENDIF THREADSAFE} if FRoot <> nil then Result := NodeContains(FRoot, AInterface) else Result := False; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndRead; end; {$ENDIF THREADSAFE} end; function TJclIntfTree.ContainsAll(const ACollection: IJclIntfCollection): Boolean; var It: IJclIntfIterator; begin {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginRead; try {$ENDIF THREADSAFE} Result := True; if ACollection = nil then Exit; It := ACollection.First; while Result and It.HasNext do Result := Contains(It.Next); {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndRead; end; {$ENDIF THREADSAFE} end; function TJclIntfTree.Extract(const AInterface: IInterface): Boolean; var It: IJclIntfIterator; begin if ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginWrite; try {$ENDIF THREADSAFE} Result := FRoot <> nil; if Result then begin It := First; while It.HasNext do if ItemsEqual(It.Next, AInterface) then begin It.Extract; if RemoveSingleElement then Break; end; end; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndWrite; end; {$ENDIF THREADSAFE} end; function TJclIntfTree.ExtractAll(const ACollection: IJclIntfCollection): Boolean; var It: IJclIntfIterator; begin if ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginWrite; try {$ENDIF THREADSAFE} Result := False; if ACollection = nil then Exit; Result := True; It := ACollection.First; while It.HasNext do Result := Extract(It.Next) and Result; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndWrite; end; {$ENDIF THREADSAFE} end; procedure TJclIntfTree.ExtractNode(var ANode: TJclIntfTreeNode); var Index, ChildIndex, NewCapacity: Integer; Parent: TJclIntfTreeNode; begin for Index := ANode.ChildrenCount - 1 downto 0 do {$IFDEF BCB} ExtractNode(TJclIntfTreeNode(ANode.Children[Index])); {$ELSE ~BCB} ExtractNode(ANode.Children[Index]); {$ENDIF ~BCB} Parent := ANode.Parent; if Parent <> nil then begin ChildIndex := Parent.IndexOfChild(ANode); for Index := ChildIndex + 1 to Parent.ChildrenCount - 1 do Parent.Children[Index - 1] := Parent.Children[Index]; Dec(Parent.ChildrenCount); NewCapacity := CalcPackCapacity(Length(Parent.Children), Parent.ChildrenCount); if NewCapacity < Length(Parent.Children) then SetLength(Parent.Children, NewCapacity); FreeAndNil(ANode); end else begin FreeAndNil(ANode); FRoot := nil; end; Dec(FSize); end; function TJclIntfTree.First: IJclIntfIterator; var Start: TJclIntfTreeNode; begin {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginRead; try {$ENDIF THREADSAFE} Start := FRoot; case GetTraverseOrder of toPreOrder: Result := TJclPreOrderIntfTreeIterator.Create(Self, Start, False, isFirst); toPostOrder: begin if Start <> nil then while (Start.ChildrenCount > 0) do Start := TJclIntfTreeNode(Start.Children[0]); Result := TJclPostOrderIntfTreeIterator.Create(Self, Start, False, isFirst); end; else Result := nil; end; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndRead; end; {$ENDIF THREADSAFE} end; {$IFDEF SUPPORTS_FOR_IN} function TJclIntfTree.GetEnumerator: IJclIntfIterator; begin Result := First; end; {$ENDIF SUPPORTS_FOR_IN} function TJclIntfTree.GetRoot: IJclIntfTreeIterator; begin {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginRead; try {$ENDIF THREADSAFE} case GetTraverseOrder of toPreOrder: Result := TJclPreOrderIntfTreeIterator.Create(Self, FRoot, False, isRoot); toPostOrder: Result := TJclPostOrderIntfTreeIterator.Create(Self, FRoot, False, isRoot); else Result := nil; end; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndRead; end; {$ENDIF THREADSAFE} end; function TJclIntfTree.GetTraverseOrder: TJclTraverseOrder; begin Result := FTraverseOrder; end; function TJclIntfTree.IsEmpty: Boolean; begin Result := FSize = 0; end; function TJclIntfTree.Last: IJclIntfIterator; var Start: TJclIntfTreeNode; begin {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginRead; try {$ENDIF THREADSAFE} Start := FRoot; case FTraverseOrder of toPreOrder: begin if Start <> nil then while Start.ChildrenCount > 0 do Start := TJclIntfTreeNode(Start.Children[Start.ChildrenCount - 1]); Result := TJclPreOrderIntfTreeIterator.Create(Self, Start, False, isLast); end; toPostOrder: Result := TJclPostOrderIntfTreeIterator.Create(Self, Start, False, isLast); else Result := nil; end; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndRead; end; {$ENDIF THREADSAFE} end; function TJclIntfTree.NodeContains(ANode: TJclIntfTreeNode; const AInterface: IInterface): Boolean; var Index: Integer; begin Result := ItemsEqual(ANode.Value, AInterface); if not Result then for Index := 0 to ANode.ChildrenCount - 1 do begin Result := NodeContains(TJclIntfTreeNode(ANode.Children[Index]), AInterface); if Result then Break; end; end; procedure TJclIntfTree.Pack; begin if ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginWrite; try {$ENDIF THREADSAFE} if FRoot <> nil then PackNode(FRoot); {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndWrite; end; {$ENDIF THREADSAFE} end; procedure TJclIntfTree.PackNode(ANode: TJclIntfTreeNode); var Index: Integer; begin SetLength(ANode.Children, ANode.ChildrenCount); for Index := 0 to ANode.ChildrenCount - 1 do PackNode(TJclIntfTreeNode(ANode.Children[Index])); end; function TJclIntfTree.Remove(const AInterface: IInterface): Boolean; var Extracted: IInterface; begin if ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginWrite; try {$ENDIF THREADSAFE} Result := Extract(AInterface); if Result then begin Extracted := AInterface; FreeObject(Extracted); end; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndWrite; end; {$ENDIF THREADSAFE} end; function TJclIntfTree.RemoveAll(const ACollection: IJclIntfCollection): Boolean; var It: IJclIntfIterator; begin if ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginWrite; try {$ENDIF THREADSAFE} Result := False; if ACollection = nil then Exit; Result := True; It := ACollection.First; while It.HasNext do Result := Remove(It.Next) and Result; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndWrite; end; {$ENDIF THREADSAFE} end; procedure TJclIntfTree.RemoveNode(var ANode: TJclIntfTreeNode); var Index, ChildIndex, NewCapacity: Integer; Parent: TJclIntfTreeNode; begin for Index := ANode.ChildrenCount - 1 downto 0 do {$IFDEF BCB} RemoveNode(TJclIntfTreeNode(ANode.Children[Index])); {$ELSE ~BCB} RemoveNode(ANode.Children[Index]); {$ENDIF ~BCB} FreeObject(ANode.Value); Parent := ANode.Parent; if Parent <> nil then begin ChildIndex := Parent.IndexOfChild(ANode); for Index := ChildIndex + 1 to Parent.ChildrenCount - 1 do Parent.Children[Index - 1] := Parent.Children[Index]; Dec(Parent.ChildrenCount); NewCapacity := CalcPackCapacity(Length(Parent.Children), Parent.ChildrenCount); if NewCapacity < Length(Parent.Children) then SetLength(Parent.Children, NewCapacity); FreeAndNil(ANode); end else begin FreeAndNil(ANode); FRoot := nil; end; Dec(FSize); end; function TJclIntfTree.RetainAll(const ACollection: IJclIntfCollection): Boolean; var It: IJclIntfIterator; begin if ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginWrite; try {$ENDIF THREADSAFE} Result := False; if ACollection = nil then Exit; Result := True; It := First; while It.HasNext do if not ACollection.Contains(It.Next) then It.Remove; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndWrite; end; {$ENDIF THREADSAFE} end; procedure TJclIntfTree.SetCapacity(Value: Integer); begin raise EJclOperationNotSupportedError.Create; end; procedure TJclIntfTree.SetTraverseOrder(Value: TJclTraverseOrder); begin FTraverseOrder := Value; end; function TJclIntfTree.Size: Integer; begin Result := FSize; end; function TJclIntfTree.CreateEmptyContainer: TJclAbstractContainerBase; begin Result := TJclIntfTree.Create; AssignPropertiesTo(Result); end; //=== { TJclIntfTreeIterator } =========================================================== constructor TJclIntfTreeIterator.Create(OwnTree: TJclIntfTree; ACursor: TJclIntfTreeNode; AValid: Boolean; AStart: TItrStart); begin inherited Create(AValid); FCursor := ACursor; FOwnTree := OwnTree; FStart := AStart; FEqualityComparer := OwnTree as IJclIntfEqualityComparer; end; function TJclIntfTreeIterator.Add(const AInterface: IInterface): Boolean; var ParentNode, NewNode: TJclIntfTreeNode; begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} // add sibling or, if FCursor is root node, behave like TJclIntfTree.Add Result := (FCursor <> nil) and (FOwnTree.AllowDefaultElements or not FEqualityComparer.ItemsEqual(AInterface, nil)) and ((not FOwnTree.Contains(AInterface)) or FOwnTree.CheckDuplicate); if Result then begin ParentNode := FCursor.Parent; if ParentNode = nil then ParentNode := FCursor; if ParentNode.ChildrenCount = Length(ParentNode.Children) then SetLength(ParentNode.Children, FOwnTree.CalcGrowCapacity(Length(ParentNode.Children), ParentNode.ChildrenCount)); if ParentNode.ChildrenCount < Length(ParentNode.Children) then begin NewNode := TJclIntfTreeNode.Create; NewNode.Value := AInterface; NewNode.Parent := ParentNode; ParentNode.Children[ParentNode.ChildrenCount] := NewNode; Inc(ParentNode.ChildrenCount); Inc(FOwnTree.FSize); end; end; {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; function TJclIntfTreeIterator.AddChild(const AInterface: IInterface): Boolean; var NewNode: TJclIntfTreeNode; begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} Result := (FCursor <> nil) and (FOwnTree.AllowDefaultElements or not FEqualityComparer.ItemsEqual(AInterface, nil)) and ((not FOwnTree.Contains(AInterface)) or FOwnTree.CheckDuplicate); if Result then begin if FCursor.ChildrenCount = Length(FCursor.Children) then SetLength(FCursor.Children, FOwnTree.CalcGrowCapacity(Length(FCursor.Children), FCursor.ChildrenCount)); if FCursor.ChildrenCount < Length(FCursor.Children) then begin NewNode := TJclIntfTreeNode.Create; NewNode.Value := AInterface; NewNode.Parent := FCursor; FCursor.Children[FCursor.ChildrenCount] := NewNode; Inc(FCursor.ChildrenCount); Inc(FOwnTree.FSize); end; end; {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; procedure TJclIntfTreeIterator.AssignPropertiesTo(Dest: TJclAbstractIterator); var ADest: TJclIntfTreeIterator; begin inherited AssignPropertiesTo(Dest); if Dest is TJclIntfTreeIterator then begin ADest := TJclIntfTreeIterator(Dest); ADest.FCursor := FCursor; ADest.FOwnTree := FOwnTree; ADest.FEqualityComparer := FEqualityComparer; ADest.FStart := FStart; end; end; function TJclIntfTreeIterator.ChildrenCount: Integer; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} if FCursor <> nil then Result := FCursor.ChildrenCount else Result := 0; {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; procedure TJclIntfTreeIterator.DeleteChild(Index: Integer); begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} if (FCursor <> nil) and (Index >= 0) and (Index < FCursor.ChildrenCount) then {$IFDEF BCB} FOwnTree.RemoveNode(TJclIntfTreeNode(FCursor.Children[Index])) {$ELSE ~BCB} FOwnTree.RemoveNode(FCursor.Children[Index]) {$ENDIF ~BCB} else raise EJclOutOfBoundsError.Create; {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; procedure TJclIntfTreeIterator.DeleteChildren; var Index: Integer; begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} if FCursor <> nil then begin for Index := FCursor.ChildrenCount - 1 downto 0 do {$IFDEF BCB} FOwnTree.RemoveNode(TJclIntfTreeNode(FCursor.Children[Index])); {$ELSE ~BCB} FOwnTree.RemoveNode(FCursor.Children[Index]); {$ENDIF ~BCB} SetLength(FCursor.Children, 0); FCursor.ChildrenCount := 0; end; {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; procedure TJclIntfTreeIterator.Extract; var OldCursor: TJclIntfTreeNode; begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} CheckValid; Valid := False; OldCursor := FCursor; FCursor := GetNextSibling; if OldCursor <> nil then FOwnTree.ExtractNode(OldCursor); {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; procedure TJclIntfTreeIterator.ExtractChild(Index: Integer); begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} if (FCursor <> nil) and (Index >= 0) and (Index < FCursor.ChildrenCount) then {$IFDEF BCB} FOwnTree.ExtractNode(TJclIntfTreeNode(FCursor.Children[Index])) {$ELSE ~BCB} FOwnTree.ExtractNode(FCursor.Children[Index]) {$ENDIF ~BCB} else raise EJclOutOfBoundsError.Create; {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; procedure TJclIntfTreeIterator.ExtractChildren; var Index: Integer; begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} if FCursor <> nil then begin for Index := FCursor.ChildrenCount - 1 downto 0 do {$IFDEF BCB} FOwnTree.ExtractNode(TJclIntfTreeNode(FCursor.Children[Index])); {$ELSE ~BCB} FOwnTree.ExtractNode(FCursor.Children[Index]); {$ENDIF ~BCB} SetLength(FCursor.Children, 0); FCursor.ChildrenCount := 0; end; {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; function TJclIntfTreeIterator.GetChild(Index: Integer): IInterface; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} Result := nil; if (FCursor <> nil) and (Index >= 0) and (Index < FCursor.ChildrenCount) then FCursor := TJclIntfTreeNode(FCursor.Children[Index]); if FCursor <> nil then Result := FCursor.Value else if not FOwnTree.ReturnDefaultElements then raise EJclNoSuchElementError.Create(''); {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; function TJclIntfTreeIterator.GetObject: IInterface; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} CheckValid; Result := nil; if FCursor <> nil then Result := FCursor.Value else if not FOwnTree.ReturnDefaultElements then raise EJclNoSuchElementError.Create(''); {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; function TJclIntfTreeIterator.HasChild(Index: Integer): Boolean; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} Result := (FCursor <> nil) and (Index >= 0) and (Index < FCursor.ChildrenCount); {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; function TJclIntfTreeIterator.HasNext: Boolean; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} if Valid then Result := GetNextCursor <> nil else Result := FCursor <> nil; {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; function TJclIntfTreeIterator.HasParent: Boolean; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} Result := (FCursor <> nil) and (FCursor.Parent <> nil); {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; function TJclIntfTreeIterator.HasPrevious: Boolean; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} if Valid then Result := GetPreviousCursor <> nil else Result := FCursor <> nil; {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; function TJclIntfTreeIterator.IndexOfChild(const AInterface: IInterface): Integer; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} if FCursor <> nil then Result := FCursor.IndexOfValue(AInterface, FEqualityComparer) else Result := -1; {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; function TJclIntfTreeIterator.Insert(const AInterface: IInterface): Boolean; var ParentNode, NewNode: TJclIntfTreeNode; Index, I: Integer; begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} // insert sibling or, if FCursor is root node, behave like TJclIntfTree.Insert Result := (FCursor <> nil) and (FOwnTree.AllowDefaultElements or not FEqualityComparer.ItemsEqual(AInterface, nil)) and ((not FOwnTree.Contains(AInterface)) or FOwnTree.CheckDuplicate); if Result then begin if FCursor.Parent <> nil then begin ParentNode := FCursor.Parent; Index := 0; while (Index < ParentNode.ChildrenCount) and (ParentNode.Children[Index] <> FCursor) do Inc(Index); end else begin ParentNode := FCursor; Index := 0; end; if ParentNode.ChildrenCount = Length(ParentNode.Children) then SetLength(ParentNode.Children, FOwnTree.CalcGrowCapacity(Length(ParentNode.Children), ParentNode.ChildrenCount)); if ParentNode.ChildrenCount < Length(ParentNode.Children) then begin NewNode := TJclIntfTreeNode.Create; NewNode.Value := AInterface; NewNode.Parent := ParentNode; for I := ParentNode.ChildrenCount - 1 downto Index do ParentNode.Children[I + 1] := ParentNode.Children[I]; ParentNode.Children[Index] := NewNode; Inc(ParentNode.ChildrenCount); Inc(FOwnTree.FSize); end; end; {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; function TJclIntfTreeIterator.InsertChild(Index: Integer; const AInterface: IInterface): Boolean; var NewNode: TJclIntfTreeNode; I: Integer; begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} // insert sibling or, if FCursor is root node, behave like TJclIntfTree.Insert Result := (FCursor <> nil) and (FOwnTree.AllowDefaultElements or not FEqualityComparer.ItemsEqual(AInterface, nil)) and ((not FOwnTree.Contains(AInterface)) or FOwnTree.CheckDuplicate); if Result then begin if FCursor.ChildrenCount = Length(FCursor.Children) then SetLength(FCursor.Children, FOwnTree.CalcGrowCapacity(Length(FCursor.Children), FCursor.ChildrenCount)); if FCursor.ChildrenCount < Length(FCursor.Children) then begin NewNode := TJclIntfTreeNode.Create; NewNode.Value := AInterface; NewNode.Parent := FCursor; for I := FCursor.ChildrenCount - 1 downto Index do FCursor.Children[I + 1] := FCursor.Children[I]; FCursor.Children[Index] := NewNode; Inc(FCursor.ChildrenCount); Inc(FOwnTree.FSize); end; end; {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; function TJclIntfTreeIterator.IteratorEquals(const AIterator: IJclIntfIterator): Boolean; var Obj: TObject; ItrObj: TJclIntfTreeIterator; begin Result := False; if AIterator = nil then Exit; Obj := AIterator.GetIteratorReference; if Obj is TJclIntfTreeIterator then begin ItrObj := TJclIntfTreeIterator(Obj); Result := (FOwnTree = ItrObj.FOwnTree) and (FCursor = ItrObj.FCursor) and (Valid = ItrObj.Valid); end; end; {$IFDEF SUPPORTS_FOR_IN} function TJclIntfTreeIterator.MoveNext: Boolean; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} if Valid then FCursor := GetNextCursor else Valid := True; Result := FCursor <> nil; {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; {$ENDIF SUPPORTS_FOR_IN} function TJclIntfTreeIterator.Next: IInterface; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} if Valid then FCursor := GetNextCursor else Valid := True; Result := nil; if FCursor <> nil then Result := FCursor.Value else if not FOwnTree.ReturnDefaultElements then raise EJclNoSuchElementError.Create(''); {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; function TJclIntfTreeIterator.NextIndex: Integer; begin // No index raise EJclOperationNotSupportedError.Create; end; function TJclIntfTreeIterator.Parent: IInterface; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} Result := nil; if FCursor <> nil then FCursor := FCursor.Parent; if FCursor <> nil then Result := FCursor.Value else if not FOwnTree.ReturnDefaultElements then raise EJclNoSuchElementError.Create(''); {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; function TJclIntfTreeIterator.Previous: IInterface; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} if Valid then FCursor := GetPreviousCursor else Valid := True; Result := nil; if FCursor <> nil then Result := FCursor.Value else if not FOwnTree.ReturnDefaultElements then raise EJclNoSuchElementError.Create(''); {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; function TJclIntfTreeIterator.PreviousIndex: Integer; begin // No index raise EJclOperationNotSupportedError.Create; end; procedure TJclIntfTreeIterator.Remove; var OldCursor: TJclIntfTreeNode; begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} CheckValid; Valid := False; OldCursor := FCursor; FCursor := GetNextSibling; if OldCursor <> nil then FOwnTree.RemoveNode(OldCursor); {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; procedure TJclIntfTreeIterator.Reset; var NewCursor: TJclIntfTreeNode; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} Valid := False; case FStart of isFirst: begin NewCursor := FCursor; while NewCursor <> nil do begin NewCursor := GetPreviousCursor; if NewCursor <> nil then FCursor := NewCursor; end; end; isLast: begin NewCursor := FCursor; while NewCursor <> nil do begin NewCursor := GetNextCursor; if NewCursor <> nil then FCursor := NewCursor; end; end; isRoot: begin while (FCursor <> nil) and (FCursor.Parent <> nil) do FCursor := FCursor.Parent; end; end; {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; procedure TJclIntfTreeIterator.SetChild(Index: Integer; const AInterface: IInterface); begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} if (FCursor <> nil) and (Index >= 0) and (Index < FCursor.ChildrenCount) then TJclIntfTreeNode(FCursor.Children[Index]).Value := AInterface else raise EJclOutOfBoundsError.Create; {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; procedure TJclIntfTreeIterator.SetObject(const AInterface: IInterface); begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} CheckValid; if FCursor <> nil then begin FOwnTree.FreeObject(FCursor.Value); FCursor.Value := AInterface; end; {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; //=== { TJclPreOrderIntfTreeIterator } =================================================== function TJclPreOrderIntfTreeIterator.CreateEmptyIterator: TJclAbstractIterator; begin Result := TJclPreOrderIntfTreeIterator.Create(FOwnTree, FCursor, Valid, FStart); end; function TJclPreOrderIntfTreeIterator.GetNextCursor: TJclIntfTreeNode; var LastRet: TJclIntfTreeNode; begin Result := FCursor; if Result = nil then Exit; LastRet := Result; if Result.ChildrenCount > 0 then Result := TJclIntfTreeNode(Result.Children[0]) else begin Result := Result.Parent; while (Result <> nil) and (Result.IndexOfChild(LastRet) = (Result.ChildrenCount - 1)) do begin LastRet := Result; Result := Result.Parent; end; if Result <> nil then // not root = return successor Result := TJclIntfTreeNode(Result.Children[Result.IndexOfChild(LastRet) + 1]); end; end; function TJclPreOrderIntfTreeIterator.GetNextSibling: TJclIntfTreeNode; var LastRet: TJclIntfTreeNode; begin Result := FCursor; if Result = nil then Exit; LastRet := Result; Result := Result.Parent; while (Result <> nil) and (Result.IndexOfChild(LastRet) = (Result.ChildrenCount - 1)) do begin LastRet := Result; Result := Result.Parent; end; if Result <> nil then // not root = return successor Result := TJclIntfTreeNode(Result.Children[Result.IndexOfChild(LastRet) + 1]); end; function TJclPreOrderIntfTreeIterator.GetPreviousCursor: TJclIntfTreeNode; var LastRet: TJclIntfTreeNode; begin Result := FCursor; if Result = nil then Exit; LastRet := Result; Result := Result.Parent; if (Result <> nil) and (Result.IndexOfChild(LastRet) > 0) then // come from Right begin Result := TJclIntfTreeNode(Result.Children[Result.IndexOfChild(LastRet) - 1]); while (Result.ChildrenCount > 0) do // descend down the tree Result := TJclIntfTreeNode(Result.Children[Result.ChildrenCount - 1]); end; end; //=== { TJclPostOrderIntfTreeIterator } ================================================== function TJclPostOrderIntfTreeIterator.CreateEmptyIterator: TJclAbstractIterator; begin Result := TJclPostOrderIntfTreeIterator.Create(FOwnTree, FCursor, Valid, FStart); end; function TJclPostOrderIntfTreeIterator.GetNextCursor: TJclIntfTreeNode; var LastRet: TJclIntfTreeNode; begin Result := FCursor; if Result = nil then Exit; LastRet := Result; Result := Result.Parent; if (Result <> nil) and (Result.IndexOfChild(LastRet) <> (Result.ChildrenCount - 1)) then begin Result := TJclIntfTreeNode(Result.Children[Result.IndexOfChild(LastRet) + 1]); while Result.ChildrenCount > 0 do Result := TJclIntfTreeNode(Result.Children[0]); end; end; function TJclPostOrderIntfTreeIterator.GetNextSibling: TJclIntfTreeNode; var LastRet: TJclIntfTreeNode; begin Result := FCursor; if Result = nil then Exit; LastRet := Result; Result := Result.Parent; if (Result <> nil) and (Result.IndexOfChild(LastRet) <> (Result.ChildrenCount - 1)) then begin Result := TJclIntfTreeNode(Result.Children[Result.IndexOfChild(LastRet) + 1]); while Result.ChildrenCount > 0 do Result := TJclIntfTreeNode(Result.Children[0]); end; end; function TJclPostOrderIntfTreeIterator.GetPreviousCursor: TJclIntfTreeNode; var LastRet: TJclIntfTreeNode; begin Result := FCursor; if Result = nil then Exit; if Result.ChildrenCount > 0 then Result := TJclIntfTreeNode(Result.Children[Result.ChildrenCount - 1]) else begin LastRet := Result; Result := Result.Parent; while (Result <> nil) and (Result.IndexOfChild(LastRet) = 0) do begin LastRet := Result; Result := Result.Parent; end; if Result <> nil then // not root Result := TJclIntfTreeNode(Result.Children[Result.IndexOfChild(LastRet) - 1]); end; end; //=== { TJclAnsiStrTreeNode } ======================================================= function TJclAnsiStrTreeNode.IndexOfChild(AChild: TJclAnsiStrTreeNode): Integer; begin for Result := 0 to ChildrenCount - 1 do if Children[Result] = AChild then Exit; Result := -1; end; function TJclAnsiStrTreeNode.IndexOfValue(const AString: AnsiString; const AEqualityComparer: IJclAnsiStrEqualityComparer): Integer; begin for Result := 0 to ChildrenCount - 1 do if AEqualityComparer.ItemsEqual(TJclAnsiStrTreeNode(Children[Result]).Value, AString) then Exit; Result := -1; end; //=== { TJclAnsiStrTree } ======================================================= constructor TJclAnsiStrTree.Create(); begin inherited Create(); FTraverseOrder := toPreOrder; end; destructor TJclAnsiStrTree.Destroy; begin FReadOnly := False; Clear; inherited Destroy; end; function TJclAnsiStrTree.Add(const AString: AnsiString): Boolean; var NewNode: TJclAnsiStrTreeNode; begin if ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginWrite; try {$ENDIF THREADSAFE} Result := AllowDefaultElements or not ItemsEqual(AString, ''); if Result then begin if FRoot <> nil then begin Result := (not Contains(AString)) or CheckDuplicate; if Result then begin if FRoot.ChildrenCount = Length(FRoot.Children) then SetLength(FRoot.Children, CalcGrowCapacity(Length(FRoot.Children), FRoot.ChildrenCount)); if FRoot.ChildrenCount < Length(FRoot.Children) then begin NewNode := TJclAnsiStrTreeNode.Create; NewNode.Value := AString; NewNode.Parent := FRoot; FRoot.Children[FRoot.ChildrenCount] := NewNode; Inc(FRoot.ChildrenCount); Inc(FSize); end else Result := False; end; end else begin FRoot := TJclAnsiStrTreeNode.Create; FRoot.Value := AString; Inc(FSize); end; end; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndWrite; end; {$ENDIF THREADSAFE} end; function TJclAnsiStrTree.AddAll(const ACollection: IJclAnsiStrCollection): Boolean; var It: IJclAnsiStrIterator; begin if ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginWrite; try {$ENDIF THREADSAFE} Result := False; if ACollection = nil then Exit; Result := True; It := ACollection.First; while It.HasNext do Result := Add(It.Next) and Result; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndWrite; end; {$ENDIF THREADSAFE} end; procedure TJclAnsiStrTree.AssignDataTo(Dest: TJclAbstractContainerBase); var ADest: TJclAnsiStrTree; ACollection: IJclAnsiStrCollection; begin inherited AssignDataTo(Dest); if Dest is TJclAnsiStrTree then begin ADest := TJclAnsiStrTree(Dest); ADest.Clear; ADest.FSize := FSize; if FRoot <> nil then ADest.FRoot := CloneNode(FRoot, nil); end else if Supports(IInterface(Dest), IJclAnsiStrCollection, ACollection) then begin ACollection.Clear; ACollection.AddAll(Self); end; end; procedure TJclAnsiStrTree.AssignPropertiesTo(Dest: TJclAbstractContainerBase); begin inherited AssignPropertiesto(Dest); if Dest is TJclAnsiStrTree then TJclAnsiStrTree(Dest).FTraverseOrder := FTraverseOrder; end; procedure TJclAnsiStrTree.Clear; begin if ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginWrite; try {$ENDIF THREADSAFE} if FRoot <> nil then RemoveNode(FRoot); FSize := 0; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndWrite; end; {$ENDIF THREADSAFE} end; function TJclAnsiStrTree.CloneNode(Node, Parent: TJclAnsiStrTreeNode): TJclAnsiStrTreeNode; var Index: Integer; begin Result := TJclAnsiStrTreeNode.Create; Result.Value := Node.Value; Result.Parent := Parent; SetLength(Result.Children, Node.ChildrenCount); Result.ChildrenCount := Node.ChildrenCount; for Index := 0 to Node.ChildrenCount - 1 do Result.Children[Index] := CloneNode(TJclAnsiStrTreeNode(Node.Children[Index]), Result); // recursive call end; function TJclAnsiStrTree.CollectionEquals(const ACollection: IJclAnsiStrCollection): Boolean; var It, ItSelf: IJclAnsiStrIterator; begin {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginRead; try {$ENDIF THREADSAFE} Result := False; if ACollection = nil then Exit; if FSize <> ACollection.Size then Exit; Result := True; It := ACollection.First; ItSelf := First; while ItSelf.HasNext do if not ItemsEqual(ItSelf.Next, It.Next) then begin Result := False; Break; end; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndRead; end; {$ENDIF THREADSAFE} end; function TJclAnsiStrTree.Contains(const AString: AnsiString): Boolean; begin {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginRead; try {$ENDIF THREADSAFE} if FRoot <> nil then Result := NodeContains(FRoot, AString) else Result := False; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndRead; end; {$ENDIF THREADSAFE} end; function TJclAnsiStrTree.ContainsAll(const ACollection: IJclAnsiStrCollection): Boolean; var It: IJclAnsiStrIterator; begin {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginRead; try {$ENDIF THREADSAFE} Result := True; if ACollection = nil then Exit; It := ACollection.First; while Result and It.HasNext do Result := Contains(It.Next); {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndRead; end; {$ENDIF THREADSAFE} end; function TJclAnsiStrTree.Extract(const AString: AnsiString): Boolean; var It: IJclAnsiStrIterator; begin if ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginWrite; try {$ENDIF THREADSAFE} Result := FRoot <> nil; if Result then begin It := First; while It.HasNext do if ItemsEqual(It.Next, AString) then begin It.Extract; if RemoveSingleElement then Break; end; end; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndWrite; end; {$ENDIF THREADSAFE} end; function TJclAnsiStrTree.ExtractAll(const ACollection: IJclAnsiStrCollection): Boolean; var It: IJclAnsiStrIterator; begin if ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginWrite; try {$ENDIF THREADSAFE} Result := False; if ACollection = nil then Exit; Result := True; It := ACollection.First; while It.HasNext do Result := Extract(It.Next) and Result; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndWrite; end; {$ENDIF THREADSAFE} end; procedure TJclAnsiStrTree.ExtractNode(var ANode: TJclAnsiStrTreeNode); var Index, ChildIndex, NewCapacity: Integer; Parent: TJclAnsiStrTreeNode; begin for Index := ANode.ChildrenCount - 1 downto 0 do {$IFDEF BCB} ExtractNode(TJclAnsiStrTreeNode(ANode.Children[Index])); {$ELSE ~BCB} ExtractNode(ANode.Children[Index]); {$ENDIF ~BCB} Parent := ANode.Parent; if Parent <> nil then begin ChildIndex := Parent.IndexOfChild(ANode); for Index := ChildIndex + 1 to Parent.ChildrenCount - 1 do Parent.Children[Index - 1] := Parent.Children[Index]; Dec(Parent.ChildrenCount); NewCapacity := CalcPackCapacity(Length(Parent.Children), Parent.ChildrenCount); if NewCapacity < Length(Parent.Children) then SetLength(Parent.Children, NewCapacity); FreeAndNil(ANode); end else begin FreeAndNil(ANode); FRoot := nil; end; Dec(FSize); end; function TJclAnsiStrTree.First: IJclAnsiStrIterator; var Start: TJclAnsiStrTreeNode; begin {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginRead; try {$ENDIF THREADSAFE} Start := FRoot; case GetTraverseOrder of toPreOrder: Result := TJclPreOrderAnsiStrTreeIterator.Create(Self, Start, False, isFirst); toPostOrder: begin if Start <> nil then while (Start.ChildrenCount > 0) do Start := TJclAnsiStrTreeNode(Start.Children[0]); Result := TJclPostOrderAnsiStrTreeIterator.Create(Self, Start, False, isFirst); end; else Result := nil; end; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndRead; end; {$ENDIF THREADSAFE} end; {$IFDEF SUPPORTS_FOR_IN} function TJclAnsiStrTree.GetEnumerator: IJclAnsiStrIterator; begin Result := First; end; {$ENDIF SUPPORTS_FOR_IN} function TJclAnsiStrTree.GetRoot: IJclAnsiStrTreeIterator; begin {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginRead; try {$ENDIF THREADSAFE} case GetTraverseOrder of toPreOrder: Result := TJclPreOrderAnsiStrTreeIterator.Create(Self, FRoot, False, isRoot); toPostOrder: Result := TJclPostOrderAnsiStrTreeIterator.Create(Self, FRoot, False, isRoot); else Result := nil; end; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndRead; end; {$ENDIF THREADSAFE} end; function TJclAnsiStrTree.GetTraverseOrder: TJclTraverseOrder; begin Result := FTraverseOrder; end; function TJclAnsiStrTree.IsEmpty: Boolean; begin Result := FSize = 0; end; function TJclAnsiStrTree.Last: IJclAnsiStrIterator; var Start: TJclAnsiStrTreeNode; begin {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginRead; try {$ENDIF THREADSAFE} Start := FRoot; case FTraverseOrder of toPreOrder: begin if Start <> nil then while Start.ChildrenCount > 0 do Start := TJclAnsiStrTreeNode(Start.Children[Start.ChildrenCount - 1]); Result := TJclPreOrderAnsiStrTreeIterator.Create(Self, Start, False, isLast); end; toPostOrder: Result := TJclPostOrderAnsiStrTreeIterator.Create(Self, Start, False, isLast); else Result := nil; end; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndRead; end; {$ENDIF THREADSAFE} end; function TJclAnsiStrTree.NodeContains(ANode: TJclAnsiStrTreeNode; const AString: AnsiString): Boolean; var Index: Integer; begin Result := ItemsEqual(ANode.Value, AString); if not Result then for Index := 0 to ANode.ChildrenCount - 1 do begin Result := NodeContains(TJclAnsiStrTreeNode(ANode.Children[Index]), AString); if Result then Break; end; end; procedure TJclAnsiStrTree.Pack; begin if ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginWrite; try {$ENDIF THREADSAFE} if FRoot <> nil then PackNode(FRoot); {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndWrite; end; {$ENDIF THREADSAFE} end; procedure TJclAnsiStrTree.PackNode(ANode: TJclAnsiStrTreeNode); var Index: Integer; begin SetLength(ANode.Children, ANode.ChildrenCount); for Index := 0 to ANode.ChildrenCount - 1 do PackNode(TJclAnsiStrTreeNode(ANode.Children[Index])); end; function TJclAnsiStrTree.Remove(const AString: AnsiString): Boolean; var Extracted: AnsiString; begin if ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginWrite; try {$ENDIF THREADSAFE} Result := Extract(AString); if Result then begin Extracted := AString; FreeString(Extracted); end; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndWrite; end; {$ENDIF THREADSAFE} end; function TJclAnsiStrTree.RemoveAll(const ACollection: IJclAnsiStrCollection): Boolean; var It: IJclAnsiStrIterator; begin if ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginWrite; try {$ENDIF THREADSAFE} Result := False; if ACollection = nil then Exit; Result := True; It := ACollection.First; while It.HasNext do Result := Remove(It.Next) and Result; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndWrite; end; {$ENDIF THREADSAFE} end; procedure TJclAnsiStrTree.RemoveNode(var ANode: TJclAnsiStrTreeNode); var Index, ChildIndex, NewCapacity: Integer; Parent: TJclAnsiStrTreeNode; begin for Index := ANode.ChildrenCount - 1 downto 0 do {$IFDEF BCB} RemoveNode(TJclAnsiStrTreeNode(ANode.Children[Index])); {$ELSE ~BCB} RemoveNode(ANode.Children[Index]); {$ENDIF ~BCB} FreeString(ANode.Value); Parent := ANode.Parent; if Parent <> nil then begin ChildIndex := Parent.IndexOfChild(ANode); for Index := ChildIndex + 1 to Parent.ChildrenCount - 1 do Parent.Children[Index - 1] := Parent.Children[Index]; Dec(Parent.ChildrenCount); NewCapacity := CalcPackCapacity(Length(Parent.Children), Parent.ChildrenCount); if NewCapacity < Length(Parent.Children) then SetLength(Parent.Children, NewCapacity); FreeAndNil(ANode); end else begin FreeAndNil(ANode); FRoot := nil; end; Dec(FSize); end; function TJclAnsiStrTree.RetainAll(const ACollection: IJclAnsiStrCollection): Boolean; var It: IJclAnsiStrIterator; begin if ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginWrite; try {$ENDIF THREADSAFE} Result := False; if ACollection = nil then Exit; Result := True; It := First; while It.HasNext do if not ACollection.Contains(It.Next) then It.Remove; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndWrite; end; {$ENDIF THREADSAFE} end; procedure TJclAnsiStrTree.SetCapacity(Value: Integer); begin raise EJclOperationNotSupportedError.Create; end; procedure TJclAnsiStrTree.SetTraverseOrder(Value: TJclTraverseOrder); begin FTraverseOrder := Value; end; function TJclAnsiStrTree.Size: Integer; begin Result := FSize; end; function TJclAnsiStrTree.CreateEmptyContainer: TJclAbstractContainerBase; begin Result := TJclAnsiStrTree.Create; AssignPropertiesTo(Result); end; //=== { TJclAnsiStrTreeIterator } =========================================================== constructor TJclAnsiStrTreeIterator.Create(OwnTree: TJclAnsiStrTree; ACursor: TJclAnsiStrTreeNode; AValid: Boolean; AStart: TItrStart); begin inherited Create(AValid); FCursor := ACursor; FOwnTree := OwnTree; FStart := AStart; FEqualityComparer := OwnTree as IJclAnsiStrEqualityComparer; end; function TJclAnsiStrTreeIterator.Add(const AString: AnsiString): Boolean; var ParentNode, NewNode: TJclAnsiStrTreeNode; begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} // add sibling or, if FCursor is root node, behave like TJclAnsiStrTree.Add Result := (FCursor <> nil) and (FOwnTree.AllowDefaultElements or not FEqualityComparer.ItemsEqual(AString, '')) and ((not FOwnTree.Contains(AString)) or FOwnTree.CheckDuplicate); if Result then begin ParentNode := FCursor.Parent; if ParentNode = nil then ParentNode := FCursor; if ParentNode.ChildrenCount = Length(ParentNode.Children) then SetLength(ParentNode.Children, FOwnTree.CalcGrowCapacity(Length(ParentNode.Children), ParentNode.ChildrenCount)); if ParentNode.ChildrenCount < Length(ParentNode.Children) then begin NewNode := TJclAnsiStrTreeNode.Create; NewNode.Value := AString; NewNode.Parent := ParentNode; ParentNode.Children[ParentNode.ChildrenCount] := NewNode; Inc(ParentNode.ChildrenCount); Inc(FOwnTree.FSize); end; end; {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; function TJclAnsiStrTreeIterator.AddChild(const AString: AnsiString): Boolean; var NewNode: TJclAnsiStrTreeNode; begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} Result := (FCursor <> nil) and (FOwnTree.AllowDefaultElements or not FEqualityComparer.ItemsEqual(AString, '')) and ((not FOwnTree.Contains(AString)) or FOwnTree.CheckDuplicate); if Result then begin if FCursor.ChildrenCount = Length(FCursor.Children) then SetLength(FCursor.Children, FOwnTree.CalcGrowCapacity(Length(FCursor.Children), FCursor.ChildrenCount)); if FCursor.ChildrenCount < Length(FCursor.Children) then begin NewNode := TJclAnsiStrTreeNode.Create; NewNode.Value := AString; NewNode.Parent := FCursor; FCursor.Children[FCursor.ChildrenCount] := NewNode; Inc(FCursor.ChildrenCount); Inc(FOwnTree.FSize); end; end; {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; procedure TJclAnsiStrTreeIterator.AssignPropertiesTo(Dest: TJclAbstractIterator); var ADest: TJclAnsiStrTreeIterator; begin inherited AssignPropertiesTo(Dest); if Dest is TJclAnsiStrTreeIterator then begin ADest := TJclAnsiStrTreeIterator(Dest); ADest.FCursor := FCursor; ADest.FOwnTree := FOwnTree; ADest.FEqualityComparer := FEqualityComparer; ADest.FStart := FStart; end; end; function TJclAnsiStrTreeIterator.ChildrenCount: Integer; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} if FCursor <> nil then Result := FCursor.ChildrenCount else Result := 0; {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; procedure TJclAnsiStrTreeIterator.DeleteChild(Index: Integer); begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} if (FCursor <> nil) and (Index >= 0) and (Index < FCursor.ChildrenCount) then {$IFDEF BCB} FOwnTree.RemoveNode(TJclAnsiStrTreeNode(FCursor.Children[Index])) {$ELSE ~BCB} FOwnTree.RemoveNode(FCursor.Children[Index]) {$ENDIF ~BCB} else raise EJclOutOfBoundsError.Create; {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; procedure TJclAnsiStrTreeIterator.DeleteChildren; var Index: Integer; begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} if FCursor <> nil then begin for Index := FCursor.ChildrenCount - 1 downto 0 do {$IFDEF BCB} FOwnTree.RemoveNode(TJclAnsiStrTreeNode(FCursor.Children[Index])); {$ELSE ~BCB} FOwnTree.RemoveNode(FCursor.Children[Index]); {$ENDIF ~BCB} SetLength(FCursor.Children, 0); FCursor.ChildrenCount := 0; end; {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; procedure TJclAnsiStrTreeIterator.Extract; var OldCursor: TJclAnsiStrTreeNode; begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} CheckValid; Valid := False; OldCursor := FCursor; FCursor := GetNextSibling; if OldCursor <> nil then FOwnTree.ExtractNode(OldCursor); {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; procedure TJclAnsiStrTreeIterator.ExtractChild(Index: Integer); begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} if (FCursor <> nil) and (Index >= 0) and (Index < FCursor.ChildrenCount) then {$IFDEF BCB} FOwnTree.ExtractNode(TJclAnsiStrTreeNode(FCursor.Children[Index])) {$ELSE ~BCB} FOwnTree.ExtractNode(FCursor.Children[Index]) {$ENDIF ~BCB} else raise EJclOutOfBoundsError.Create; {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; procedure TJclAnsiStrTreeIterator.ExtractChildren; var Index: Integer; begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} if FCursor <> nil then begin for Index := FCursor.ChildrenCount - 1 downto 0 do {$IFDEF BCB} FOwnTree.ExtractNode(TJclAnsiStrTreeNode(FCursor.Children[Index])); {$ELSE ~BCB} FOwnTree.ExtractNode(FCursor.Children[Index]); {$ENDIF ~BCB} SetLength(FCursor.Children, 0); FCursor.ChildrenCount := 0; end; {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; function TJclAnsiStrTreeIterator.GetChild(Index: Integer): AnsiString; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} Result := ''; if (FCursor <> nil) and (Index >= 0) and (Index < FCursor.ChildrenCount) then FCursor := TJclAnsiStrTreeNode(FCursor.Children[Index]); if FCursor <> nil then Result := FCursor.Value else if not FOwnTree.ReturnDefaultElements then raise EJclNoSuchElementError.Create(''); {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; function TJclAnsiStrTreeIterator.GetString: AnsiString; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} CheckValid; Result := ''; if FCursor <> nil then Result := FCursor.Value else if not FOwnTree.ReturnDefaultElements then raise EJclNoSuchElementError.Create(''); {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; function TJclAnsiStrTreeIterator.HasChild(Index: Integer): Boolean; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} Result := (FCursor <> nil) and (Index >= 0) and (Index < FCursor.ChildrenCount); {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; function TJclAnsiStrTreeIterator.HasNext: Boolean; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} if Valid then Result := GetNextCursor <> nil else Result := FCursor <> nil; {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; function TJclAnsiStrTreeIterator.HasParent: Boolean; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} Result := (FCursor <> nil) and (FCursor.Parent <> nil); {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; function TJclAnsiStrTreeIterator.HasPrevious: Boolean; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} if Valid then Result := GetPreviousCursor <> nil else Result := FCursor <> nil; {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; function TJclAnsiStrTreeIterator.IndexOfChild(const AString: AnsiString): Integer; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} if FCursor <> nil then Result := FCursor.IndexOfValue(AString, FEqualityComparer) else Result := -1; {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; function TJclAnsiStrTreeIterator.Insert(const AString: AnsiString): Boolean; var ParentNode, NewNode: TJclAnsiStrTreeNode; Index, I: Integer; begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} // insert sibling or, if FCursor is root node, behave like TJclAnsiStrTree.Insert Result := (FCursor <> nil) and (FOwnTree.AllowDefaultElements or not FEqualityComparer.ItemsEqual(AString, '')) and ((not FOwnTree.Contains(AString)) or FOwnTree.CheckDuplicate); if Result then begin if FCursor.Parent <> nil then begin ParentNode := FCursor.Parent; Index := 0; while (Index < ParentNode.ChildrenCount) and (ParentNode.Children[Index] <> FCursor) do Inc(Index); end else begin ParentNode := FCursor; Index := 0; end; if ParentNode.ChildrenCount = Length(ParentNode.Children) then SetLength(ParentNode.Children, FOwnTree.CalcGrowCapacity(Length(ParentNode.Children), ParentNode.ChildrenCount)); if ParentNode.ChildrenCount < Length(ParentNode.Children) then begin NewNode := TJclAnsiStrTreeNode.Create; NewNode.Value := AString; NewNode.Parent := ParentNode; for I := ParentNode.ChildrenCount - 1 downto Index do ParentNode.Children[I + 1] := ParentNode.Children[I]; ParentNode.Children[Index] := NewNode; Inc(ParentNode.ChildrenCount); Inc(FOwnTree.FSize); end; end; {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; function TJclAnsiStrTreeIterator.InsertChild(Index: Integer; const AString: AnsiString): Boolean; var NewNode: TJclAnsiStrTreeNode; I: Integer; begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} // insert sibling or, if FCursor is root node, behave like TJclAnsiStrTree.Insert Result := (FCursor <> nil) and (FOwnTree.AllowDefaultElements or not FEqualityComparer.ItemsEqual(AString, '')) and ((not FOwnTree.Contains(AString)) or FOwnTree.CheckDuplicate); if Result then begin if FCursor.ChildrenCount = Length(FCursor.Children) then SetLength(FCursor.Children, FOwnTree.CalcGrowCapacity(Length(FCursor.Children), FCursor.ChildrenCount)); if FCursor.ChildrenCount < Length(FCursor.Children) then begin NewNode := TJclAnsiStrTreeNode.Create; NewNode.Value := AString; NewNode.Parent := FCursor; for I := FCursor.ChildrenCount - 1 downto Index do FCursor.Children[I + 1] := FCursor.Children[I]; FCursor.Children[Index] := NewNode; Inc(FCursor.ChildrenCount); Inc(FOwnTree.FSize); end; end; {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; function TJclAnsiStrTreeIterator.IteratorEquals(const AIterator: IJclAnsiStrIterator): Boolean; var Obj: TObject; ItrObj: TJclAnsiStrTreeIterator; begin Result := False; if AIterator = nil then Exit; Obj := AIterator.GetIteratorReference; if Obj is TJclAnsiStrTreeIterator then begin ItrObj := TJclAnsiStrTreeIterator(Obj); Result := (FOwnTree = ItrObj.FOwnTree) and (FCursor = ItrObj.FCursor) and (Valid = ItrObj.Valid); end; end; {$IFDEF SUPPORTS_FOR_IN} function TJclAnsiStrTreeIterator.MoveNext: Boolean; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} if Valid then FCursor := GetNextCursor else Valid := True; Result := FCursor <> nil; {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; {$ENDIF SUPPORTS_FOR_IN} function TJclAnsiStrTreeIterator.Next: AnsiString; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} if Valid then FCursor := GetNextCursor else Valid := True; Result := ''; if FCursor <> nil then Result := FCursor.Value else if not FOwnTree.ReturnDefaultElements then raise EJclNoSuchElementError.Create(''); {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; function TJclAnsiStrTreeIterator.NextIndex: Integer; begin // No index raise EJclOperationNotSupportedError.Create; end; function TJclAnsiStrTreeIterator.Parent: AnsiString; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} Result := ''; if FCursor <> nil then FCursor := FCursor.Parent; if FCursor <> nil then Result := FCursor.Value else if not FOwnTree.ReturnDefaultElements then raise EJclNoSuchElementError.Create(''); {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; function TJclAnsiStrTreeIterator.Previous: AnsiString; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} if Valid then FCursor := GetPreviousCursor else Valid := True; Result := ''; if FCursor <> nil then Result := FCursor.Value else if not FOwnTree.ReturnDefaultElements then raise EJclNoSuchElementError.Create(''); {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; function TJclAnsiStrTreeIterator.PreviousIndex: Integer; begin // No index raise EJclOperationNotSupportedError.Create; end; procedure TJclAnsiStrTreeIterator.Remove; var OldCursor: TJclAnsiStrTreeNode; begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} CheckValid; Valid := False; OldCursor := FCursor; FCursor := GetNextSibling; if OldCursor <> nil then FOwnTree.RemoveNode(OldCursor); {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; procedure TJclAnsiStrTreeIterator.Reset; var NewCursor: TJclAnsiStrTreeNode; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} Valid := False; case FStart of isFirst: begin NewCursor := FCursor; while NewCursor <> nil do begin NewCursor := GetPreviousCursor; if NewCursor <> nil then FCursor := NewCursor; end; end; isLast: begin NewCursor := FCursor; while NewCursor <> nil do begin NewCursor := GetNextCursor; if NewCursor <> nil then FCursor := NewCursor; end; end; isRoot: begin while (FCursor <> nil) and (FCursor.Parent <> nil) do FCursor := FCursor.Parent; end; end; {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; procedure TJclAnsiStrTreeIterator.SetChild(Index: Integer; const AString: AnsiString); begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} if (FCursor <> nil) and (Index >= 0) and (Index < FCursor.ChildrenCount) then TJclAnsiStrTreeNode(FCursor.Children[Index]).Value := AString else raise EJclOutOfBoundsError.Create; {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; procedure TJclAnsiStrTreeIterator.SetString(const AString: AnsiString); begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} CheckValid; if FCursor <> nil then begin FOwnTree.FreeString(FCursor.Value); FCursor.Value := AString; end; {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; //=== { TJclPreOrderAnsiStrTreeIterator } =================================================== function TJclPreOrderAnsiStrTreeIterator.CreateEmptyIterator: TJclAbstractIterator; begin Result := TJclPreOrderAnsiStrTreeIterator.Create(FOwnTree, FCursor, Valid, FStart); end; function TJclPreOrderAnsiStrTreeIterator.GetNextCursor: TJclAnsiStrTreeNode; var LastRet: TJclAnsiStrTreeNode; begin Result := FCursor; if Result = nil then Exit; LastRet := Result; if Result.ChildrenCount > 0 then Result := TJclAnsiStrTreeNode(Result.Children[0]) else begin Result := Result.Parent; while (Result <> nil) and (Result.IndexOfChild(LastRet) = (Result.ChildrenCount - 1)) do begin LastRet := Result; Result := Result.Parent; end; if Result <> nil then // not root = return successor Result := TJclAnsiStrTreeNode(Result.Children[Result.IndexOfChild(LastRet) + 1]); end; end; function TJclPreOrderAnsiStrTreeIterator.GetNextSibling: TJclAnsiStrTreeNode; var LastRet: TJclAnsiStrTreeNode; begin Result := FCursor; if Result = nil then Exit; LastRet := Result; Result := Result.Parent; while (Result <> nil) and (Result.IndexOfChild(LastRet) = (Result.ChildrenCount - 1)) do begin LastRet := Result; Result := Result.Parent; end; if Result <> nil then // not root = return successor Result := TJclAnsiStrTreeNode(Result.Children[Result.IndexOfChild(LastRet) + 1]); end; function TJclPreOrderAnsiStrTreeIterator.GetPreviousCursor: TJclAnsiStrTreeNode; var LastRet: TJclAnsiStrTreeNode; begin Result := FCursor; if Result = nil then Exit; LastRet := Result; Result := Result.Parent; if (Result <> nil) and (Result.IndexOfChild(LastRet) > 0) then // come from Right begin Result := TJclAnsiStrTreeNode(Result.Children[Result.IndexOfChild(LastRet) - 1]); while (Result.ChildrenCount > 0) do // descend down the tree Result := TJclAnsiStrTreeNode(Result.Children[Result.ChildrenCount - 1]); end; end; //=== { TJclPostOrderAnsiStrTreeIterator } ================================================== function TJclPostOrderAnsiStrTreeIterator.CreateEmptyIterator: TJclAbstractIterator; begin Result := TJclPostOrderAnsiStrTreeIterator.Create(FOwnTree, FCursor, Valid, FStart); end; function TJclPostOrderAnsiStrTreeIterator.GetNextCursor: TJclAnsiStrTreeNode; var LastRet: TJclAnsiStrTreeNode; begin Result := FCursor; if Result = nil then Exit; LastRet := Result; Result := Result.Parent; if (Result <> nil) and (Result.IndexOfChild(LastRet) <> (Result.ChildrenCount - 1)) then begin Result := TJclAnsiStrTreeNode(Result.Children[Result.IndexOfChild(LastRet) + 1]); while Result.ChildrenCount > 0 do Result := TJclAnsiStrTreeNode(Result.Children[0]); end; end; function TJclPostOrderAnsiStrTreeIterator.GetNextSibling: TJclAnsiStrTreeNode; var LastRet: TJclAnsiStrTreeNode; begin Result := FCursor; if Result = nil then Exit; LastRet := Result; Result := Result.Parent; if (Result <> nil) and (Result.IndexOfChild(LastRet) <> (Result.ChildrenCount - 1)) then begin Result := TJclAnsiStrTreeNode(Result.Children[Result.IndexOfChild(LastRet) + 1]); while Result.ChildrenCount > 0 do Result := TJclAnsiStrTreeNode(Result.Children[0]); end; end; function TJclPostOrderAnsiStrTreeIterator.GetPreviousCursor: TJclAnsiStrTreeNode; var LastRet: TJclAnsiStrTreeNode; begin Result := FCursor; if Result = nil then Exit; if Result.ChildrenCount > 0 then Result := TJclAnsiStrTreeNode(Result.Children[Result.ChildrenCount - 1]) else begin LastRet := Result; Result := Result.Parent; while (Result <> nil) and (Result.IndexOfChild(LastRet) = 0) do begin LastRet := Result; Result := Result.Parent; end; if Result <> nil then // not root Result := TJclAnsiStrTreeNode(Result.Children[Result.IndexOfChild(LastRet) - 1]); end; end; //=== { TJclWideStrTreeNode } ======================================================= function TJclWideStrTreeNode.IndexOfChild(AChild: TJclWideStrTreeNode): Integer; begin for Result := 0 to ChildrenCount - 1 do if Children[Result] = AChild then Exit; Result := -1; end; function TJclWideStrTreeNode.IndexOfValue(const AString: WideString; const AEqualityComparer: IJclWideStrEqualityComparer): Integer; begin for Result := 0 to ChildrenCount - 1 do if AEqualityComparer.ItemsEqual(TJclWideStrTreeNode(Children[Result]).Value, AString) then Exit; Result := -1; end; //=== { TJclWideStrTree } ======================================================= constructor TJclWideStrTree.Create(); begin inherited Create(); FTraverseOrder := toPreOrder; end; destructor TJclWideStrTree.Destroy; begin FReadOnly := False; Clear; inherited Destroy; end; function TJclWideStrTree.Add(const AString: WideString): Boolean; var NewNode: TJclWideStrTreeNode; begin if ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginWrite; try {$ENDIF THREADSAFE} Result := AllowDefaultElements or not ItemsEqual(AString, ''); if Result then begin if FRoot <> nil then begin Result := (not Contains(AString)) or CheckDuplicate; if Result then begin if FRoot.ChildrenCount = Length(FRoot.Children) then SetLength(FRoot.Children, CalcGrowCapacity(Length(FRoot.Children), FRoot.ChildrenCount)); if FRoot.ChildrenCount < Length(FRoot.Children) then begin NewNode := TJclWideStrTreeNode.Create; NewNode.Value := AString; NewNode.Parent := FRoot; FRoot.Children[FRoot.ChildrenCount] := NewNode; Inc(FRoot.ChildrenCount); Inc(FSize); end else Result := False; end; end else begin FRoot := TJclWideStrTreeNode.Create; FRoot.Value := AString; Inc(FSize); end; end; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndWrite; end; {$ENDIF THREADSAFE} end; function TJclWideStrTree.AddAll(const ACollection: IJclWideStrCollection): Boolean; var It: IJclWideStrIterator; begin if ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginWrite; try {$ENDIF THREADSAFE} Result := False; if ACollection = nil then Exit; Result := True; It := ACollection.First; while It.HasNext do Result := Add(It.Next) and Result; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndWrite; end; {$ENDIF THREADSAFE} end; procedure TJclWideStrTree.AssignDataTo(Dest: TJclAbstractContainerBase); var ADest: TJclWideStrTree; ACollection: IJclWideStrCollection; begin inherited AssignDataTo(Dest); if Dest is TJclWideStrTree then begin ADest := TJclWideStrTree(Dest); ADest.Clear; ADest.FSize := FSize; if FRoot <> nil then ADest.FRoot := CloneNode(FRoot, nil); end else if Supports(IInterface(Dest), IJclWideStrCollection, ACollection) then begin ACollection.Clear; ACollection.AddAll(Self); end; end; procedure TJclWideStrTree.AssignPropertiesTo(Dest: TJclAbstractContainerBase); begin inherited AssignPropertiesto(Dest); if Dest is TJclWideStrTree then TJclWideStrTree(Dest).FTraverseOrder := FTraverseOrder; end; procedure TJclWideStrTree.Clear; begin if ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginWrite; try {$ENDIF THREADSAFE} if FRoot <> nil then RemoveNode(FRoot); FSize := 0; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndWrite; end; {$ENDIF THREADSAFE} end; function TJclWideStrTree.CloneNode(Node, Parent: TJclWideStrTreeNode): TJclWideStrTreeNode; var Index: Integer; begin Result := TJclWideStrTreeNode.Create; Result.Value := Node.Value; Result.Parent := Parent; SetLength(Result.Children, Node.ChildrenCount); Result.ChildrenCount := Node.ChildrenCount; for Index := 0 to Node.ChildrenCount - 1 do Result.Children[Index] := CloneNode(TJclWideStrTreeNode(Node.Children[Index]), Result); // recursive call end; function TJclWideStrTree.CollectionEquals(const ACollection: IJclWideStrCollection): Boolean; var It, ItSelf: IJclWideStrIterator; begin {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginRead; try {$ENDIF THREADSAFE} Result := False; if ACollection = nil then Exit; if FSize <> ACollection.Size then Exit; Result := True; It := ACollection.First; ItSelf := First; while ItSelf.HasNext do if not ItemsEqual(ItSelf.Next, It.Next) then begin Result := False; Break; end; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndRead; end; {$ENDIF THREADSAFE} end; function TJclWideStrTree.Contains(const AString: WideString): Boolean; begin {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginRead; try {$ENDIF THREADSAFE} if FRoot <> nil then Result := NodeContains(FRoot, AString) else Result := False; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndRead; end; {$ENDIF THREADSAFE} end; function TJclWideStrTree.ContainsAll(const ACollection: IJclWideStrCollection): Boolean; var It: IJclWideStrIterator; begin {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginRead; try {$ENDIF THREADSAFE} Result := True; if ACollection = nil then Exit; It := ACollection.First; while Result and It.HasNext do Result := Contains(It.Next); {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndRead; end; {$ENDIF THREADSAFE} end; function TJclWideStrTree.Extract(const AString: WideString): Boolean; var It: IJclWideStrIterator; begin if ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginWrite; try {$ENDIF THREADSAFE} Result := FRoot <> nil; if Result then begin It := First; while It.HasNext do if ItemsEqual(It.Next, AString) then begin It.Extract; if RemoveSingleElement then Break; end; end; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndWrite; end; {$ENDIF THREADSAFE} end; function TJclWideStrTree.ExtractAll(const ACollection: IJclWideStrCollection): Boolean; var It: IJclWideStrIterator; begin if ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginWrite; try {$ENDIF THREADSAFE} Result := False; if ACollection = nil then Exit; Result := True; It := ACollection.First; while It.HasNext do Result := Extract(It.Next) and Result; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndWrite; end; {$ENDIF THREADSAFE} end; procedure TJclWideStrTree.ExtractNode(var ANode: TJclWideStrTreeNode); var Index, ChildIndex, NewCapacity: Integer; Parent: TJclWideStrTreeNode; begin for Index := ANode.ChildrenCount - 1 downto 0 do {$IFDEF BCB} ExtractNode(TJclWideStrTreeNode(ANode.Children[Index])); {$ELSE ~BCB} ExtractNode(ANode.Children[Index]); {$ENDIF ~BCB} Parent := ANode.Parent; if Parent <> nil then begin ChildIndex := Parent.IndexOfChild(ANode); for Index := ChildIndex + 1 to Parent.ChildrenCount - 1 do Parent.Children[Index - 1] := Parent.Children[Index]; Dec(Parent.ChildrenCount); NewCapacity := CalcPackCapacity(Length(Parent.Children), Parent.ChildrenCount); if NewCapacity < Length(Parent.Children) then SetLength(Parent.Children, NewCapacity); FreeAndNil(ANode); end else begin FreeAndNil(ANode); FRoot := nil; end; Dec(FSize); end; function TJclWideStrTree.First: IJclWideStrIterator; var Start: TJclWideStrTreeNode; begin {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginRead; try {$ENDIF THREADSAFE} Start := FRoot; case GetTraverseOrder of toPreOrder: Result := TJclPreOrderWideStrTreeIterator.Create(Self, Start, False, isFirst); toPostOrder: begin if Start <> nil then while (Start.ChildrenCount > 0) do Start := TJclWideStrTreeNode(Start.Children[0]); Result := TJclPostOrderWideStrTreeIterator.Create(Self, Start, False, isFirst); end; else Result := nil; end; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndRead; end; {$ENDIF THREADSAFE} end; {$IFDEF SUPPORTS_FOR_IN} function TJclWideStrTree.GetEnumerator: IJclWideStrIterator; begin Result := First; end; {$ENDIF SUPPORTS_FOR_IN} function TJclWideStrTree.GetRoot: IJclWideStrTreeIterator; begin {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginRead; try {$ENDIF THREADSAFE} case GetTraverseOrder of toPreOrder: Result := TJclPreOrderWideStrTreeIterator.Create(Self, FRoot, False, isRoot); toPostOrder: Result := TJclPostOrderWideStrTreeIterator.Create(Self, FRoot, False, isRoot); else Result := nil; end; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndRead; end; {$ENDIF THREADSAFE} end; function TJclWideStrTree.GetTraverseOrder: TJclTraverseOrder; begin Result := FTraverseOrder; end; function TJclWideStrTree.IsEmpty: Boolean; begin Result := FSize = 0; end; function TJclWideStrTree.Last: IJclWideStrIterator; var Start: TJclWideStrTreeNode; begin {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginRead; try {$ENDIF THREADSAFE} Start := FRoot; case FTraverseOrder of toPreOrder: begin if Start <> nil then while Start.ChildrenCount > 0 do Start := TJclWideStrTreeNode(Start.Children[Start.ChildrenCount - 1]); Result := TJclPreOrderWideStrTreeIterator.Create(Self, Start, False, isLast); end; toPostOrder: Result := TJclPostOrderWideStrTreeIterator.Create(Self, Start, False, isLast); else Result := nil; end; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndRead; end; {$ENDIF THREADSAFE} end; function TJclWideStrTree.NodeContains(ANode: TJclWideStrTreeNode; const AString: WideString): Boolean; var Index: Integer; begin Result := ItemsEqual(ANode.Value, AString); if not Result then for Index := 0 to ANode.ChildrenCount - 1 do begin Result := NodeContains(TJclWideStrTreeNode(ANode.Children[Index]), AString); if Result then Break; end; end; procedure TJclWideStrTree.Pack; begin if ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginWrite; try {$ENDIF THREADSAFE} if FRoot <> nil then PackNode(FRoot); {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndWrite; end; {$ENDIF THREADSAFE} end; procedure TJclWideStrTree.PackNode(ANode: TJclWideStrTreeNode); var Index: Integer; begin SetLength(ANode.Children, ANode.ChildrenCount); for Index := 0 to ANode.ChildrenCount - 1 do PackNode(TJclWideStrTreeNode(ANode.Children[Index])); end; function TJclWideStrTree.Remove(const AString: WideString): Boolean; var Extracted: WideString; begin if ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginWrite; try {$ENDIF THREADSAFE} Result := Extract(AString); if Result then begin Extracted := AString; FreeString(Extracted); end; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndWrite; end; {$ENDIF THREADSAFE} end; function TJclWideStrTree.RemoveAll(const ACollection: IJclWideStrCollection): Boolean; var It: IJclWideStrIterator; begin if ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginWrite; try {$ENDIF THREADSAFE} Result := False; if ACollection = nil then Exit; Result := True; It := ACollection.First; while It.HasNext do Result := Remove(It.Next) and Result; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndWrite; end; {$ENDIF THREADSAFE} end; procedure TJclWideStrTree.RemoveNode(var ANode: TJclWideStrTreeNode); var Index, ChildIndex, NewCapacity: Integer; Parent: TJclWideStrTreeNode; begin for Index := ANode.ChildrenCount - 1 downto 0 do {$IFDEF BCB} RemoveNode(TJclWideStrTreeNode(ANode.Children[Index])); {$ELSE ~BCB} RemoveNode(ANode.Children[Index]); {$ENDIF ~BCB} FreeString(ANode.Value); Parent := ANode.Parent; if Parent <> nil then begin ChildIndex := Parent.IndexOfChild(ANode); for Index := ChildIndex + 1 to Parent.ChildrenCount - 1 do Parent.Children[Index - 1] := Parent.Children[Index]; Dec(Parent.ChildrenCount); NewCapacity := CalcPackCapacity(Length(Parent.Children), Parent.ChildrenCount); if NewCapacity < Length(Parent.Children) then SetLength(Parent.Children, NewCapacity); FreeAndNil(ANode); end else begin FreeAndNil(ANode); FRoot := nil; end; Dec(FSize); end; function TJclWideStrTree.RetainAll(const ACollection: IJclWideStrCollection): Boolean; var It: IJclWideStrIterator; begin if ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginWrite; try {$ENDIF THREADSAFE} Result := False; if ACollection = nil then Exit; Result := True; It := First; while It.HasNext do if not ACollection.Contains(It.Next) then It.Remove; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndWrite; end; {$ENDIF THREADSAFE} end; procedure TJclWideStrTree.SetCapacity(Value: Integer); begin raise EJclOperationNotSupportedError.Create; end; procedure TJclWideStrTree.SetTraverseOrder(Value: TJclTraverseOrder); begin FTraverseOrder := Value; end; function TJclWideStrTree.Size: Integer; begin Result := FSize; end; function TJclWideStrTree.CreateEmptyContainer: TJclAbstractContainerBase; begin Result := TJclWideStrTree.Create; AssignPropertiesTo(Result); end; //=== { TJclWideStrTreeIterator } =========================================================== constructor TJclWideStrTreeIterator.Create(OwnTree: TJclWideStrTree; ACursor: TJclWideStrTreeNode; AValid: Boolean; AStart: TItrStart); begin inherited Create(AValid); FCursor := ACursor; FOwnTree := OwnTree; FStart := AStart; FEqualityComparer := OwnTree as IJclWideStrEqualityComparer; end; function TJclWideStrTreeIterator.Add(const AString: WideString): Boolean; var ParentNode, NewNode: TJclWideStrTreeNode; begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} // add sibling or, if FCursor is root node, behave like TJclWideStrTree.Add Result := (FCursor <> nil) and (FOwnTree.AllowDefaultElements or not FEqualityComparer.ItemsEqual(AString, '')) and ((not FOwnTree.Contains(AString)) or FOwnTree.CheckDuplicate); if Result then begin ParentNode := FCursor.Parent; if ParentNode = nil then ParentNode := FCursor; if ParentNode.ChildrenCount = Length(ParentNode.Children) then SetLength(ParentNode.Children, FOwnTree.CalcGrowCapacity(Length(ParentNode.Children), ParentNode.ChildrenCount)); if ParentNode.ChildrenCount < Length(ParentNode.Children) then begin NewNode := TJclWideStrTreeNode.Create; NewNode.Value := AString; NewNode.Parent := ParentNode; ParentNode.Children[ParentNode.ChildrenCount] := NewNode; Inc(ParentNode.ChildrenCount); Inc(FOwnTree.FSize); end; end; {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; function TJclWideStrTreeIterator.AddChild(const AString: WideString): Boolean; var NewNode: TJclWideStrTreeNode; begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} Result := (FCursor <> nil) and (FOwnTree.AllowDefaultElements or not FEqualityComparer.ItemsEqual(AString, '')) and ((not FOwnTree.Contains(AString)) or FOwnTree.CheckDuplicate); if Result then begin if FCursor.ChildrenCount = Length(FCursor.Children) then SetLength(FCursor.Children, FOwnTree.CalcGrowCapacity(Length(FCursor.Children), FCursor.ChildrenCount)); if FCursor.ChildrenCount < Length(FCursor.Children) then begin NewNode := TJclWideStrTreeNode.Create; NewNode.Value := AString; NewNode.Parent := FCursor; FCursor.Children[FCursor.ChildrenCount] := NewNode; Inc(FCursor.ChildrenCount); Inc(FOwnTree.FSize); end; end; {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; procedure TJclWideStrTreeIterator.AssignPropertiesTo(Dest: TJclAbstractIterator); var ADest: TJclWideStrTreeIterator; begin inherited AssignPropertiesTo(Dest); if Dest is TJclWideStrTreeIterator then begin ADest := TJclWideStrTreeIterator(Dest); ADest.FCursor := FCursor; ADest.FOwnTree := FOwnTree; ADest.FEqualityComparer := FEqualityComparer; ADest.FStart := FStart; end; end; function TJclWideStrTreeIterator.ChildrenCount: Integer; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} if FCursor <> nil then Result := FCursor.ChildrenCount else Result := 0; {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; procedure TJclWideStrTreeIterator.DeleteChild(Index: Integer); begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} if (FCursor <> nil) and (Index >= 0) and (Index < FCursor.ChildrenCount) then {$IFDEF BCB} FOwnTree.RemoveNode(TJclWideStrTreeNode(FCursor.Children[Index])) {$ELSE ~BCB} FOwnTree.RemoveNode(FCursor.Children[Index]) {$ENDIF ~BCB} else raise EJclOutOfBoundsError.Create; {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; procedure TJclWideStrTreeIterator.DeleteChildren; var Index: Integer; begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} if FCursor <> nil then begin for Index := FCursor.ChildrenCount - 1 downto 0 do {$IFDEF BCB} FOwnTree.RemoveNode(TJclWideStrTreeNode(FCursor.Children[Index])); {$ELSE ~BCB} FOwnTree.RemoveNode(FCursor.Children[Index]); {$ENDIF ~BCB} SetLength(FCursor.Children, 0); FCursor.ChildrenCount := 0; end; {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; procedure TJclWideStrTreeIterator.Extract; var OldCursor: TJclWideStrTreeNode; begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} CheckValid; Valid := False; OldCursor := FCursor; FCursor := GetNextSibling; if OldCursor <> nil then FOwnTree.ExtractNode(OldCursor); {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; procedure TJclWideStrTreeIterator.ExtractChild(Index: Integer); begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} if (FCursor <> nil) and (Index >= 0) and (Index < FCursor.ChildrenCount) then {$IFDEF BCB} FOwnTree.ExtractNode(TJclWideStrTreeNode(FCursor.Children[Index])) {$ELSE ~BCB} FOwnTree.ExtractNode(FCursor.Children[Index]) {$ENDIF ~BCB} else raise EJclOutOfBoundsError.Create; {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; procedure TJclWideStrTreeIterator.ExtractChildren; var Index: Integer; begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} if FCursor <> nil then begin for Index := FCursor.ChildrenCount - 1 downto 0 do {$IFDEF BCB} FOwnTree.ExtractNode(TJclWideStrTreeNode(FCursor.Children[Index])); {$ELSE ~BCB} FOwnTree.ExtractNode(FCursor.Children[Index]); {$ENDIF ~BCB} SetLength(FCursor.Children, 0); FCursor.ChildrenCount := 0; end; {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; function TJclWideStrTreeIterator.GetChild(Index: Integer): WideString; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} Result := ''; if (FCursor <> nil) and (Index >= 0) and (Index < FCursor.ChildrenCount) then FCursor := TJclWideStrTreeNode(FCursor.Children[Index]); if FCursor <> nil then Result := FCursor.Value else if not FOwnTree.ReturnDefaultElements then raise EJclNoSuchElementError.Create(''); {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; function TJclWideStrTreeIterator.GetString: WideString; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} CheckValid; Result := ''; if FCursor <> nil then Result := FCursor.Value else if not FOwnTree.ReturnDefaultElements then raise EJclNoSuchElementError.Create(''); {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; function TJclWideStrTreeIterator.HasChild(Index: Integer): Boolean; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} Result := (FCursor <> nil) and (Index >= 0) and (Index < FCursor.ChildrenCount); {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; function TJclWideStrTreeIterator.HasNext: Boolean; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} if Valid then Result := GetNextCursor <> nil else Result := FCursor <> nil; {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; function TJclWideStrTreeIterator.HasParent: Boolean; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} Result := (FCursor <> nil) and (FCursor.Parent <> nil); {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; function TJclWideStrTreeIterator.HasPrevious: Boolean; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} if Valid then Result := GetPreviousCursor <> nil else Result := FCursor <> nil; {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; function TJclWideStrTreeIterator.IndexOfChild(const AString: WideString): Integer; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} if FCursor <> nil then Result := FCursor.IndexOfValue(AString, FEqualityComparer) else Result := -1; {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; function TJclWideStrTreeIterator.Insert(const AString: WideString): Boolean; var ParentNode, NewNode: TJclWideStrTreeNode; Index, I: Integer; begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} // insert sibling or, if FCursor is root node, behave like TJclWideStrTree.Insert Result := (FCursor <> nil) and (FOwnTree.AllowDefaultElements or not FEqualityComparer.ItemsEqual(AString, '')) and ((not FOwnTree.Contains(AString)) or FOwnTree.CheckDuplicate); if Result then begin if FCursor.Parent <> nil then begin ParentNode := FCursor.Parent; Index := 0; while (Index < ParentNode.ChildrenCount) and (ParentNode.Children[Index] <> FCursor) do Inc(Index); end else begin ParentNode := FCursor; Index := 0; end; if ParentNode.ChildrenCount = Length(ParentNode.Children) then SetLength(ParentNode.Children, FOwnTree.CalcGrowCapacity(Length(ParentNode.Children), ParentNode.ChildrenCount)); if ParentNode.ChildrenCount < Length(ParentNode.Children) then begin NewNode := TJclWideStrTreeNode.Create; NewNode.Value := AString; NewNode.Parent := ParentNode; for I := ParentNode.ChildrenCount - 1 downto Index do ParentNode.Children[I + 1] := ParentNode.Children[I]; ParentNode.Children[Index] := NewNode; Inc(ParentNode.ChildrenCount); Inc(FOwnTree.FSize); end; end; {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; function TJclWideStrTreeIterator.InsertChild(Index: Integer; const AString: WideString): Boolean; var NewNode: TJclWideStrTreeNode; I: Integer; begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} // insert sibling or, if FCursor is root node, behave like TJclWideStrTree.Insert Result := (FCursor <> nil) and (FOwnTree.AllowDefaultElements or not FEqualityComparer.ItemsEqual(AString, '')) and ((not FOwnTree.Contains(AString)) or FOwnTree.CheckDuplicate); if Result then begin if FCursor.ChildrenCount = Length(FCursor.Children) then SetLength(FCursor.Children, FOwnTree.CalcGrowCapacity(Length(FCursor.Children), FCursor.ChildrenCount)); if FCursor.ChildrenCount < Length(FCursor.Children) then begin NewNode := TJclWideStrTreeNode.Create; NewNode.Value := AString; NewNode.Parent := FCursor; for I := FCursor.ChildrenCount - 1 downto Index do FCursor.Children[I + 1] := FCursor.Children[I]; FCursor.Children[Index] := NewNode; Inc(FCursor.ChildrenCount); Inc(FOwnTree.FSize); end; end; {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; function TJclWideStrTreeIterator.IteratorEquals(const AIterator: IJclWideStrIterator): Boolean; var Obj: TObject; ItrObj: TJclWideStrTreeIterator; begin Result := False; if AIterator = nil then Exit; Obj := AIterator.GetIteratorReference; if Obj is TJclWideStrTreeIterator then begin ItrObj := TJclWideStrTreeIterator(Obj); Result := (FOwnTree = ItrObj.FOwnTree) and (FCursor = ItrObj.FCursor) and (Valid = ItrObj.Valid); end; end; {$IFDEF SUPPORTS_FOR_IN} function TJclWideStrTreeIterator.MoveNext: Boolean; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} if Valid then FCursor := GetNextCursor else Valid := True; Result := FCursor <> nil; {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; {$ENDIF SUPPORTS_FOR_IN} function TJclWideStrTreeIterator.Next: WideString; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} if Valid then FCursor := GetNextCursor else Valid := True; Result := ''; if FCursor <> nil then Result := FCursor.Value else if not FOwnTree.ReturnDefaultElements then raise EJclNoSuchElementError.Create(''); {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; function TJclWideStrTreeIterator.NextIndex: Integer; begin // No index raise EJclOperationNotSupportedError.Create; end; function TJclWideStrTreeIterator.Parent: WideString; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} Result := ''; if FCursor <> nil then FCursor := FCursor.Parent; if FCursor <> nil then Result := FCursor.Value else if not FOwnTree.ReturnDefaultElements then raise EJclNoSuchElementError.Create(''); {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; function TJclWideStrTreeIterator.Previous: WideString; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} if Valid then FCursor := GetPreviousCursor else Valid := True; Result := ''; if FCursor <> nil then Result := FCursor.Value else if not FOwnTree.ReturnDefaultElements then raise EJclNoSuchElementError.Create(''); {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; function TJclWideStrTreeIterator.PreviousIndex: Integer; begin // No index raise EJclOperationNotSupportedError.Create; end; procedure TJclWideStrTreeIterator.Remove; var OldCursor: TJclWideStrTreeNode; begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} CheckValid; Valid := False; OldCursor := FCursor; FCursor := GetNextSibling; if OldCursor <> nil then FOwnTree.RemoveNode(OldCursor); {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; procedure TJclWideStrTreeIterator.Reset; var NewCursor: TJclWideStrTreeNode; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} Valid := False; case FStart of isFirst: begin NewCursor := FCursor; while NewCursor <> nil do begin NewCursor := GetPreviousCursor; if NewCursor <> nil then FCursor := NewCursor; end; end; isLast: begin NewCursor := FCursor; while NewCursor <> nil do begin NewCursor := GetNextCursor; if NewCursor <> nil then FCursor := NewCursor; end; end; isRoot: begin while (FCursor <> nil) and (FCursor.Parent <> nil) do FCursor := FCursor.Parent; end; end; {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; procedure TJclWideStrTreeIterator.SetChild(Index: Integer; const AString: WideString); begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} if (FCursor <> nil) and (Index >= 0) and (Index < FCursor.ChildrenCount) then TJclWideStrTreeNode(FCursor.Children[Index]).Value := AString else raise EJclOutOfBoundsError.Create; {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; procedure TJclWideStrTreeIterator.SetString(const AString: WideString); begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} CheckValid; if FCursor <> nil then begin FOwnTree.FreeString(FCursor.Value); FCursor.Value := AString; end; {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; //=== { TJclPreOrderWideStrTreeIterator } =================================================== function TJclPreOrderWideStrTreeIterator.CreateEmptyIterator: TJclAbstractIterator; begin Result := TJclPreOrderWideStrTreeIterator.Create(FOwnTree, FCursor, Valid, FStart); end; function TJclPreOrderWideStrTreeIterator.GetNextCursor: TJclWideStrTreeNode; var LastRet: TJclWideStrTreeNode; begin Result := FCursor; if Result = nil then Exit; LastRet := Result; if Result.ChildrenCount > 0 then Result := TJclWideStrTreeNode(Result.Children[0]) else begin Result := Result.Parent; while (Result <> nil) and (Result.IndexOfChild(LastRet) = (Result.ChildrenCount - 1)) do begin LastRet := Result; Result := Result.Parent; end; if Result <> nil then // not root = return successor Result := TJclWideStrTreeNode(Result.Children[Result.IndexOfChild(LastRet) + 1]); end; end; function TJclPreOrderWideStrTreeIterator.GetNextSibling: TJclWideStrTreeNode; var LastRet: TJclWideStrTreeNode; begin Result := FCursor; if Result = nil then Exit; LastRet := Result; Result := Result.Parent; while (Result <> nil) and (Result.IndexOfChild(LastRet) = (Result.ChildrenCount - 1)) do begin LastRet := Result; Result := Result.Parent; end; if Result <> nil then // not root = return successor Result := TJclWideStrTreeNode(Result.Children[Result.IndexOfChild(LastRet) + 1]); end; function TJclPreOrderWideStrTreeIterator.GetPreviousCursor: TJclWideStrTreeNode; var LastRet: TJclWideStrTreeNode; begin Result := FCursor; if Result = nil then Exit; LastRet := Result; Result := Result.Parent; if (Result <> nil) and (Result.IndexOfChild(LastRet) > 0) then // come from Right begin Result := TJclWideStrTreeNode(Result.Children[Result.IndexOfChild(LastRet) - 1]); while (Result.ChildrenCount > 0) do // descend down the tree Result := TJclWideStrTreeNode(Result.Children[Result.ChildrenCount - 1]); end; end; //=== { TJclPostOrderWideStrTreeIterator } ================================================== function TJclPostOrderWideStrTreeIterator.CreateEmptyIterator: TJclAbstractIterator; begin Result := TJclPostOrderWideStrTreeIterator.Create(FOwnTree, FCursor, Valid, FStart); end; function TJclPostOrderWideStrTreeIterator.GetNextCursor: TJclWideStrTreeNode; var LastRet: TJclWideStrTreeNode; begin Result := FCursor; if Result = nil then Exit; LastRet := Result; Result := Result.Parent; if (Result <> nil) and (Result.IndexOfChild(LastRet) <> (Result.ChildrenCount - 1)) then begin Result := TJclWideStrTreeNode(Result.Children[Result.IndexOfChild(LastRet) + 1]); while Result.ChildrenCount > 0 do Result := TJclWideStrTreeNode(Result.Children[0]); end; end; function TJclPostOrderWideStrTreeIterator.GetNextSibling: TJclWideStrTreeNode; var LastRet: TJclWideStrTreeNode; begin Result := FCursor; if Result = nil then Exit; LastRet := Result; Result := Result.Parent; if (Result <> nil) and (Result.IndexOfChild(LastRet) <> (Result.ChildrenCount - 1)) then begin Result := TJclWideStrTreeNode(Result.Children[Result.IndexOfChild(LastRet) + 1]); while Result.ChildrenCount > 0 do Result := TJclWideStrTreeNode(Result.Children[0]); end; end; function TJclPostOrderWideStrTreeIterator.GetPreviousCursor: TJclWideStrTreeNode; var LastRet: TJclWideStrTreeNode; begin Result := FCursor; if Result = nil then Exit; if Result.ChildrenCount > 0 then Result := TJclWideStrTreeNode(Result.Children[Result.ChildrenCount - 1]) else begin LastRet := Result; Result := Result.Parent; while (Result <> nil) and (Result.IndexOfChild(LastRet) = 0) do begin LastRet := Result; Result := Result.Parent; end; if Result <> nil then // not root Result := TJclWideStrTreeNode(Result.Children[Result.IndexOfChild(LastRet) - 1]); end; end; {$IFDEF SUPPORTS_UNICODE_STRING} //=== { TJclUnicodeStrTreeNode } ======================================================= function TJclUnicodeStrTreeNode.IndexOfChild(AChild: TJclUnicodeStrTreeNode): Integer; begin for Result := 0 to ChildrenCount - 1 do if Children[Result] = AChild then Exit; Result := -1; end; function TJclUnicodeStrTreeNode.IndexOfValue(const AString: UnicodeString; const AEqualityComparer: IJclUnicodeStrEqualityComparer): Integer; begin for Result := 0 to ChildrenCount - 1 do if AEqualityComparer.ItemsEqual(TJclUnicodeStrTreeNode(Children[Result]).Value, AString) then Exit; Result := -1; end; //=== { TJclUnicodeStrTree } ======================================================= constructor TJclUnicodeStrTree.Create(); begin inherited Create(); FTraverseOrder := toPreOrder; end; destructor TJclUnicodeStrTree.Destroy; begin FReadOnly := False; Clear; inherited Destroy; end; function TJclUnicodeStrTree.Add(const AString: UnicodeString): Boolean; var NewNode: TJclUnicodeStrTreeNode; begin if ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginWrite; try {$ENDIF THREADSAFE} Result := AllowDefaultElements or not ItemsEqual(AString, ''); if Result then begin if FRoot <> nil then begin Result := (not Contains(AString)) or CheckDuplicate; if Result then begin if FRoot.ChildrenCount = Length(FRoot.Children) then SetLength(FRoot.Children, CalcGrowCapacity(Length(FRoot.Children), FRoot.ChildrenCount)); if FRoot.ChildrenCount < Length(FRoot.Children) then begin NewNode := TJclUnicodeStrTreeNode.Create; NewNode.Value := AString; NewNode.Parent := FRoot; FRoot.Children[FRoot.ChildrenCount] := NewNode; Inc(FRoot.ChildrenCount); Inc(FSize); end else Result := False; end; end else begin FRoot := TJclUnicodeStrTreeNode.Create; FRoot.Value := AString; Inc(FSize); end; end; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndWrite; end; {$ENDIF THREADSAFE} end; function TJclUnicodeStrTree.AddAll(const ACollection: IJclUnicodeStrCollection): Boolean; var It: IJclUnicodeStrIterator; begin if ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginWrite; try {$ENDIF THREADSAFE} Result := False; if ACollection = nil then Exit; Result := True; It := ACollection.First; while It.HasNext do Result := Add(It.Next) and Result; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndWrite; end; {$ENDIF THREADSAFE} end; procedure TJclUnicodeStrTree.AssignDataTo(Dest: TJclAbstractContainerBase); var ADest: TJclUnicodeStrTree; ACollection: IJclUnicodeStrCollection; begin inherited AssignDataTo(Dest); if Dest is TJclUnicodeStrTree then begin ADest := TJclUnicodeStrTree(Dest); ADest.Clear; ADest.FSize := FSize; if FRoot <> nil then ADest.FRoot := CloneNode(FRoot, nil); end else if Supports(IInterface(Dest), IJclUnicodeStrCollection, ACollection) then begin ACollection.Clear; ACollection.AddAll(Self); end; end; procedure TJclUnicodeStrTree.AssignPropertiesTo(Dest: TJclAbstractContainerBase); begin inherited AssignPropertiesto(Dest); if Dest is TJclUnicodeStrTree then TJclUnicodeStrTree(Dest).FTraverseOrder := FTraverseOrder; end; procedure TJclUnicodeStrTree.Clear; begin if ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginWrite; try {$ENDIF THREADSAFE} if FRoot <> nil then RemoveNode(FRoot); FSize := 0; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndWrite; end; {$ENDIF THREADSAFE} end; function TJclUnicodeStrTree.CloneNode(Node, Parent: TJclUnicodeStrTreeNode): TJclUnicodeStrTreeNode; var Index: Integer; begin Result := TJclUnicodeStrTreeNode.Create; Result.Value := Node.Value; Result.Parent := Parent; SetLength(Result.Children, Node.ChildrenCount); Result.ChildrenCount := Node.ChildrenCount; for Index := 0 to Node.ChildrenCount - 1 do Result.Children[Index] := CloneNode(TJclUnicodeStrTreeNode(Node.Children[Index]), Result); // recursive call end; function TJclUnicodeStrTree.CollectionEquals(const ACollection: IJclUnicodeStrCollection): Boolean; var It, ItSelf: IJclUnicodeStrIterator; begin {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginRead; try {$ENDIF THREADSAFE} Result := False; if ACollection = nil then Exit; if FSize <> ACollection.Size then Exit; Result := True; It := ACollection.First; ItSelf := First; while ItSelf.HasNext do if not ItemsEqual(ItSelf.Next, It.Next) then begin Result := False; Break; end; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndRead; end; {$ENDIF THREADSAFE} end; function TJclUnicodeStrTree.Contains(const AString: UnicodeString): Boolean; begin {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginRead; try {$ENDIF THREADSAFE} if FRoot <> nil then Result := NodeContains(FRoot, AString) else Result := False; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndRead; end; {$ENDIF THREADSAFE} end; function TJclUnicodeStrTree.ContainsAll(const ACollection: IJclUnicodeStrCollection): Boolean; var It: IJclUnicodeStrIterator; begin {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginRead; try {$ENDIF THREADSAFE} Result := True; if ACollection = nil then Exit; It := ACollection.First; while Result and It.HasNext do Result := Contains(It.Next); {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndRead; end; {$ENDIF THREADSAFE} end; function TJclUnicodeStrTree.Extract(const AString: UnicodeString): Boolean; var It: IJclUnicodeStrIterator; begin if ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginWrite; try {$ENDIF THREADSAFE} Result := FRoot <> nil; if Result then begin It := First; while It.HasNext do if ItemsEqual(It.Next, AString) then begin It.Extract; if RemoveSingleElement then Break; end; end; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndWrite; end; {$ENDIF THREADSAFE} end; function TJclUnicodeStrTree.ExtractAll(const ACollection: IJclUnicodeStrCollection): Boolean; var It: IJclUnicodeStrIterator; begin if ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginWrite; try {$ENDIF THREADSAFE} Result := False; if ACollection = nil then Exit; Result := True; It := ACollection.First; while It.HasNext do Result := Extract(It.Next) and Result; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndWrite; end; {$ENDIF THREADSAFE} end; procedure TJclUnicodeStrTree.ExtractNode(var ANode: TJclUnicodeStrTreeNode); var Index, ChildIndex, NewCapacity: Integer; Parent: TJclUnicodeStrTreeNode; begin for Index := ANode.ChildrenCount - 1 downto 0 do {$IFDEF BCB} ExtractNode(TJclUnicodeStrTreeNode(ANode.Children[Index])); {$ELSE ~BCB} ExtractNode(ANode.Children[Index]); {$ENDIF ~BCB} Parent := ANode.Parent; if Parent <> nil then begin ChildIndex := Parent.IndexOfChild(ANode); for Index := ChildIndex + 1 to Parent.ChildrenCount - 1 do Parent.Children[Index - 1] := Parent.Children[Index]; Dec(Parent.ChildrenCount); NewCapacity := CalcPackCapacity(Length(Parent.Children), Parent.ChildrenCount); if NewCapacity < Length(Parent.Children) then SetLength(Parent.Children, NewCapacity); FreeAndNil(ANode); end else begin FreeAndNil(ANode); FRoot := nil; end; Dec(FSize); end; function TJclUnicodeStrTree.First: IJclUnicodeStrIterator; var Start: TJclUnicodeStrTreeNode; begin {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginRead; try {$ENDIF THREADSAFE} Start := FRoot; case GetTraverseOrder of toPreOrder: Result := TJclPreOrderUnicodeStrTreeIterator.Create(Self, Start, False, isFirst); toPostOrder: begin if Start <> nil then while (Start.ChildrenCount > 0) do Start := TJclUnicodeStrTreeNode(Start.Children[0]); Result := TJclPostOrderUnicodeStrTreeIterator.Create(Self, Start, False, isFirst); end; else Result := nil; end; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndRead; end; {$ENDIF THREADSAFE} end; {$IFDEF SUPPORTS_FOR_IN} function TJclUnicodeStrTree.GetEnumerator: IJclUnicodeStrIterator; begin Result := First; end; {$ENDIF SUPPORTS_FOR_IN} function TJclUnicodeStrTree.GetRoot: IJclUnicodeStrTreeIterator; begin {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginRead; try {$ENDIF THREADSAFE} case GetTraverseOrder of toPreOrder: Result := TJclPreOrderUnicodeStrTreeIterator.Create(Self, FRoot, False, isRoot); toPostOrder: Result := TJclPostOrderUnicodeStrTreeIterator.Create(Self, FRoot, False, isRoot); else Result := nil; end; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndRead; end; {$ENDIF THREADSAFE} end; function TJclUnicodeStrTree.GetTraverseOrder: TJclTraverseOrder; begin Result := FTraverseOrder; end; function TJclUnicodeStrTree.IsEmpty: Boolean; begin Result := FSize = 0; end; function TJclUnicodeStrTree.Last: IJclUnicodeStrIterator; var Start: TJclUnicodeStrTreeNode; begin {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginRead; try {$ENDIF THREADSAFE} Start := FRoot; case FTraverseOrder of toPreOrder: begin if Start <> nil then while Start.ChildrenCount > 0 do Start := TJclUnicodeStrTreeNode(Start.Children[Start.ChildrenCount - 1]); Result := TJclPreOrderUnicodeStrTreeIterator.Create(Self, Start, False, isLast); end; toPostOrder: Result := TJclPostOrderUnicodeStrTreeIterator.Create(Self, Start, False, isLast); else Result := nil; end; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndRead; end; {$ENDIF THREADSAFE} end; function TJclUnicodeStrTree.NodeContains(ANode: TJclUnicodeStrTreeNode; const AString: UnicodeString): Boolean; var Index: Integer; begin Result := ItemsEqual(ANode.Value, AString); if not Result then for Index := 0 to ANode.ChildrenCount - 1 do begin Result := NodeContains(TJclUnicodeStrTreeNode(ANode.Children[Index]), AString); if Result then Break; end; end; procedure TJclUnicodeStrTree.Pack; begin if ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginWrite; try {$ENDIF THREADSAFE} if FRoot <> nil then PackNode(FRoot); {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndWrite; end; {$ENDIF THREADSAFE} end; procedure TJclUnicodeStrTree.PackNode(ANode: TJclUnicodeStrTreeNode); var Index: Integer; begin SetLength(ANode.Children, ANode.ChildrenCount); for Index := 0 to ANode.ChildrenCount - 1 do PackNode(TJclUnicodeStrTreeNode(ANode.Children[Index])); end; function TJclUnicodeStrTree.Remove(const AString: UnicodeString): Boolean; var Extracted: UnicodeString; begin if ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginWrite; try {$ENDIF THREADSAFE} Result := Extract(AString); if Result then begin Extracted := AString; FreeString(Extracted); end; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndWrite; end; {$ENDIF THREADSAFE} end; function TJclUnicodeStrTree.RemoveAll(const ACollection: IJclUnicodeStrCollection): Boolean; var It: IJclUnicodeStrIterator; begin if ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginWrite; try {$ENDIF THREADSAFE} Result := False; if ACollection = nil then Exit; Result := True; It := ACollection.First; while It.HasNext do Result := Remove(It.Next) and Result; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndWrite; end; {$ENDIF THREADSAFE} end; procedure TJclUnicodeStrTree.RemoveNode(var ANode: TJclUnicodeStrTreeNode); var Index, ChildIndex, NewCapacity: Integer; Parent: TJclUnicodeStrTreeNode; begin for Index := ANode.ChildrenCount - 1 downto 0 do {$IFDEF BCB} RemoveNode(TJclUnicodeStrTreeNode(ANode.Children[Index])); {$ELSE ~BCB} RemoveNode(ANode.Children[Index]); {$ENDIF ~BCB} FreeString(ANode.Value); Parent := ANode.Parent; if Parent <> nil then begin ChildIndex := Parent.IndexOfChild(ANode); for Index := ChildIndex + 1 to Parent.ChildrenCount - 1 do Parent.Children[Index - 1] := Parent.Children[Index]; Dec(Parent.ChildrenCount); NewCapacity := CalcPackCapacity(Length(Parent.Children), Parent.ChildrenCount); if NewCapacity < Length(Parent.Children) then SetLength(Parent.Children, NewCapacity); FreeAndNil(ANode); end else begin FreeAndNil(ANode); FRoot := nil; end; Dec(FSize); end; function TJclUnicodeStrTree.RetainAll(const ACollection: IJclUnicodeStrCollection): Boolean; var It: IJclUnicodeStrIterator; begin if ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginWrite; try {$ENDIF THREADSAFE} Result := False; if ACollection = nil then Exit; Result := True; It := First; while It.HasNext do if not ACollection.Contains(It.Next) then It.Remove; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndWrite; end; {$ENDIF THREADSAFE} end; procedure TJclUnicodeStrTree.SetCapacity(Value: Integer); begin raise EJclOperationNotSupportedError.Create; end; procedure TJclUnicodeStrTree.SetTraverseOrder(Value: TJclTraverseOrder); begin FTraverseOrder := Value; end; function TJclUnicodeStrTree.Size: Integer; begin Result := FSize; end; function TJclUnicodeStrTree.CreateEmptyContainer: TJclAbstractContainerBase; begin Result := TJclUnicodeStrTree.Create; AssignPropertiesTo(Result); end; //=== { TJclUnicodeStrTreeIterator } =========================================================== constructor TJclUnicodeStrTreeIterator.Create(OwnTree: TJclUnicodeStrTree; ACursor: TJclUnicodeStrTreeNode; AValid: Boolean; AStart: TItrStart); begin inherited Create(AValid); FCursor := ACursor; FOwnTree := OwnTree; FStart := AStart; FEqualityComparer := OwnTree as IJclUnicodeStrEqualityComparer; end; function TJclUnicodeStrTreeIterator.Add(const AString: UnicodeString): Boolean; var ParentNode, NewNode: TJclUnicodeStrTreeNode; begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} // add sibling or, if FCursor is root node, behave like TJclUnicodeStrTree.Add Result := (FCursor <> nil) and (FOwnTree.AllowDefaultElements or not FEqualityComparer.ItemsEqual(AString, '')) and ((not FOwnTree.Contains(AString)) or FOwnTree.CheckDuplicate); if Result then begin ParentNode := FCursor.Parent; if ParentNode = nil then ParentNode := FCursor; if ParentNode.ChildrenCount = Length(ParentNode.Children) then SetLength(ParentNode.Children, FOwnTree.CalcGrowCapacity(Length(ParentNode.Children), ParentNode.ChildrenCount)); if ParentNode.ChildrenCount < Length(ParentNode.Children) then begin NewNode := TJclUnicodeStrTreeNode.Create; NewNode.Value := AString; NewNode.Parent := ParentNode; ParentNode.Children[ParentNode.ChildrenCount] := NewNode; Inc(ParentNode.ChildrenCount); Inc(FOwnTree.FSize); end; end; {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; function TJclUnicodeStrTreeIterator.AddChild(const AString: UnicodeString): Boolean; var NewNode: TJclUnicodeStrTreeNode; begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} Result := (FCursor <> nil) and (FOwnTree.AllowDefaultElements or not FEqualityComparer.ItemsEqual(AString, '')) and ((not FOwnTree.Contains(AString)) or FOwnTree.CheckDuplicate); if Result then begin if FCursor.ChildrenCount = Length(FCursor.Children) then SetLength(FCursor.Children, FOwnTree.CalcGrowCapacity(Length(FCursor.Children), FCursor.ChildrenCount)); if FCursor.ChildrenCount < Length(FCursor.Children) then begin NewNode := TJclUnicodeStrTreeNode.Create; NewNode.Value := AString; NewNode.Parent := FCursor; FCursor.Children[FCursor.ChildrenCount] := NewNode; Inc(FCursor.ChildrenCount); Inc(FOwnTree.FSize); end; end; {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; procedure TJclUnicodeStrTreeIterator.AssignPropertiesTo(Dest: TJclAbstractIterator); var ADest: TJclUnicodeStrTreeIterator; begin inherited AssignPropertiesTo(Dest); if Dest is TJclUnicodeStrTreeIterator then begin ADest := TJclUnicodeStrTreeIterator(Dest); ADest.FCursor := FCursor; ADest.FOwnTree := FOwnTree; ADest.FEqualityComparer := FEqualityComparer; ADest.FStart := FStart; end; end; function TJclUnicodeStrTreeIterator.ChildrenCount: Integer; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} if FCursor <> nil then Result := FCursor.ChildrenCount else Result := 0; {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; procedure TJclUnicodeStrTreeIterator.DeleteChild(Index: Integer); begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} if (FCursor <> nil) and (Index >= 0) and (Index < FCursor.ChildrenCount) then {$IFDEF BCB} FOwnTree.RemoveNode(TJclUnicodeStrTreeNode(FCursor.Children[Index])) {$ELSE ~BCB} FOwnTree.RemoveNode(FCursor.Children[Index]) {$ENDIF ~BCB} else raise EJclOutOfBoundsError.Create; {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; procedure TJclUnicodeStrTreeIterator.DeleteChildren; var Index: Integer; begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} if FCursor <> nil then begin for Index := FCursor.ChildrenCount - 1 downto 0 do {$IFDEF BCB} FOwnTree.RemoveNode(TJclUnicodeStrTreeNode(FCursor.Children[Index])); {$ELSE ~BCB} FOwnTree.RemoveNode(FCursor.Children[Index]); {$ENDIF ~BCB} SetLength(FCursor.Children, 0); FCursor.ChildrenCount := 0; end; {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; procedure TJclUnicodeStrTreeIterator.Extract; var OldCursor: TJclUnicodeStrTreeNode; begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} CheckValid; Valid := False; OldCursor := FCursor; FCursor := GetNextSibling; if OldCursor <> nil then FOwnTree.ExtractNode(OldCursor); {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; procedure TJclUnicodeStrTreeIterator.ExtractChild(Index: Integer); begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} if (FCursor <> nil) and (Index >= 0) and (Index < FCursor.ChildrenCount) then {$IFDEF BCB} FOwnTree.ExtractNode(TJclUnicodeStrTreeNode(FCursor.Children[Index])) {$ELSE ~BCB} FOwnTree.ExtractNode(FCursor.Children[Index]) {$ENDIF ~BCB} else raise EJclOutOfBoundsError.Create; {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; procedure TJclUnicodeStrTreeIterator.ExtractChildren; var Index: Integer; begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} if FCursor <> nil then begin for Index := FCursor.ChildrenCount - 1 downto 0 do {$IFDEF BCB} FOwnTree.ExtractNode(TJclUnicodeStrTreeNode(FCursor.Children[Index])); {$ELSE ~BCB} FOwnTree.ExtractNode(FCursor.Children[Index]); {$ENDIF ~BCB} SetLength(FCursor.Children, 0); FCursor.ChildrenCount := 0; end; {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; function TJclUnicodeStrTreeIterator.GetChild(Index: Integer): UnicodeString; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} Result := ''; if (FCursor <> nil) and (Index >= 0) and (Index < FCursor.ChildrenCount) then FCursor := TJclUnicodeStrTreeNode(FCursor.Children[Index]); if FCursor <> nil then Result := FCursor.Value else if not FOwnTree.ReturnDefaultElements then raise EJclNoSuchElementError.Create(''); {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; function TJclUnicodeStrTreeIterator.GetString: UnicodeString; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} CheckValid; Result := ''; if FCursor <> nil then Result := FCursor.Value else if not FOwnTree.ReturnDefaultElements then raise EJclNoSuchElementError.Create(''); {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; function TJclUnicodeStrTreeIterator.HasChild(Index: Integer): Boolean; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} Result := (FCursor <> nil) and (Index >= 0) and (Index < FCursor.ChildrenCount); {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; function TJclUnicodeStrTreeIterator.HasNext: Boolean; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} if Valid then Result := GetNextCursor <> nil else Result := FCursor <> nil; {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; function TJclUnicodeStrTreeIterator.HasParent: Boolean; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} Result := (FCursor <> nil) and (FCursor.Parent <> nil); {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; function TJclUnicodeStrTreeIterator.HasPrevious: Boolean; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} if Valid then Result := GetPreviousCursor <> nil else Result := FCursor <> nil; {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; function TJclUnicodeStrTreeIterator.IndexOfChild(const AString: UnicodeString): Integer; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} if FCursor <> nil then Result := FCursor.IndexOfValue(AString, FEqualityComparer) else Result := -1; {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; function TJclUnicodeStrTreeIterator.Insert(const AString: UnicodeString): Boolean; var ParentNode, NewNode: TJclUnicodeStrTreeNode; Index, I: Integer; begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} // insert sibling or, if FCursor is root node, behave like TJclUnicodeStrTree.Insert Result := (FCursor <> nil) and (FOwnTree.AllowDefaultElements or not FEqualityComparer.ItemsEqual(AString, '')) and ((not FOwnTree.Contains(AString)) or FOwnTree.CheckDuplicate); if Result then begin if FCursor.Parent <> nil then begin ParentNode := FCursor.Parent; Index := 0; while (Index < ParentNode.ChildrenCount) and (ParentNode.Children[Index] <> FCursor) do Inc(Index); end else begin ParentNode := FCursor; Index := 0; end; if ParentNode.ChildrenCount = Length(ParentNode.Children) then SetLength(ParentNode.Children, FOwnTree.CalcGrowCapacity(Length(ParentNode.Children), ParentNode.ChildrenCount)); if ParentNode.ChildrenCount < Length(ParentNode.Children) then begin NewNode := TJclUnicodeStrTreeNode.Create; NewNode.Value := AString; NewNode.Parent := ParentNode; for I := ParentNode.ChildrenCount - 1 downto Index do ParentNode.Children[I + 1] := ParentNode.Children[I]; ParentNode.Children[Index] := NewNode; Inc(ParentNode.ChildrenCount); Inc(FOwnTree.FSize); end; end; {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; function TJclUnicodeStrTreeIterator.InsertChild(Index: Integer; const AString: UnicodeString): Boolean; var NewNode: TJclUnicodeStrTreeNode; I: Integer; begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} // insert sibling or, if FCursor is root node, behave like TJclUnicodeStrTree.Insert Result := (FCursor <> nil) and (FOwnTree.AllowDefaultElements or not FEqualityComparer.ItemsEqual(AString, '')) and ((not FOwnTree.Contains(AString)) or FOwnTree.CheckDuplicate); if Result then begin if FCursor.ChildrenCount = Length(FCursor.Children) then SetLength(FCursor.Children, FOwnTree.CalcGrowCapacity(Length(FCursor.Children), FCursor.ChildrenCount)); if FCursor.ChildrenCount < Length(FCursor.Children) then begin NewNode := TJclUnicodeStrTreeNode.Create; NewNode.Value := AString; NewNode.Parent := FCursor; for I := FCursor.ChildrenCount - 1 downto Index do FCursor.Children[I + 1] := FCursor.Children[I]; FCursor.Children[Index] := NewNode; Inc(FCursor.ChildrenCount); Inc(FOwnTree.FSize); end; end; {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; function TJclUnicodeStrTreeIterator.IteratorEquals(const AIterator: IJclUnicodeStrIterator): Boolean; var Obj: TObject; ItrObj: TJclUnicodeStrTreeIterator; begin Result := False; if AIterator = nil then Exit; Obj := AIterator.GetIteratorReference; if Obj is TJclUnicodeStrTreeIterator then begin ItrObj := TJclUnicodeStrTreeIterator(Obj); Result := (FOwnTree = ItrObj.FOwnTree) and (FCursor = ItrObj.FCursor) and (Valid = ItrObj.Valid); end; end; {$IFDEF SUPPORTS_FOR_IN} function TJclUnicodeStrTreeIterator.MoveNext: Boolean; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} if Valid then FCursor := GetNextCursor else Valid := True; Result := FCursor <> nil; {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; {$ENDIF SUPPORTS_FOR_IN} function TJclUnicodeStrTreeIterator.Next: UnicodeString; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} if Valid then FCursor := GetNextCursor else Valid := True; Result := ''; if FCursor <> nil then Result := FCursor.Value else if not FOwnTree.ReturnDefaultElements then raise EJclNoSuchElementError.Create(''); {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; function TJclUnicodeStrTreeIterator.NextIndex: Integer; begin // No index raise EJclOperationNotSupportedError.Create; end; function TJclUnicodeStrTreeIterator.Parent: UnicodeString; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} Result := ''; if FCursor <> nil then FCursor := FCursor.Parent; if FCursor <> nil then Result := FCursor.Value else if not FOwnTree.ReturnDefaultElements then raise EJclNoSuchElementError.Create(''); {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; function TJclUnicodeStrTreeIterator.Previous: UnicodeString; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} if Valid then FCursor := GetPreviousCursor else Valid := True; Result := ''; if FCursor <> nil then Result := FCursor.Value else if not FOwnTree.ReturnDefaultElements then raise EJclNoSuchElementError.Create(''); {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; function TJclUnicodeStrTreeIterator.PreviousIndex: Integer; begin // No index raise EJclOperationNotSupportedError.Create; end; procedure TJclUnicodeStrTreeIterator.Remove; var OldCursor: TJclUnicodeStrTreeNode; begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} CheckValid; Valid := False; OldCursor := FCursor; FCursor := GetNextSibling; if OldCursor <> nil then FOwnTree.RemoveNode(OldCursor); {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; procedure TJclUnicodeStrTreeIterator.Reset; var NewCursor: TJclUnicodeStrTreeNode; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} Valid := False; case FStart of isFirst: begin NewCursor := FCursor; while NewCursor <> nil do begin NewCursor := GetPreviousCursor; if NewCursor <> nil then FCursor := NewCursor; end; end; isLast: begin NewCursor := FCursor; while NewCursor <> nil do begin NewCursor := GetNextCursor; if NewCursor <> nil then FCursor := NewCursor; end; end; isRoot: begin while (FCursor <> nil) and (FCursor.Parent <> nil) do FCursor := FCursor.Parent; end; end; {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; procedure TJclUnicodeStrTreeIterator.SetChild(Index: Integer; const AString: UnicodeString); begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} if (FCursor <> nil) and (Index >= 0) and (Index < FCursor.ChildrenCount) then TJclUnicodeStrTreeNode(FCursor.Children[Index]).Value := AString else raise EJclOutOfBoundsError.Create; {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; procedure TJclUnicodeStrTreeIterator.SetString(const AString: UnicodeString); begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} CheckValid; if FCursor <> nil then begin FOwnTree.FreeString(FCursor.Value); FCursor.Value := AString; end; {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; //=== { TJclPreOrderUnicodeStrTreeIterator } =================================================== function TJclPreOrderUnicodeStrTreeIterator.CreateEmptyIterator: TJclAbstractIterator; begin Result := TJclPreOrderUnicodeStrTreeIterator.Create(FOwnTree, FCursor, Valid, FStart); end; function TJclPreOrderUnicodeStrTreeIterator.GetNextCursor: TJclUnicodeStrTreeNode; var LastRet: TJclUnicodeStrTreeNode; begin Result := FCursor; if Result = nil then Exit; LastRet := Result; if Result.ChildrenCount > 0 then Result := TJclUnicodeStrTreeNode(Result.Children[0]) else begin Result := Result.Parent; while (Result <> nil) and (Result.IndexOfChild(LastRet) = (Result.ChildrenCount - 1)) do begin LastRet := Result; Result := Result.Parent; end; if Result <> nil then // not root = return successor Result := TJclUnicodeStrTreeNode(Result.Children[Result.IndexOfChild(LastRet) + 1]); end; end; function TJclPreOrderUnicodeStrTreeIterator.GetNextSibling: TJclUnicodeStrTreeNode; var LastRet: TJclUnicodeStrTreeNode; begin Result := FCursor; if Result = nil then Exit; LastRet := Result; Result := Result.Parent; while (Result <> nil) and (Result.IndexOfChild(LastRet) = (Result.ChildrenCount - 1)) do begin LastRet := Result; Result := Result.Parent; end; if Result <> nil then // not root = return successor Result := TJclUnicodeStrTreeNode(Result.Children[Result.IndexOfChild(LastRet) + 1]); end; function TJclPreOrderUnicodeStrTreeIterator.GetPreviousCursor: TJclUnicodeStrTreeNode; var LastRet: TJclUnicodeStrTreeNode; begin Result := FCursor; if Result = nil then Exit; LastRet := Result; Result := Result.Parent; if (Result <> nil) and (Result.IndexOfChild(LastRet) > 0) then // come from Right begin Result := TJclUnicodeStrTreeNode(Result.Children[Result.IndexOfChild(LastRet) - 1]); while (Result.ChildrenCount > 0) do // descend down the tree Result := TJclUnicodeStrTreeNode(Result.Children[Result.ChildrenCount - 1]); end; end; //=== { TJclPostOrderUnicodeStrTreeIterator } ================================================== function TJclPostOrderUnicodeStrTreeIterator.CreateEmptyIterator: TJclAbstractIterator; begin Result := TJclPostOrderUnicodeStrTreeIterator.Create(FOwnTree, FCursor, Valid, FStart); end; function TJclPostOrderUnicodeStrTreeIterator.GetNextCursor: TJclUnicodeStrTreeNode; var LastRet: TJclUnicodeStrTreeNode; begin Result := FCursor; if Result = nil then Exit; LastRet := Result; Result := Result.Parent; if (Result <> nil) and (Result.IndexOfChild(LastRet) <> (Result.ChildrenCount - 1)) then begin Result := TJclUnicodeStrTreeNode(Result.Children[Result.IndexOfChild(LastRet) + 1]); while Result.ChildrenCount > 0 do Result := TJclUnicodeStrTreeNode(Result.Children[0]); end; end; function TJclPostOrderUnicodeStrTreeIterator.GetNextSibling: TJclUnicodeStrTreeNode; var LastRet: TJclUnicodeStrTreeNode; begin Result := FCursor; if Result = nil then Exit; LastRet := Result; Result := Result.Parent; if (Result <> nil) and (Result.IndexOfChild(LastRet) <> (Result.ChildrenCount - 1)) then begin Result := TJclUnicodeStrTreeNode(Result.Children[Result.IndexOfChild(LastRet) + 1]); while Result.ChildrenCount > 0 do Result := TJclUnicodeStrTreeNode(Result.Children[0]); end; end; function TJclPostOrderUnicodeStrTreeIterator.GetPreviousCursor: TJclUnicodeStrTreeNode; var LastRet: TJclUnicodeStrTreeNode; begin Result := FCursor; if Result = nil then Exit; if Result.ChildrenCount > 0 then Result := TJclUnicodeStrTreeNode(Result.Children[Result.ChildrenCount - 1]) else begin LastRet := Result; Result := Result.Parent; while (Result <> nil) and (Result.IndexOfChild(LastRet) = 0) do begin LastRet := Result; Result := Result.Parent; end; if Result <> nil then // not root Result := TJclUnicodeStrTreeNode(Result.Children[Result.IndexOfChild(LastRet) - 1]); end; end; {$ENDIF SUPPORTS_UNICODE_STRING} //=== { TJclSingleTreeNode } ======================================================= function TJclSingleTreeNode.IndexOfChild(AChild: TJclSingleTreeNode): Integer; begin for Result := 0 to ChildrenCount - 1 do if Children[Result] = AChild then Exit; Result := -1; end; function TJclSingleTreeNode.IndexOfValue(const AValue: Single; const AEqualityComparer: IJclSingleEqualityComparer): Integer; begin for Result := 0 to ChildrenCount - 1 do if AEqualityComparer.ItemsEqual(TJclSingleTreeNode(Children[Result]).Value, AValue) then Exit; Result := -1; end; //=== { TJclSingleTree } ======================================================= constructor TJclSingleTree.Create(); begin inherited Create(); FTraverseOrder := toPreOrder; end; destructor TJclSingleTree.Destroy; begin FReadOnly := False; Clear; inherited Destroy; end; function TJclSingleTree.Add(const AValue: Single): Boolean; var NewNode: TJclSingleTreeNode; begin if ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginWrite; try {$ENDIF THREADSAFE} Result := AllowDefaultElements or not ItemsEqual(AValue, 0.0); if Result then begin if FRoot <> nil then begin Result := (not Contains(AValue)) or CheckDuplicate; if Result then begin if FRoot.ChildrenCount = Length(FRoot.Children) then SetLength(FRoot.Children, CalcGrowCapacity(Length(FRoot.Children), FRoot.ChildrenCount)); if FRoot.ChildrenCount < Length(FRoot.Children) then begin NewNode := TJclSingleTreeNode.Create; NewNode.Value := AValue; NewNode.Parent := FRoot; FRoot.Children[FRoot.ChildrenCount] := NewNode; Inc(FRoot.ChildrenCount); Inc(FSize); end else Result := False; end; end else begin FRoot := TJclSingleTreeNode.Create; FRoot.Value := AValue; Inc(FSize); end; end; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndWrite; end; {$ENDIF THREADSAFE} end; function TJclSingleTree.AddAll(const ACollection: IJclSingleCollection): Boolean; var It: IJclSingleIterator; begin if ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginWrite; try {$ENDIF THREADSAFE} Result := False; if ACollection = nil then Exit; Result := True; It := ACollection.First; while It.HasNext do Result := Add(It.Next) and Result; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndWrite; end; {$ENDIF THREADSAFE} end; procedure TJclSingleTree.AssignDataTo(Dest: TJclAbstractContainerBase); var ADest: TJclSingleTree; ACollection: IJclSingleCollection; begin inherited AssignDataTo(Dest); if Dest is TJclSingleTree then begin ADest := TJclSingleTree(Dest); ADest.Clear; ADest.FSize := FSize; if FRoot <> nil then ADest.FRoot := CloneNode(FRoot, nil); end else if Supports(IInterface(Dest), IJclSingleCollection, ACollection) then begin ACollection.Clear; ACollection.AddAll(Self); end; end; procedure TJclSingleTree.AssignPropertiesTo(Dest: TJclAbstractContainerBase); begin inherited AssignPropertiesto(Dest); if Dest is TJclSingleTree then TJclSingleTree(Dest).FTraverseOrder := FTraverseOrder; end; procedure TJclSingleTree.Clear; begin if ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginWrite; try {$ENDIF THREADSAFE} if FRoot <> nil then RemoveNode(FRoot); FSize := 0; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndWrite; end; {$ENDIF THREADSAFE} end; function TJclSingleTree.CloneNode(Node, Parent: TJclSingleTreeNode): TJclSingleTreeNode; var Index: Integer; begin Result := TJclSingleTreeNode.Create; Result.Value := Node.Value; Result.Parent := Parent; SetLength(Result.Children, Node.ChildrenCount); Result.ChildrenCount := Node.ChildrenCount; for Index := 0 to Node.ChildrenCount - 1 do Result.Children[Index] := CloneNode(TJclSingleTreeNode(Node.Children[Index]), Result); // recursive call end; function TJclSingleTree.CollectionEquals(const ACollection: IJclSingleCollection): Boolean; var It, ItSelf: IJclSingleIterator; begin {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginRead; try {$ENDIF THREADSAFE} Result := False; if ACollection = nil then Exit; if FSize <> ACollection.Size then Exit; Result := True; It := ACollection.First; ItSelf := First; while ItSelf.HasNext do if not ItemsEqual(ItSelf.Next, It.Next) then begin Result := False; Break; end; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndRead; end; {$ENDIF THREADSAFE} end; function TJclSingleTree.Contains(const AValue: Single): Boolean; begin {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginRead; try {$ENDIF THREADSAFE} if FRoot <> nil then Result := NodeContains(FRoot, AValue) else Result := False; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndRead; end; {$ENDIF THREADSAFE} end; function TJclSingleTree.ContainsAll(const ACollection: IJclSingleCollection): Boolean; var It: IJclSingleIterator; begin {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginRead; try {$ENDIF THREADSAFE} Result := True; if ACollection = nil then Exit; It := ACollection.First; while Result and It.HasNext do Result := Contains(It.Next); {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndRead; end; {$ENDIF THREADSAFE} end; function TJclSingleTree.Extract(const AValue: Single): Boolean; var It: IJclSingleIterator; begin if ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginWrite; try {$ENDIF THREADSAFE} Result := FRoot <> nil; if Result then begin It := First; while It.HasNext do if ItemsEqual(It.Next, AValue) then begin It.Extract; if RemoveSingleElement then Break; end; end; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndWrite; end; {$ENDIF THREADSAFE} end; function TJclSingleTree.ExtractAll(const ACollection: IJclSingleCollection): Boolean; var It: IJclSingleIterator; begin if ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginWrite; try {$ENDIF THREADSAFE} Result := False; if ACollection = nil then Exit; Result := True; It := ACollection.First; while It.HasNext do Result := Extract(It.Next) and Result; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndWrite; end; {$ENDIF THREADSAFE} end; procedure TJclSingleTree.ExtractNode(var ANode: TJclSingleTreeNode); var Index, ChildIndex, NewCapacity: Integer; Parent: TJclSingleTreeNode; begin for Index := ANode.ChildrenCount - 1 downto 0 do {$IFDEF BCB} ExtractNode(TJclSingleTreeNode(ANode.Children[Index])); {$ELSE ~BCB} ExtractNode(ANode.Children[Index]); {$ENDIF ~BCB} Parent := ANode.Parent; if Parent <> nil then begin ChildIndex := Parent.IndexOfChild(ANode); for Index := ChildIndex + 1 to Parent.ChildrenCount - 1 do Parent.Children[Index - 1] := Parent.Children[Index]; Dec(Parent.ChildrenCount); NewCapacity := CalcPackCapacity(Length(Parent.Children), Parent.ChildrenCount); if NewCapacity < Length(Parent.Children) then SetLength(Parent.Children, NewCapacity); FreeAndNil(ANode); end else begin FreeAndNil(ANode); FRoot := nil; end; Dec(FSize); end; function TJclSingleTree.First: IJclSingleIterator; var Start: TJclSingleTreeNode; begin {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginRead; try {$ENDIF THREADSAFE} Start := FRoot; case GetTraverseOrder of toPreOrder: Result := TJclPreOrderSingleTreeIterator.Create(Self, Start, False, isFirst); toPostOrder: begin if Start <> nil then while (Start.ChildrenCount > 0) do Start := TJclSingleTreeNode(Start.Children[0]); Result := TJclPostOrderSingleTreeIterator.Create(Self, Start, False, isFirst); end; else Result := nil; end; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndRead; end; {$ENDIF THREADSAFE} end; {$IFDEF SUPPORTS_FOR_IN} function TJclSingleTree.GetEnumerator: IJclSingleIterator; begin Result := First; end; {$ENDIF SUPPORTS_FOR_IN} function TJclSingleTree.GetRoot: IJclSingleTreeIterator; begin {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginRead; try {$ENDIF THREADSAFE} case GetTraverseOrder of toPreOrder: Result := TJclPreOrderSingleTreeIterator.Create(Self, FRoot, False, isRoot); toPostOrder: Result := TJclPostOrderSingleTreeIterator.Create(Self, FRoot, False, isRoot); else Result := nil; end; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndRead; end; {$ENDIF THREADSAFE} end; function TJclSingleTree.GetTraverseOrder: TJclTraverseOrder; begin Result := FTraverseOrder; end; function TJclSingleTree.IsEmpty: Boolean; begin Result := FSize = 0; end; function TJclSingleTree.Last: IJclSingleIterator; var Start: TJclSingleTreeNode; begin {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginRead; try {$ENDIF THREADSAFE} Start := FRoot; case FTraverseOrder of toPreOrder: begin if Start <> nil then while Start.ChildrenCount > 0 do Start := TJclSingleTreeNode(Start.Children[Start.ChildrenCount - 1]); Result := TJclPreOrderSingleTreeIterator.Create(Self, Start, False, isLast); end; toPostOrder: Result := TJclPostOrderSingleTreeIterator.Create(Self, Start, False, isLast); else Result := nil; end; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndRead; end; {$ENDIF THREADSAFE} end; function TJclSingleTree.NodeContains(ANode: TJclSingleTreeNode; const AValue: Single): Boolean; var Index: Integer; begin Result := ItemsEqual(ANode.Value, AValue); if not Result then for Index := 0 to ANode.ChildrenCount - 1 do begin Result := NodeContains(TJclSingleTreeNode(ANode.Children[Index]), AValue); if Result then Break; end; end; procedure TJclSingleTree.Pack; begin if ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginWrite; try {$ENDIF THREADSAFE} if FRoot <> nil then PackNode(FRoot); {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndWrite; end; {$ENDIF THREADSAFE} end; procedure TJclSingleTree.PackNode(ANode: TJclSingleTreeNode); var Index: Integer; begin SetLength(ANode.Children, ANode.ChildrenCount); for Index := 0 to ANode.ChildrenCount - 1 do PackNode(TJclSingleTreeNode(ANode.Children[Index])); end; function TJclSingleTree.Remove(const AValue: Single): Boolean; var Extracted: Single; begin if ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginWrite; try {$ENDIF THREADSAFE} Result := Extract(AValue); if Result then begin Extracted := AValue; FreeSingle(Extracted); end; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndWrite; end; {$ENDIF THREADSAFE} end; function TJclSingleTree.RemoveAll(const ACollection: IJclSingleCollection): Boolean; var It: IJclSingleIterator; begin if ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginWrite; try {$ENDIF THREADSAFE} Result := False; if ACollection = nil then Exit; Result := True; It := ACollection.First; while It.HasNext do Result := Remove(It.Next) and Result; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndWrite; end; {$ENDIF THREADSAFE} end; procedure TJclSingleTree.RemoveNode(var ANode: TJclSingleTreeNode); var Index, ChildIndex, NewCapacity: Integer; Parent: TJclSingleTreeNode; begin for Index := ANode.ChildrenCount - 1 downto 0 do {$IFDEF BCB} RemoveNode(TJclSingleTreeNode(ANode.Children[Index])); {$ELSE ~BCB} RemoveNode(ANode.Children[Index]); {$ENDIF ~BCB} FreeSingle(ANode.Value); Parent := ANode.Parent; if Parent <> nil then begin ChildIndex := Parent.IndexOfChild(ANode); for Index := ChildIndex + 1 to Parent.ChildrenCount - 1 do Parent.Children[Index - 1] := Parent.Children[Index]; Dec(Parent.ChildrenCount); NewCapacity := CalcPackCapacity(Length(Parent.Children), Parent.ChildrenCount); if NewCapacity < Length(Parent.Children) then SetLength(Parent.Children, NewCapacity); FreeAndNil(ANode); end else begin FreeAndNil(ANode); FRoot := nil; end; Dec(FSize); end; function TJclSingleTree.RetainAll(const ACollection: IJclSingleCollection): Boolean; var It: IJclSingleIterator; begin if ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginWrite; try {$ENDIF THREADSAFE} Result := False; if ACollection = nil then Exit; Result := True; It := First; while It.HasNext do if not ACollection.Contains(It.Next) then It.Remove; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndWrite; end; {$ENDIF THREADSAFE} end; procedure TJclSingleTree.SetCapacity(Value: Integer); begin raise EJclOperationNotSupportedError.Create; end; procedure TJclSingleTree.SetTraverseOrder(Value: TJclTraverseOrder); begin FTraverseOrder := Value; end; function TJclSingleTree.Size: Integer; begin Result := FSize; end; function TJclSingleTree.CreateEmptyContainer: TJclAbstractContainerBase; begin Result := TJclSingleTree.Create; AssignPropertiesTo(Result); end; //=== { TJclSingleTreeIterator } =========================================================== constructor TJclSingleTreeIterator.Create(OwnTree: TJclSingleTree; ACursor: TJclSingleTreeNode; AValid: Boolean; AStart: TItrStart); begin inherited Create(AValid); FCursor := ACursor; FOwnTree := OwnTree; FStart := AStart; FEqualityComparer := OwnTree as IJclSingleEqualityComparer; end; function TJclSingleTreeIterator.Add(const AValue: Single): Boolean; var ParentNode, NewNode: TJclSingleTreeNode; begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} // add sibling or, if FCursor is root node, behave like TJclSingleTree.Add Result := (FCursor <> nil) and (FOwnTree.AllowDefaultElements or not FEqualityComparer.ItemsEqual(AValue, 0.0)) and ((not FOwnTree.Contains(AValue)) or FOwnTree.CheckDuplicate); if Result then begin ParentNode := FCursor.Parent; if ParentNode = nil then ParentNode := FCursor; if ParentNode.ChildrenCount = Length(ParentNode.Children) then SetLength(ParentNode.Children, FOwnTree.CalcGrowCapacity(Length(ParentNode.Children), ParentNode.ChildrenCount)); if ParentNode.ChildrenCount < Length(ParentNode.Children) then begin NewNode := TJclSingleTreeNode.Create; NewNode.Value := AValue; NewNode.Parent := ParentNode; ParentNode.Children[ParentNode.ChildrenCount] := NewNode; Inc(ParentNode.ChildrenCount); Inc(FOwnTree.FSize); end; end; {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; function TJclSingleTreeIterator.AddChild(const AValue: Single): Boolean; var NewNode: TJclSingleTreeNode; begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} Result := (FCursor <> nil) and (FOwnTree.AllowDefaultElements or not FEqualityComparer.ItemsEqual(AValue, 0.0)) and ((not FOwnTree.Contains(AValue)) or FOwnTree.CheckDuplicate); if Result then begin if FCursor.ChildrenCount = Length(FCursor.Children) then SetLength(FCursor.Children, FOwnTree.CalcGrowCapacity(Length(FCursor.Children), FCursor.ChildrenCount)); if FCursor.ChildrenCount < Length(FCursor.Children) then begin NewNode := TJclSingleTreeNode.Create; NewNode.Value := AValue; NewNode.Parent := FCursor; FCursor.Children[FCursor.ChildrenCount] := NewNode; Inc(FCursor.ChildrenCount); Inc(FOwnTree.FSize); end; end; {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; procedure TJclSingleTreeIterator.AssignPropertiesTo(Dest: TJclAbstractIterator); var ADest: TJclSingleTreeIterator; begin inherited AssignPropertiesTo(Dest); if Dest is TJclSingleTreeIterator then begin ADest := TJclSingleTreeIterator(Dest); ADest.FCursor := FCursor; ADest.FOwnTree := FOwnTree; ADest.FEqualityComparer := FEqualityComparer; ADest.FStart := FStart; end; end; function TJclSingleTreeIterator.ChildrenCount: Integer; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} if FCursor <> nil then Result := FCursor.ChildrenCount else Result := 0; {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; procedure TJclSingleTreeIterator.DeleteChild(Index: Integer); begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} if (FCursor <> nil) and (Index >= 0) and (Index < FCursor.ChildrenCount) then {$IFDEF BCB} FOwnTree.RemoveNode(TJclSingleTreeNode(FCursor.Children[Index])) {$ELSE ~BCB} FOwnTree.RemoveNode(FCursor.Children[Index]) {$ENDIF ~BCB} else raise EJclOutOfBoundsError.Create; {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; procedure TJclSingleTreeIterator.DeleteChildren; var Index: Integer; begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} if FCursor <> nil then begin for Index := FCursor.ChildrenCount - 1 downto 0 do {$IFDEF BCB} FOwnTree.RemoveNode(TJclSingleTreeNode(FCursor.Children[Index])); {$ELSE ~BCB} FOwnTree.RemoveNode(FCursor.Children[Index]); {$ENDIF ~BCB} SetLength(FCursor.Children, 0); FCursor.ChildrenCount := 0; end; {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; procedure TJclSingleTreeIterator.Extract; var OldCursor: TJclSingleTreeNode; begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} CheckValid; Valid := False; OldCursor := FCursor; FCursor := GetNextSibling; if OldCursor <> nil then FOwnTree.ExtractNode(OldCursor); {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; procedure TJclSingleTreeIterator.ExtractChild(Index: Integer); begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} if (FCursor <> nil) and (Index >= 0) and (Index < FCursor.ChildrenCount) then {$IFDEF BCB} FOwnTree.ExtractNode(TJclSingleTreeNode(FCursor.Children[Index])) {$ELSE ~BCB} FOwnTree.ExtractNode(FCursor.Children[Index]) {$ENDIF ~BCB} else raise EJclOutOfBoundsError.Create; {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; procedure TJclSingleTreeIterator.ExtractChildren; var Index: Integer; begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} if FCursor <> nil then begin for Index := FCursor.ChildrenCount - 1 downto 0 do {$IFDEF BCB} FOwnTree.ExtractNode(TJclSingleTreeNode(FCursor.Children[Index])); {$ELSE ~BCB} FOwnTree.ExtractNode(FCursor.Children[Index]); {$ENDIF ~BCB} SetLength(FCursor.Children, 0); FCursor.ChildrenCount := 0; end; {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; function TJclSingleTreeIterator.GetChild(Index: Integer): Single; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} Result := 0.0; if (FCursor <> nil) and (Index >= 0) and (Index < FCursor.ChildrenCount) then FCursor := TJclSingleTreeNode(FCursor.Children[Index]); if FCursor <> nil then Result := FCursor.Value else if not FOwnTree.ReturnDefaultElements then raise EJclNoSuchElementError.Create(''); {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; function TJclSingleTreeIterator.GetValue: Single; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} CheckValid; Result := 0.0; if FCursor <> nil then Result := FCursor.Value else if not FOwnTree.ReturnDefaultElements then raise EJclNoSuchElementError.Create(''); {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; function TJclSingleTreeIterator.HasChild(Index: Integer): Boolean; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} Result := (FCursor <> nil) and (Index >= 0) and (Index < FCursor.ChildrenCount); {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; function TJclSingleTreeIterator.HasNext: Boolean; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} if Valid then Result := GetNextCursor <> nil else Result := FCursor <> nil; {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; function TJclSingleTreeIterator.HasParent: Boolean; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} Result := (FCursor <> nil) and (FCursor.Parent <> nil); {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; function TJclSingleTreeIterator.HasPrevious: Boolean; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} if Valid then Result := GetPreviousCursor <> nil else Result := FCursor <> nil; {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; function TJclSingleTreeIterator.IndexOfChild(const AValue: Single): Integer; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} if FCursor <> nil then Result := FCursor.IndexOfValue(AValue, FEqualityComparer) else Result := -1; {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; function TJclSingleTreeIterator.Insert(const AValue: Single): Boolean; var ParentNode, NewNode: TJclSingleTreeNode; Index, I: Integer; begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} // insert sibling or, if FCursor is root node, behave like TJclSingleTree.Insert Result := (FCursor <> nil) and (FOwnTree.AllowDefaultElements or not FEqualityComparer.ItemsEqual(AValue, 0.0)) and ((not FOwnTree.Contains(AValue)) or FOwnTree.CheckDuplicate); if Result then begin if FCursor.Parent <> nil then begin ParentNode := FCursor.Parent; Index := 0; while (Index < ParentNode.ChildrenCount) and (ParentNode.Children[Index] <> FCursor) do Inc(Index); end else begin ParentNode := FCursor; Index := 0; end; if ParentNode.ChildrenCount = Length(ParentNode.Children) then SetLength(ParentNode.Children, FOwnTree.CalcGrowCapacity(Length(ParentNode.Children), ParentNode.ChildrenCount)); if ParentNode.ChildrenCount < Length(ParentNode.Children) then begin NewNode := TJclSingleTreeNode.Create; NewNode.Value := AValue; NewNode.Parent := ParentNode; for I := ParentNode.ChildrenCount - 1 downto Index do ParentNode.Children[I + 1] := ParentNode.Children[I]; ParentNode.Children[Index] := NewNode; Inc(ParentNode.ChildrenCount); Inc(FOwnTree.FSize); end; end; {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; function TJclSingleTreeIterator.InsertChild(Index: Integer; const AValue: Single): Boolean; var NewNode: TJclSingleTreeNode; I: Integer; begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} // insert sibling or, if FCursor is root node, behave like TJclSingleTree.Insert Result := (FCursor <> nil) and (FOwnTree.AllowDefaultElements or not FEqualityComparer.ItemsEqual(AValue, 0.0)) and ((not FOwnTree.Contains(AValue)) or FOwnTree.CheckDuplicate); if Result then begin if FCursor.ChildrenCount = Length(FCursor.Children) then SetLength(FCursor.Children, FOwnTree.CalcGrowCapacity(Length(FCursor.Children), FCursor.ChildrenCount)); if FCursor.ChildrenCount < Length(FCursor.Children) then begin NewNode := TJclSingleTreeNode.Create; NewNode.Value := AValue; NewNode.Parent := FCursor; for I := FCursor.ChildrenCount - 1 downto Index do FCursor.Children[I + 1] := FCursor.Children[I]; FCursor.Children[Index] := NewNode; Inc(FCursor.ChildrenCount); Inc(FOwnTree.FSize); end; end; {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; function TJclSingleTreeIterator.IteratorEquals(const AIterator: IJclSingleIterator): Boolean; var Obj: TObject; ItrObj: TJclSingleTreeIterator; begin Result := False; if AIterator = nil then Exit; Obj := AIterator.GetIteratorReference; if Obj is TJclSingleTreeIterator then begin ItrObj := TJclSingleTreeIterator(Obj); Result := (FOwnTree = ItrObj.FOwnTree) and (FCursor = ItrObj.FCursor) and (Valid = ItrObj.Valid); end; end; {$IFDEF SUPPORTS_FOR_IN} function TJclSingleTreeIterator.MoveNext: Boolean; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} if Valid then FCursor := GetNextCursor else Valid := True; Result := FCursor <> nil; {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; {$ENDIF SUPPORTS_FOR_IN} function TJclSingleTreeIterator.Next: Single; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} if Valid then FCursor := GetNextCursor else Valid := True; Result := 0.0; if FCursor <> nil then Result := FCursor.Value else if not FOwnTree.ReturnDefaultElements then raise EJclNoSuchElementError.Create(''); {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; function TJclSingleTreeIterator.NextIndex: Integer; begin // No index raise EJclOperationNotSupportedError.Create; end; function TJclSingleTreeIterator.Parent: Single; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} Result := 0.0; if FCursor <> nil then FCursor := FCursor.Parent; if FCursor <> nil then Result := FCursor.Value else if not FOwnTree.ReturnDefaultElements then raise EJclNoSuchElementError.Create(''); {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; function TJclSingleTreeIterator.Previous: Single; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} if Valid then FCursor := GetPreviousCursor else Valid := True; Result := 0.0; if FCursor <> nil then Result := FCursor.Value else if not FOwnTree.ReturnDefaultElements then raise EJclNoSuchElementError.Create(''); {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; function TJclSingleTreeIterator.PreviousIndex: Integer; begin // No index raise EJclOperationNotSupportedError.Create; end; procedure TJclSingleTreeIterator.Remove; var OldCursor: TJclSingleTreeNode; begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} CheckValid; Valid := False; OldCursor := FCursor; FCursor := GetNextSibling; if OldCursor <> nil then FOwnTree.RemoveNode(OldCursor); {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; procedure TJclSingleTreeIterator.Reset; var NewCursor: TJclSingleTreeNode; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} Valid := False; case FStart of isFirst: begin NewCursor := FCursor; while NewCursor <> nil do begin NewCursor := GetPreviousCursor; if NewCursor <> nil then FCursor := NewCursor; end; end; isLast: begin NewCursor := FCursor; while NewCursor <> nil do begin NewCursor := GetNextCursor; if NewCursor <> nil then FCursor := NewCursor; end; end; isRoot: begin while (FCursor <> nil) and (FCursor.Parent <> nil) do FCursor := FCursor.Parent; end; end; {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; procedure TJclSingleTreeIterator.SetChild(Index: Integer; const AValue: Single); begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} if (FCursor <> nil) and (Index >= 0) and (Index < FCursor.ChildrenCount) then TJclSingleTreeNode(FCursor.Children[Index]).Value := AValue else raise EJclOutOfBoundsError.Create; {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; procedure TJclSingleTreeIterator.SetValue(const AValue: Single); begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} CheckValid; if FCursor <> nil then begin FOwnTree.FreeSingle(FCursor.Value); FCursor.Value := AValue; end; {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; //=== { TJclPreOrderSingleTreeIterator } =================================================== function TJclPreOrderSingleTreeIterator.CreateEmptyIterator: TJclAbstractIterator; begin Result := TJclPreOrderSingleTreeIterator.Create(FOwnTree, FCursor, Valid, FStart); end; function TJclPreOrderSingleTreeIterator.GetNextCursor: TJclSingleTreeNode; var LastRet: TJclSingleTreeNode; begin Result := FCursor; if Result = nil then Exit; LastRet := Result; if Result.ChildrenCount > 0 then Result := TJclSingleTreeNode(Result.Children[0]) else begin Result := Result.Parent; while (Result <> nil) and (Result.IndexOfChild(LastRet) = (Result.ChildrenCount - 1)) do begin LastRet := Result; Result := Result.Parent; end; if Result <> nil then // not root = return successor Result := TJclSingleTreeNode(Result.Children[Result.IndexOfChild(LastRet) + 1]); end; end; function TJclPreOrderSingleTreeIterator.GetNextSibling: TJclSingleTreeNode; var LastRet: TJclSingleTreeNode; begin Result := FCursor; if Result = nil then Exit; LastRet := Result; Result := Result.Parent; while (Result <> nil) and (Result.IndexOfChild(LastRet) = (Result.ChildrenCount - 1)) do begin LastRet := Result; Result := Result.Parent; end; if Result <> nil then // not root = return successor Result := TJclSingleTreeNode(Result.Children[Result.IndexOfChild(LastRet) + 1]); end; function TJclPreOrderSingleTreeIterator.GetPreviousCursor: TJclSingleTreeNode; var LastRet: TJclSingleTreeNode; begin Result := FCursor; if Result = nil then Exit; LastRet := Result; Result := Result.Parent; if (Result <> nil) and (Result.IndexOfChild(LastRet) > 0) then // come from Right begin Result := TJclSingleTreeNode(Result.Children[Result.IndexOfChild(LastRet) - 1]); while (Result.ChildrenCount > 0) do // descend down the tree Result := TJclSingleTreeNode(Result.Children[Result.ChildrenCount - 1]); end; end; //=== { TJclPostOrderSingleTreeIterator } ================================================== function TJclPostOrderSingleTreeIterator.CreateEmptyIterator: TJclAbstractIterator; begin Result := TJclPostOrderSingleTreeIterator.Create(FOwnTree, FCursor, Valid, FStart); end; function TJclPostOrderSingleTreeIterator.GetNextCursor: TJclSingleTreeNode; var LastRet: TJclSingleTreeNode; begin Result := FCursor; if Result = nil then Exit; LastRet := Result; Result := Result.Parent; if (Result <> nil) and (Result.IndexOfChild(LastRet) <> (Result.ChildrenCount - 1)) then begin Result := TJclSingleTreeNode(Result.Children[Result.IndexOfChild(LastRet) + 1]); while Result.ChildrenCount > 0 do Result := TJclSingleTreeNode(Result.Children[0]); end; end; function TJclPostOrderSingleTreeIterator.GetNextSibling: TJclSingleTreeNode; var LastRet: TJclSingleTreeNode; begin Result := FCursor; if Result = nil then Exit; LastRet := Result; Result := Result.Parent; if (Result <> nil) and (Result.IndexOfChild(LastRet) <> (Result.ChildrenCount - 1)) then begin Result := TJclSingleTreeNode(Result.Children[Result.IndexOfChild(LastRet) + 1]); while Result.ChildrenCount > 0 do Result := TJclSingleTreeNode(Result.Children[0]); end; end; function TJclPostOrderSingleTreeIterator.GetPreviousCursor: TJclSingleTreeNode; var LastRet: TJclSingleTreeNode; begin Result := FCursor; if Result = nil then Exit; if Result.ChildrenCount > 0 then Result := TJclSingleTreeNode(Result.Children[Result.ChildrenCount - 1]) else begin LastRet := Result; Result := Result.Parent; while (Result <> nil) and (Result.IndexOfChild(LastRet) = 0) do begin LastRet := Result; Result := Result.Parent; end; if Result <> nil then // not root Result := TJclSingleTreeNode(Result.Children[Result.IndexOfChild(LastRet) - 1]); end; end; //=== { TJclDoubleTreeNode } ======================================================= function TJclDoubleTreeNode.IndexOfChild(AChild: TJclDoubleTreeNode): Integer; begin for Result := 0 to ChildrenCount - 1 do if Children[Result] = AChild then Exit; Result := -1; end; function TJclDoubleTreeNode.IndexOfValue(const AValue: Double; const AEqualityComparer: IJclDoubleEqualityComparer): Integer; begin for Result := 0 to ChildrenCount - 1 do if AEqualityComparer.ItemsEqual(TJclDoubleTreeNode(Children[Result]).Value, AValue) then Exit; Result := -1; end; //=== { TJclDoubleTree } ======================================================= constructor TJclDoubleTree.Create(); begin inherited Create(); FTraverseOrder := toPreOrder; end; destructor TJclDoubleTree.Destroy; begin FReadOnly := False; Clear; inherited Destroy; end; function TJclDoubleTree.Add(const AValue: Double): Boolean; var NewNode: TJclDoubleTreeNode; begin if ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginWrite; try {$ENDIF THREADSAFE} Result := AllowDefaultElements or not ItemsEqual(AValue, 0.0); if Result then begin if FRoot <> nil then begin Result := (not Contains(AValue)) or CheckDuplicate; if Result then begin if FRoot.ChildrenCount = Length(FRoot.Children) then SetLength(FRoot.Children, CalcGrowCapacity(Length(FRoot.Children), FRoot.ChildrenCount)); if FRoot.ChildrenCount < Length(FRoot.Children) then begin NewNode := TJclDoubleTreeNode.Create; NewNode.Value := AValue; NewNode.Parent := FRoot; FRoot.Children[FRoot.ChildrenCount] := NewNode; Inc(FRoot.ChildrenCount); Inc(FSize); end else Result := False; end; end else begin FRoot := TJclDoubleTreeNode.Create; FRoot.Value := AValue; Inc(FSize); end; end; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndWrite; end; {$ENDIF THREADSAFE} end; function TJclDoubleTree.AddAll(const ACollection: IJclDoubleCollection): Boolean; var It: IJclDoubleIterator; begin if ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginWrite; try {$ENDIF THREADSAFE} Result := False; if ACollection = nil then Exit; Result := True; It := ACollection.First; while It.HasNext do Result := Add(It.Next) and Result; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndWrite; end; {$ENDIF THREADSAFE} end; procedure TJclDoubleTree.AssignDataTo(Dest: TJclAbstractContainerBase); var ADest: TJclDoubleTree; ACollection: IJclDoubleCollection; begin inherited AssignDataTo(Dest); if Dest is TJclDoubleTree then begin ADest := TJclDoubleTree(Dest); ADest.Clear; ADest.FSize := FSize; if FRoot <> nil then ADest.FRoot := CloneNode(FRoot, nil); end else if Supports(IInterface(Dest), IJclDoubleCollection, ACollection) then begin ACollection.Clear; ACollection.AddAll(Self); end; end; procedure TJclDoubleTree.AssignPropertiesTo(Dest: TJclAbstractContainerBase); begin inherited AssignPropertiesto(Dest); if Dest is TJclDoubleTree then TJclDoubleTree(Dest).FTraverseOrder := FTraverseOrder; end; procedure TJclDoubleTree.Clear; begin if ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginWrite; try {$ENDIF THREADSAFE} if FRoot <> nil then RemoveNode(FRoot); FSize := 0; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndWrite; end; {$ENDIF THREADSAFE} end; function TJclDoubleTree.CloneNode(Node, Parent: TJclDoubleTreeNode): TJclDoubleTreeNode; var Index: Integer; begin Result := TJclDoubleTreeNode.Create; Result.Value := Node.Value; Result.Parent := Parent; SetLength(Result.Children, Node.ChildrenCount); Result.ChildrenCount := Node.ChildrenCount; for Index := 0 to Node.ChildrenCount - 1 do Result.Children[Index] := CloneNode(TJclDoubleTreeNode(Node.Children[Index]), Result); // recursive call end; function TJclDoubleTree.CollectionEquals(const ACollection: IJclDoubleCollection): Boolean; var It, ItSelf: IJclDoubleIterator; begin {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginRead; try {$ENDIF THREADSAFE} Result := False; if ACollection = nil then Exit; if FSize <> ACollection.Size then Exit; Result := True; It := ACollection.First; ItSelf := First; while ItSelf.HasNext do if not ItemsEqual(ItSelf.Next, It.Next) then begin Result := False; Break; end; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndRead; end; {$ENDIF THREADSAFE} end; function TJclDoubleTree.Contains(const AValue: Double): Boolean; begin {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginRead; try {$ENDIF THREADSAFE} if FRoot <> nil then Result := NodeContains(FRoot, AValue) else Result := False; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndRead; end; {$ENDIF THREADSAFE} end; function TJclDoubleTree.ContainsAll(const ACollection: IJclDoubleCollection): Boolean; var It: IJclDoubleIterator; begin {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginRead; try {$ENDIF THREADSAFE} Result := True; if ACollection = nil then Exit; It := ACollection.First; while Result and It.HasNext do Result := Contains(It.Next); {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndRead; end; {$ENDIF THREADSAFE} end; function TJclDoubleTree.Extract(const AValue: Double): Boolean; var It: IJclDoubleIterator; begin if ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginWrite; try {$ENDIF THREADSAFE} Result := FRoot <> nil; if Result then begin It := First; while It.HasNext do if ItemsEqual(It.Next, AValue) then begin It.Extract; if RemoveSingleElement then Break; end; end; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndWrite; end; {$ENDIF THREADSAFE} end; function TJclDoubleTree.ExtractAll(const ACollection: IJclDoubleCollection): Boolean; var It: IJclDoubleIterator; begin if ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginWrite; try {$ENDIF THREADSAFE} Result := False; if ACollection = nil then Exit; Result := True; It := ACollection.First; while It.HasNext do Result := Extract(It.Next) and Result; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndWrite; end; {$ENDIF THREADSAFE} end; procedure TJclDoubleTree.ExtractNode(var ANode: TJclDoubleTreeNode); var Index, ChildIndex, NewCapacity: Integer; Parent: TJclDoubleTreeNode; begin for Index := ANode.ChildrenCount - 1 downto 0 do {$IFDEF BCB} ExtractNode(TJclDoubleTreeNode(ANode.Children[Index])); {$ELSE ~BCB} ExtractNode(ANode.Children[Index]); {$ENDIF ~BCB} Parent := ANode.Parent; if Parent <> nil then begin ChildIndex := Parent.IndexOfChild(ANode); for Index := ChildIndex + 1 to Parent.ChildrenCount - 1 do Parent.Children[Index - 1] := Parent.Children[Index]; Dec(Parent.ChildrenCount); NewCapacity := CalcPackCapacity(Length(Parent.Children), Parent.ChildrenCount); if NewCapacity < Length(Parent.Children) then SetLength(Parent.Children, NewCapacity); FreeAndNil(ANode); end else begin FreeAndNil(ANode); FRoot := nil; end; Dec(FSize); end; function TJclDoubleTree.First: IJclDoubleIterator; var Start: TJclDoubleTreeNode; begin {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginRead; try {$ENDIF THREADSAFE} Start := FRoot; case GetTraverseOrder of toPreOrder: Result := TJclPreOrderDoubleTreeIterator.Create(Self, Start, False, isFirst); toPostOrder: begin if Start <> nil then while (Start.ChildrenCount > 0) do Start := TJclDoubleTreeNode(Start.Children[0]); Result := TJclPostOrderDoubleTreeIterator.Create(Self, Start, False, isFirst); end; else Result := nil; end; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndRead; end; {$ENDIF THREADSAFE} end; {$IFDEF SUPPORTS_FOR_IN} function TJclDoubleTree.GetEnumerator: IJclDoubleIterator; begin Result := First; end; {$ENDIF SUPPORTS_FOR_IN} function TJclDoubleTree.GetRoot: IJclDoubleTreeIterator; begin {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginRead; try {$ENDIF THREADSAFE} case GetTraverseOrder of toPreOrder: Result := TJclPreOrderDoubleTreeIterator.Create(Self, FRoot, False, isRoot); toPostOrder: Result := TJclPostOrderDoubleTreeIterator.Create(Self, FRoot, False, isRoot); else Result := nil; end; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndRead; end; {$ENDIF THREADSAFE} end; function TJclDoubleTree.GetTraverseOrder: TJclTraverseOrder; begin Result := FTraverseOrder; end; function TJclDoubleTree.IsEmpty: Boolean; begin Result := FSize = 0; end; function TJclDoubleTree.Last: IJclDoubleIterator; var Start: TJclDoubleTreeNode; begin {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginRead; try {$ENDIF THREADSAFE} Start := FRoot; case FTraverseOrder of toPreOrder: begin if Start <> nil then while Start.ChildrenCount > 0 do Start := TJclDoubleTreeNode(Start.Children[Start.ChildrenCount - 1]); Result := TJclPreOrderDoubleTreeIterator.Create(Self, Start, False, isLast); end; toPostOrder: Result := TJclPostOrderDoubleTreeIterator.Create(Self, Start, False, isLast); else Result := nil; end; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndRead; end; {$ENDIF THREADSAFE} end; function TJclDoubleTree.NodeContains(ANode: TJclDoubleTreeNode; const AValue: Double): Boolean; var Index: Integer; begin Result := ItemsEqual(ANode.Value, AValue); if not Result then for Index := 0 to ANode.ChildrenCount - 1 do begin Result := NodeContains(TJclDoubleTreeNode(ANode.Children[Index]), AValue); if Result then Break; end; end; procedure TJclDoubleTree.Pack; begin if ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginWrite; try {$ENDIF THREADSAFE} if FRoot <> nil then PackNode(FRoot); {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndWrite; end; {$ENDIF THREADSAFE} end; procedure TJclDoubleTree.PackNode(ANode: TJclDoubleTreeNode); var Index: Integer; begin SetLength(ANode.Children, ANode.ChildrenCount); for Index := 0 to ANode.ChildrenCount - 1 do PackNode(TJclDoubleTreeNode(ANode.Children[Index])); end; function TJclDoubleTree.Remove(const AValue: Double): Boolean; var Extracted: Double; begin if ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginWrite; try {$ENDIF THREADSAFE} Result := Extract(AValue); if Result then begin Extracted := AValue; FreeDouble(Extracted); end; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndWrite; end; {$ENDIF THREADSAFE} end; function TJclDoubleTree.RemoveAll(const ACollection: IJclDoubleCollection): Boolean; var It: IJclDoubleIterator; begin if ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginWrite; try {$ENDIF THREADSAFE} Result := False; if ACollection = nil then Exit; Result := True; It := ACollection.First; while It.HasNext do Result := Remove(It.Next) and Result; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndWrite; end; {$ENDIF THREADSAFE} end; procedure TJclDoubleTree.RemoveNode(var ANode: TJclDoubleTreeNode); var Index, ChildIndex, NewCapacity: Integer; Parent: TJclDoubleTreeNode; begin for Index := ANode.ChildrenCount - 1 downto 0 do {$IFDEF BCB} RemoveNode(TJclDoubleTreeNode(ANode.Children[Index])); {$ELSE ~BCB} RemoveNode(ANode.Children[Index]); {$ENDIF ~BCB} FreeDouble(ANode.Value); Parent := ANode.Parent; if Parent <> nil then begin ChildIndex := Parent.IndexOfChild(ANode); for Index := ChildIndex + 1 to Parent.ChildrenCount - 1 do Parent.Children[Index - 1] := Parent.Children[Index]; Dec(Parent.ChildrenCount); NewCapacity := CalcPackCapacity(Length(Parent.Children), Parent.ChildrenCount); if NewCapacity < Length(Parent.Children) then SetLength(Parent.Children, NewCapacity); FreeAndNil(ANode); end else begin FreeAndNil(ANode); FRoot := nil; end; Dec(FSize); end; function TJclDoubleTree.RetainAll(const ACollection: IJclDoubleCollection): Boolean; var It: IJclDoubleIterator; begin if ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginWrite; try {$ENDIF THREADSAFE} Result := False; if ACollection = nil then Exit; Result := True; It := First; while It.HasNext do if not ACollection.Contains(It.Next) then It.Remove; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndWrite; end; {$ENDIF THREADSAFE} end; procedure TJclDoubleTree.SetCapacity(Value: Integer); begin raise EJclOperationNotSupportedError.Create; end; procedure TJclDoubleTree.SetTraverseOrder(Value: TJclTraverseOrder); begin FTraverseOrder := Value; end; function TJclDoubleTree.Size: Integer; begin Result := FSize; end; function TJclDoubleTree.CreateEmptyContainer: TJclAbstractContainerBase; begin Result := TJclDoubleTree.Create; AssignPropertiesTo(Result); end; //=== { TJclDoubleTreeIterator } =========================================================== constructor TJclDoubleTreeIterator.Create(OwnTree: TJclDoubleTree; ACursor: TJclDoubleTreeNode; AValid: Boolean; AStart: TItrStart); begin inherited Create(AValid); FCursor := ACursor; FOwnTree := OwnTree; FStart := AStart; FEqualityComparer := OwnTree as IJclDoubleEqualityComparer; end; function TJclDoubleTreeIterator.Add(const AValue: Double): Boolean; var ParentNode, NewNode: TJclDoubleTreeNode; begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} // add sibling or, if FCursor is root node, behave like TJclDoubleTree.Add Result := (FCursor <> nil) and (FOwnTree.AllowDefaultElements or not FEqualityComparer.ItemsEqual(AValue, 0.0)) and ((not FOwnTree.Contains(AValue)) or FOwnTree.CheckDuplicate); if Result then begin ParentNode := FCursor.Parent; if ParentNode = nil then ParentNode := FCursor; if ParentNode.ChildrenCount = Length(ParentNode.Children) then SetLength(ParentNode.Children, FOwnTree.CalcGrowCapacity(Length(ParentNode.Children), ParentNode.ChildrenCount)); if ParentNode.ChildrenCount < Length(ParentNode.Children) then begin NewNode := TJclDoubleTreeNode.Create; NewNode.Value := AValue; NewNode.Parent := ParentNode; ParentNode.Children[ParentNode.ChildrenCount] := NewNode; Inc(ParentNode.ChildrenCount); Inc(FOwnTree.FSize); end; end; {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; function TJclDoubleTreeIterator.AddChild(const AValue: Double): Boolean; var NewNode: TJclDoubleTreeNode; begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} Result := (FCursor <> nil) and (FOwnTree.AllowDefaultElements or not FEqualityComparer.ItemsEqual(AValue, 0.0)) and ((not FOwnTree.Contains(AValue)) or FOwnTree.CheckDuplicate); if Result then begin if FCursor.ChildrenCount = Length(FCursor.Children) then SetLength(FCursor.Children, FOwnTree.CalcGrowCapacity(Length(FCursor.Children), FCursor.ChildrenCount)); if FCursor.ChildrenCount < Length(FCursor.Children) then begin NewNode := TJclDoubleTreeNode.Create; NewNode.Value := AValue; NewNode.Parent := FCursor; FCursor.Children[FCursor.ChildrenCount] := NewNode; Inc(FCursor.ChildrenCount); Inc(FOwnTree.FSize); end; end; {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; procedure TJclDoubleTreeIterator.AssignPropertiesTo(Dest: TJclAbstractIterator); var ADest: TJclDoubleTreeIterator; begin inherited AssignPropertiesTo(Dest); if Dest is TJclDoubleTreeIterator then begin ADest := TJclDoubleTreeIterator(Dest); ADest.FCursor := FCursor; ADest.FOwnTree := FOwnTree; ADest.FEqualityComparer := FEqualityComparer; ADest.FStart := FStart; end; end; function TJclDoubleTreeIterator.ChildrenCount: Integer; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} if FCursor <> nil then Result := FCursor.ChildrenCount else Result := 0; {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; procedure TJclDoubleTreeIterator.DeleteChild(Index: Integer); begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} if (FCursor <> nil) and (Index >= 0) and (Index < FCursor.ChildrenCount) then {$IFDEF BCB} FOwnTree.RemoveNode(TJclDoubleTreeNode(FCursor.Children[Index])) {$ELSE ~BCB} FOwnTree.RemoveNode(FCursor.Children[Index]) {$ENDIF ~BCB} else raise EJclOutOfBoundsError.Create; {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; procedure TJclDoubleTreeIterator.DeleteChildren; var Index: Integer; begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} if FCursor <> nil then begin for Index := FCursor.ChildrenCount - 1 downto 0 do {$IFDEF BCB} FOwnTree.RemoveNode(TJclDoubleTreeNode(FCursor.Children[Index])); {$ELSE ~BCB} FOwnTree.RemoveNode(FCursor.Children[Index]); {$ENDIF ~BCB} SetLength(FCursor.Children, 0); FCursor.ChildrenCount := 0; end; {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; procedure TJclDoubleTreeIterator.Extract; var OldCursor: TJclDoubleTreeNode; begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} CheckValid; Valid := False; OldCursor := FCursor; FCursor := GetNextSibling; if OldCursor <> nil then FOwnTree.ExtractNode(OldCursor); {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; procedure TJclDoubleTreeIterator.ExtractChild(Index: Integer); begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} if (FCursor <> nil) and (Index >= 0) and (Index < FCursor.ChildrenCount) then {$IFDEF BCB} FOwnTree.ExtractNode(TJclDoubleTreeNode(FCursor.Children[Index])) {$ELSE ~BCB} FOwnTree.ExtractNode(FCursor.Children[Index]) {$ENDIF ~BCB} else raise EJclOutOfBoundsError.Create; {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; procedure TJclDoubleTreeIterator.ExtractChildren; var Index: Integer; begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} if FCursor <> nil then begin for Index := FCursor.ChildrenCount - 1 downto 0 do {$IFDEF BCB} FOwnTree.ExtractNode(TJclDoubleTreeNode(FCursor.Children[Index])); {$ELSE ~BCB} FOwnTree.ExtractNode(FCursor.Children[Index]); {$ENDIF ~BCB} SetLength(FCursor.Children, 0); FCursor.ChildrenCount := 0; end; {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; function TJclDoubleTreeIterator.GetChild(Index: Integer): Double; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} Result := 0.0; if (FCursor <> nil) and (Index >= 0) and (Index < FCursor.ChildrenCount) then FCursor := TJclDoubleTreeNode(FCursor.Children[Index]); if FCursor <> nil then Result := FCursor.Value else if not FOwnTree.ReturnDefaultElements then raise EJclNoSuchElementError.Create(''); {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; function TJclDoubleTreeIterator.GetValue: Double; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} CheckValid; Result := 0.0; if FCursor <> nil then Result := FCursor.Value else if not FOwnTree.ReturnDefaultElements then raise EJclNoSuchElementError.Create(''); {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; function TJclDoubleTreeIterator.HasChild(Index: Integer): Boolean; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} Result := (FCursor <> nil) and (Index >= 0) and (Index < FCursor.ChildrenCount); {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; function TJclDoubleTreeIterator.HasNext: Boolean; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} if Valid then Result := GetNextCursor <> nil else Result := FCursor <> nil; {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; function TJclDoubleTreeIterator.HasParent: Boolean; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} Result := (FCursor <> nil) and (FCursor.Parent <> nil); {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; function TJclDoubleTreeIterator.HasPrevious: Boolean; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} if Valid then Result := GetPreviousCursor <> nil else Result := FCursor <> nil; {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; function TJclDoubleTreeIterator.IndexOfChild(const AValue: Double): Integer; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} if FCursor <> nil then Result := FCursor.IndexOfValue(AValue, FEqualityComparer) else Result := -1; {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; function TJclDoubleTreeIterator.Insert(const AValue: Double): Boolean; var ParentNode, NewNode: TJclDoubleTreeNode; Index, I: Integer; begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} // insert sibling or, if FCursor is root node, behave like TJclDoubleTree.Insert Result := (FCursor <> nil) and (FOwnTree.AllowDefaultElements or not FEqualityComparer.ItemsEqual(AValue, 0.0)) and ((not FOwnTree.Contains(AValue)) or FOwnTree.CheckDuplicate); if Result then begin if FCursor.Parent <> nil then begin ParentNode := FCursor.Parent; Index := 0; while (Index < ParentNode.ChildrenCount) and (ParentNode.Children[Index] <> FCursor) do Inc(Index); end else begin ParentNode := FCursor; Index := 0; end; if ParentNode.ChildrenCount = Length(ParentNode.Children) then SetLength(ParentNode.Children, FOwnTree.CalcGrowCapacity(Length(ParentNode.Children), ParentNode.ChildrenCount)); if ParentNode.ChildrenCount < Length(ParentNode.Children) then begin NewNode := TJclDoubleTreeNode.Create; NewNode.Value := AValue; NewNode.Parent := ParentNode; for I := ParentNode.ChildrenCount - 1 downto Index do ParentNode.Children[I + 1] := ParentNode.Children[I]; ParentNode.Children[Index] := NewNode; Inc(ParentNode.ChildrenCount); Inc(FOwnTree.FSize); end; end; {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; function TJclDoubleTreeIterator.InsertChild(Index: Integer; const AValue: Double): Boolean; var NewNode: TJclDoubleTreeNode; I: Integer; begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} // insert sibling or, if FCursor is root node, behave like TJclDoubleTree.Insert Result := (FCursor <> nil) and (FOwnTree.AllowDefaultElements or not FEqualityComparer.ItemsEqual(AValue, 0.0)) and ((not FOwnTree.Contains(AValue)) or FOwnTree.CheckDuplicate); if Result then begin if FCursor.ChildrenCount = Length(FCursor.Children) then SetLength(FCursor.Children, FOwnTree.CalcGrowCapacity(Length(FCursor.Children), FCursor.ChildrenCount)); if FCursor.ChildrenCount < Length(FCursor.Children) then begin NewNode := TJclDoubleTreeNode.Create; NewNode.Value := AValue; NewNode.Parent := FCursor; for I := FCursor.ChildrenCount - 1 downto Index do FCursor.Children[I + 1] := FCursor.Children[I]; FCursor.Children[Index] := NewNode; Inc(FCursor.ChildrenCount); Inc(FOwnTree.FSize); end; end; {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; function TJclDoubleTreeIterator.IteratorEquals(const AIterator: IJclDoubleIterator): Boolean; var Obj: TObject; ItrObj: TJclDoubleTreeIterator; begin Result := False; if AIterator = nil then Exit; Obj := AIterator.GetIteratorReference; if Obj is TJclDoubleTreeIterator then begin ItrObj := TJclDoubleTreeIterator(Obj); Result := (FOwnTree = ItrObj.FOwnTree) and (FCursor = ItrObj.FCursor) and (Valid = ItrObj.Valid); end; end; {$IFDEF SUPPORTS_FOR_IN} function TJclDoubleTreeIterator.MoveNext: Boolean; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} if Valid then FCursor := GetNextCursor else Valid := True; Result := FCursor <> nil; {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; {$ENDIF SUPPORTS_FOR_IN} function TJclDoubleTreeIterator.Next: Double; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} if Valid then FCursor := GetNextCursor else Valid := True; Result := 0.0; if FCursor <> nil then Result := FCursor.Value else if not FOwnTree.ReturnDefaultElements then raise EJclNoSuchElementError.Create(''); {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; function TJclDoubleTreeIterator.NextIndex: Integer; begin // No index raise EJclOperationNotSupportedError.Create; end; function TJclDoubleTreeIterator.Parent: Double; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} Result := 0.0; if FCursor <> nil then FCursor := FCursor.Parent; if FCursor <> nil then Result := FCursor.Value else if not FOwnTree.ReturnDefaultElements then raise EJclNoSuchElementError.Create(''); {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; function TJclDoubleTreeIterator.Previous: Double; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} if Valid then FCursor := GetPreviousCursor else Valid := True; Result := 0.0; if FCursor <> nil then Result := FCursor.Value else if not FOwnTree.ReturnDefaultElements then raise EJclNoSuchElementError.Create(''); {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; function TJclDoubleTreeIterator.PreviousIndex: Integer; begin // No index raise EJclOperationNotSupportedError.Create; end; procedure TJclDoubleTreeIterator.Remove; var OldCursor: TJclDoubleTreeNode; begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} CheckValid; Valid := False; OldCursor := FCursor; FCursor := GetNextSibling; if OldCursor <> nil then FOwnTree.RemoveNode(OldCursor); {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; procedure TJclDoubleTreeIterator.Reset; var NewCursor: TJclDoubleTreeNode; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} Valid := False; case FStart of isFirst: begin NewCursor := FCursor; while NewCursor <> nil do begin NewCursor := GetPreviousCursor; if NewCursor <> nil then FCursor := NewCursor; end; end; isLast: begin NewCursor := FCursor; while NewCursor <> nil do begin NewCursor := GetNextCursor; if NewCursor <> nil then FCursor := NewCursor; end; end; isRoot: begin while (FCursor <> nil) and (FCursor.Parent <> nil) do FCursor := FCursor.Parent; end; end; {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; procedure TJclDoubleTreeIterator.SetChild(Index: Integer; const AValue: Double); begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} if (FCursor <> nil) and (Index >= 0) and (Index < FCursor.ChildrenCount) then TJclDoubleTreeNode(FCursor.Children[Index]).Value := AValue else raise EJclOutOfBoundsError.Create; {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; procedure TJclDoubleTreeIterator.SetValue(const AValue: Double); begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} CheckValid; if FCursor <> nil then begin FOwnTree.FreeDouble(FCursor.Value); FCursor.Value := AValue; end; {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; //=== { TJclPreOrderDoubleTreeIterator } =================================================== function TJclPreOrderDoubleTreeIterator.CreateEmptyIterator: TJclAbstractIterator; begin Result := TJclPreOrderDoubleTreeIterator.Create(FOwnTree, FCursor, Valid, FStart); end; function TJclPreOrderDoubleTreeIterator.GetNextCursor: TJclDoubleTreeNode; var LastRet: TJclDoubleTreeNode; begin Result := FCursor; if Result = nil then Exit; LastRet := Result; if Result.ChildrenCount > 0 then Result := TJclDoubleTreeNode(Result.Children[0]) else begin Result := Result.Parent; while (Result <> nil) and (Result.IndexOfChild(LastRet) = (Result.ChildrenCount - 1)) do begin LastRet := Result; Result := Result.Parent; end; if Result <> nil then // not root = return successor Result := TJclDoubleTreeNode(Result.Children[Result.IndexOfChild(LastRet) + 1]); end; end; function TJclPreOrderDoubleTreeIterator.GetNextSibling: TJclDoubleTreeNode; var LastRet: TJclDoubleTreeNode; begin Result := FCursor; if Result = nil then Exit; LastRet := Result; Result := Result.Parent; while (Result <> nil) and (Result.IndexOfChild(LastRet) = (Result.ChildrenCount - 1)) do begin LastRet := Result; Result := Result.Parent; end; if Result <> nil then // not root = return successor Result := TJclDoubleTreeNode(Result.Children[Result.IndexOfChild(LastRet) + 1]); end; function TJclPreOrderDoubleTreeIterator.GetPreviousCursor: TJclDoubleTreeNode; var LastRet: TJclDoubleTreeNode; begin Result := FCursor; if Result = nil then Exit; LastRet := Result; Result := Result.Parent; if (Result <> nil) and (Result.IndexOfChild(LastRet) > 0) then // come from Right begin Result := TJclDoubleTreeNode(Result.Children[Result.IndexOfChild(LastRet) - 1]); while (Result.ChildrenCount > 0) do // descend down the tree Result := TJclDoubleTreeNode(Result.Children[Result.ChildrenCount - 1]); end; end; //=== { TJclPostOrderDoubleTreeIterator } ================================================== function TJclPostOrderDoubleTreeIterator.CreateEmptyIterator: TJclAbstractIterator; begin Result := TJclPostOrderDoubleTreeIterator.Create(FOwnTree, FCursor, Valid, FStart); end; function TJclPostOrderDoubleTreeIterator.GetNextCursor: TJclDoubleTreeNode; var LastRet: TJclDoubleTreeNode; begin Result := FCursor; if Result = nil then Exit; LastRet := Result; Result := Result.Parent; if (Result <> nil) and (Result.IndexOfChild(LastRet) <> (Result.ChildrenCount - 1)) then begin Result := TJclDoubleTreeNode(Result.Children[Result.IndexOfChild(LastRet) + 1]); while Result.ChildrenCount > 0 do Result := TJclDoubleTreeNode(Result.Children[0]); end; end; function TJclPostOrderDoubleTreeIterator.GetNextSibling: TJclDoubleTreeNode; var LastRet: TJclDoubleTreeNode; begin Result := FCursor; if Result = nil then Exit; LastRet := Result; Result := Result.Parent; if (Result <> nil) and (Result.IndexOfChild(LastRet) <> (Result.ChildrenCount - 1)) then begin Result := TJclDoubleTreeNode(Result.Children[Result.IndexOfChild(LastRet) + 1]); while Result.ChildrenCount > 0 do Result := TJclDoubleTreeNode(Result.Children[0]); end; end; function TJclPostOrderDoubleTreeIterator.GetPreviousCursor: TJclDoubleTreeNode; var LastRet: TJclDoubleTreeNode; begin Result := FCursor; if Result = nil then Exit; if Result.ChildrenCount > 0 then Result := TJclDoubleTreeNode(Result.Children[Result.ChildrenCount - 1]) else begin LastRet := Result; Result := Result.Parent; while (Result <> nil) and (Result.IndexOfChild(LastRet) = 0) do begin LastRet := Result; Result := Result.Parent; end; if Result <> nil then // not root Result := TJclDoubleTreeNode(Result.Children[Result.IndexOfChild(LastRet) - 1]); end; end; //=== { TJclExtendedTreeNode } ======================================================= function TJclExtendedTreeNode.IndexOfChild(AChild: TJclExtendedTreeNode): Integer; begin for Result := 0 to ChildrenCount - 1 do if Children[Result] = AChild then Exit; Result := -1; end; function TJclExtendedTreeNode.IndexOfValue(const AValue: Extended; const AEqualityComparer: IJclExtendedEqualityComparer): Integer; begin for Result := 0 to ChildrenCount - 1 do if AEqualityComparer.ItemsEqual(TJclExtendedTreeNode(Children[Result]).Value, AValue) then Exit; Result := -1; end; //=== { TJclExtendedTree } ======================================================= constructor TJclExtendedTree.Create(); begin inherited Create(); FTraverseOrder := toPreOrder; end; destructor TJclExtendedTree.Destroy; begin FReadOnly := False; Clear; inherited Destroy; end; function TJclExtendedTree.Add(const AValue: Extended): Boolean; var NewNode: TJclExtendedTreeNode; begin if ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginWrite; try {$ENDIF THREADSAFE} Result := AllowDefaultElements or not ItemsEqual(AValue, 0.0); if Result then begin if FRoot <> nil then begin Result := (not Contains(AValue)) or CheckDuplicate; if Result then begin if FRoot.ChildrenCount = Length(FRoot.Children) then SetLength(FRoot.Children, CalcGrowCapacity(Length(FRoot.Children), FRoot.ChildrenCount)); if FRoot.ChildrenCount < Length(FRoot.Children) then begin NewNode := TJclExtendedTreeNode.Create; NewNode.Value := AValue; NewNode.Parent := FRoot; FRoot.Children[FRoot.ChildrenCount] := NewNode; Inc(FRoot.ChildrenCount); Inc(FSize); end else Result := False; end; end else begin FRoot := TJclExtendedTreeNode.Create; FRoot.Value := AValue; Inc(FSize); end; end; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndWrite; end; {$ENDIF THREADSAFE} end; function TJclExtendedTree.AddAll(const ACollection: IJclExtendedCollection): Boolean; var It: IJclExtendedIterator; begin if ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginWrite; try {$ENDIF THREADSAFE} Result := False; if ACollection = nil then Exit; Result := True; It := ACollection.First; while It.HasNext do Result := Add(It.Next) and Result; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndWrite; end; {$ENDIF THREADSAFE} end; procedure TJclExtendedTree.AssignDataTo(Dest: TJclAbstractContainerBase); var ADest: TJclExtendedTree; ACollection: IJclExtendedCollection; begin inherited AssignDataTo(Dest); if Dest is TJclExtendedTree then begin ADest := TJclExtendedTree(Dest); ADest.Clear; ADest.FSize := FSize; if FRoot <> nil then ADest.FRoot := CloneNode(FRoot, nil); end else if Supports(IInterface(Dest), IJclExtendedCollection, ACollection) then begin ACollection.Clear; ACollection.AddAll(Self); end; end; procedure TJclExtendedTree.AssignPropertiesTo(Dest: TJclAbstractContainerBase); begin inherited AssignPropertiesto(Dest); if Dest is TJclExtendedTree then TJclExtendedTree(Dest).FTraverseOrder := FTraverseOrder; end; procedure TJclExtendedTree.Clear; begin if ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginWrite; try {$ENDIF THREADSAFE} if FRoot <> nil then RemoveNode(FRoot); FSize := 0; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndWrite; end; {$ENDIF THREADSAFE} end; function TJclExtendedTree.CloneNode(Node, Parent: TJclExtendedTreeNode): TJclExtendedTreeNode; var Index: Integer; begin Result := TJclExtendedTreeNode.Create; Result.Value := Node.Value; Result.Parent := Parent; SetLength(Result.Children, Node.ChildrenCount); Result.ChildrenCount := Node.ChildrenCount; for Index := 0 to Node.ChildrenCount - 1 do Result.Children[Index] := CloneNode(TJclExtendedTreeNode(Node.Children[Index]), Result); // recursive call end; function TJclExtendedTree.CollectionEquals(const ACollection: IJclExtendedCollection): Boolean; var It, ItSelf: IJclExtendedIterator; begin {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginRead; try {$ENDIF THREADSAFE} Result := False; if ACollection = nil then Exit; if FSize <> ACollection.Size then Exit; Result := True; It := ACollection.First; ItSelf := First; while ItSelf.HasNext do if not ItemsEqual(ItSelf.Next, It.Next) then begin Result := False; Break; end; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndRead; end; {$ENDIF THREADSAFE} end; function TJclExtendedTree.Contains(const AValue: Extended): Boolean; begin {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginRead; try {$ENDIF THREADSAFE} if FRoot <> nil then Result := NodeContains(FRoot, AValue) else Result := False; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndRead; end; {$ENDIF THREADSAFE} end; function TJclExtendedTree.ContainsAll(const ACollection: IJclExtendedCollection): Boolean; var It: IJclExtendedIterator; begin {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginRead; try {$ENDIF THREADSAFE} Result := True; if ACollection = nil then Exit; It := ACollection.First; while Result and It.HasNext do Result := Contains(It.Next); {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndRead; end; {$ENDIF THREADSAFE} end; function TJclExtendedTree.Extract(const AValue: Extended): Boolean; var It: IJclExtendedIterator; begin if ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginWrite; try {$ENDIF THREADSAFE} Result := FRoot <> nil; if Result then begin It := First; while It.HasNext do if ItemsEqual(It.Next, AValue) then begin It.Extract; if RemoveSingleElement then Break; end; end; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndWrite; end; {$ENDIF THREADSAFE} end; function TJclExtendedTree.ExtractAll(const ACollection: IJclExtendedCollection): Boolean; var It: IJclExtendedIterator; begin if ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginWrite; try {$ENDIF THREADSAFE} Result := False; if ACollection = nil then Exit; Result := True; It := ACollection.First; while It.HasNext do Result := Extract(It.Next) and Result; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndWrite; end; {$ENDIF THREADSAFE} end; procedure TJclExtendedTree.ExtractNode(var ANode: TJclExtendedTreeNode); var Index, ChildIndex, NewCapacity: Integer; Parent: TJclExtendedTreeNode; begin for Index := ANode.ChildrenCount - 1 downto 0 do {$IFDEF BCB} ExtractNode(TJclExtendedTreeNode(ANode.Children[Index])); {$ELSE ~BCB} ExtractNode(ANode.Children[Index]); {$ENDIF ~BCB} Parent := ANode.Parent; if Parent <> nil then begin ChildIndex := Parent.IndexOfChild(ANode); for Index := ChildIndex + 1 to Parent.ChildrenCount - 1 do Parent.Children[Index - 1] := Parent.Children[Index]; Dec(Parent.ChildrenCount); NewCapacity := CalcPackCapacity(Length(Parent.Children), Parent.ChildrenCount); if NewCapacity < Length(Parent.Children) then SetLength(Parent.Children, NewCapacity); FreeAndNil(ANode); end else begin FreeAndNil(ANode); FRoot := nil; end; Dec(FSize); end; function TJclExtendedTree.First: IJclExtendedIterator; var Start: TJclExtendedTreeNode; begin {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginRead; try {$ENDIF THREADSAFE} Start := FRoot; case GetTraverseOrder of toPreOrder: Result := TJclPreOrderExtendedTreeIterator.Create(Self, Start, False, isFirst); toPostOrder: begin if Start <> nil then while (Start.ChildrenCount > 0) do Start := TJclExtendedTreeNode(Start.Children[0]); Result := TJclPostOrderExtendedTreeIterator.Create(Self, Start, False, isFirst); end; else Result := nil; end; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndRead; end; {$ENDIF THREADSAFE} end; {$IFDEF SUPPORTS_FOR_IN} function TJclExtendedTree.GetEnumerator: IJclExtendedIterator; begin Result := First; end; {$ENDIF SUPPORTS_FOR_IN} function TJclExtendedTree.GetRoot: IJclExtendedTreeIterator; begin {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginRead; try {$ENDIF THREADSAFE} case GetTraverseOrder of toPreOrder: Result := TJclPreOrderExtendedTreeIterator.Create(Self, FRoot, False, isRoot); toPostOrder: Result := TJclPostOrderExtendedTreeIterator.Create(Self, FRoot, False, isRoot); else Result := nil; end; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndRead; end; {$ENDIF THREADSAFE} end; function TJclExtendedTree.GetTraverseOrder: TJclTraverseOrder; begin Result := FTraverseOrder; end; function TJclExtendedTree.IsEmpty: Boolean; begin Result := FSize = 0; end; function TJclExtendedTree.Last: IJclExtendedIterator; var Start: TJclExtendedTreeNode; begin {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginRead; try {$ENDIF THREADSAFE} Start := FRoot; case FTraverseOrder of toPreOrder: begin if Start <> nil then while Start.ChildrenCount > 0 do Start := TJclExtendedTreeNode(Start.Children[Start.ChildrenCount - 1]); Result := TJclPreOrderExtendedTreeIterator.Create(Self, Start, False, isLast); end; toPostOrder: Result := TJclPostOrderExtendedTreeIterator.Create(Self, Start, False, isLast); else Result := nil; end; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndRead; end; {$ENDIF THREADSAFE} end; function TJclExtendedTree.NodeContains(ANode: TJclExtendedTreeNode; const AValue: Extended): Boolean; var Index: Integer; begin Result := ItemsEqual(ANode.Value, AValue); if not Result then for Index := 0 to ANode.ChildrenCount - 1 do begin Result := NodeContains(TJclExtendedTreeNode(ANode.Children[Index]), AValue); if Result then Break; end; end; procedure TJclExtendedTree.Pack; begin if ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginWrite; try {$ENDIF THREADSAFE} if FRoot <> nil then PackNode(FRoot); {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndWrite; end; {$ENDIF THREADSAFE} end; procedure TJclExtendedTree.PackNode(ANode: TJclExtendedTreeNode); var Index: Integer; begin SetLength(ANode.Children, ANode.ChildrenCount); for Index := 0 to ANode.ChildrenCount - 1 do PackNode(TJclExtendedTreeNode(ANode.Children[Index])); end; function TJclExtendedTree.Remove(const AValue: Extended): Boolean; var Extracted: Extended; begin if ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginWrite; try {$ENDIF THREADSAFE} Result := Extract(AValue); if Result then begin Extracted := AValue; FreeExtended(Extracted); end; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndWrite; end; {$ENDIF THREADSAFE} end; function TJclExtendedTree.RemoveAll(const ACollection: IJclExtendedCollection): Boolean; var It: IJclExtendedIterator; begin if ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginWrite; try {$ENDIF THREADSAFE} Result := False; if ACollection = nil then Exit; Result := True; It := ACollection.First; while It.HasNext do Result := Remove(It.Next) and Result; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndWrite; end; {$ENDIF THREADSAFE} end; procedure TJclExtendedTree.RemoveNode(var ANode: TJclExtendedTreeNode); var Index, ChildIndex, NewCapacity: Integer; Parent: TJclExtendedTreeNode; begin for Index := ANode.ChildrenCount - 1 downto 0 do {$IFDEF BCB} RemoveNode(TJclExtendedTreeNode(ANode.Children[Index])); {$ELSE ~BCB} RemoveNode(ANode.Children[Index]); {$ENDIF ~BCB} FreeExtended(ANode.Value); Parent := ANode.Parent; if Parent <> nil then begin ChildIndex := Parent.IndexOfChild(ANode); for Index := ChildIndex + 1 to Parent.ChildrenCount - 1 do Parent.Children[Index - 1] := Parent.Children[Index]; Dec(Parent.ChildrenCount); NewCapacity := CalcPackCapacity(Length(Parent.Children), Parent.ChildrenCount); if NewCapacity < Length(Parent.Children) then SetLength(Parent.Children, NewCapacity); FreeAndNil(ANode); end else begin FreeAndNil(ANode); FRoot := nil; end; Dec(FSize); end; function TJclExtendedTree.RetainAll(const ACollection: IJclExtendedCollection): Boolean; var It: IJclExtendedIterator; begin if ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginWrite; try {$ENDIF THREADSAFE} Result := False; if ACollection = nil then Exit; Result := True; It := First; while It.HasNext do if not ACollection.Contains(It.Next) then It.Remove; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndWrite; end; {$ENDIF THREADSAFE} end; procedure TJclExtendedTree.SetCapacity(Value: Integer); begin raise EJclOperationNotSupportedError.Create; end; procedure TJclExtendedTree.SetTraverseOrder(Value: TJclTraverseOrder); begin FTraverseOrder := Value; end; function TJclExtendedTree.Size: Integer; begin Result := FSize; end; function TJclExtendedTree.CreateEmptyContainer: TJclAbstractContainerBase; begin Result := TJclExtendedTree.Create; AssignPropertiesTo(Result); end; //=== { TJclExtendedTreeIterator } =========================================================== constructor TJclExtendedTreeIterator.Create(OwnTree: TJclExtendedTree; ACursor: TJclExtendedTreeNode; AValid: Boolean; AStart: TItrStart); begin inherited Create(AValid); FCursor := ACursor; FOwnTree := OwnTree; FStart := AStart; FEqualityComparer := OwnTree as IJclExtendedEqualityComparer; end; function TJclExtendedTreeIterator.Add(const AValue: Extended): Boolean; var ParentNode, NewNode: TJclExtendedTreeNode; begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} // add sibling or, if FCursor is root node, behave like TJclExtendedTree.Add Result := (FCursor <> nil) and (FOwnTree.AllowDefaultElements or not FEqualityComparer.ItemsEqual(AValue, 0.0)) and ((not FOwnTree.Contains(AValue)) or FOwnTree.CheckDuplicate); if Result then begin ParentNode := FCursor.Parent; if ParentNode = nil then ParentNode := FCursor; if ParentNode.ChildrenCount = Length(ParentNode.Children) then SetLength(ParentNode.Children, FOwnTree.CalcGrowCapacity(Length(ParentNode.Children), ParentNode.ChildrenCount)); if ParentNode.ChildrenCount < Length(ParentNode.Children) then begin NewNode := TJclExtendedTreeNode.Create; NewNode.Value := AValue; NewNode.Parent := ParentNode; ParentNode.Children[ParentNode.ChildrenCount] := NewNode; Inc(ParentNode.ChildrenCount); Inc(FOwnTree.FSize); end; end; {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; function TJclExtendedTreeIterator.AddChild(const AValue: Extended): Boolean; var NewNode: TJclExtendedTreeNode; begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} Result := (FCursor <> nil) and (FOwnTree.AllowDefaultElements or not FEqualityComparer.ItemsEqual(AValue, 0.0)) and ((not FOwnTree.Contains(AValue)) or FOwnTree.CheckDuplicate); if Result then begin if FCursor.ChildrenCount = Length(FCursor.Children) then SetLength(FCursor.Children, FOwnTree.CalcGrowCapacity(Length(FCursor.Children), FCursor.ChildrenCount)); if FCursor.ChildrenCount < Length(FCursor.Children) then begin NewNode := TJclExtendedTreeNode.Create; NewNode.Value := AValue; NewNode.Parent := FCursor; FCursor.Children[FCursor.ChildrenCount] := NewNode; Inc(FCursor.ChildrenCount); Inc(FOwnTree.FSize); end; end; {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; procedure TJclExtendedTreeIterator.AssignPropertiesTo(Dest: TJclAbstractIterator); var ADest: TJclExtendedTreeIterator; begin inherited AssignPropertiesTo(Dest); if Dest is TJclExtendedTreeIterator then begin ADest := TJclExtendedTreeIterator(Dest); ADest.FCursor := FCursor; ADest.FOwnTree := FOwnTree; ADest.FEqualityComparer := FEqualityComparer; ADest.FStart := FStart; end; end; function TJclExtendedTreeIterator.ChildrenCount: Integer; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} if FCursor <> nil then Result := FCursor.ChildrenCount else Result := 0; {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; procedure TJclExtendedTreeIterator.DeleteChild(Index: Integer); begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} if (FCursor <> nil) and (Index >= 0) and (Index < FCursor.ChildrenCount) then {$IFDEF BCB} FOwnTree.RemoveNode(TJclExtendedTreeNode(FCursor.Children[Index])) {$ELSE ~BCB} FOwnTree.RemoveNode(FCursor.Children[Index]) {$ENDIF ~BCB} else raise EJclOutOfBoundsError.Create; {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; procedure TJclExtendedTreeIterator.DeleteChildren; var Index: Integer; begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} if FCursor <> nil then begin for Index := FCursor.ChildrenCount - 1 downto 0 do {$IFDEF BCB} FOwnTree.RemoveNode(TJclExtendedTreeNode(FCursor.Children[Index])); {$ELSE ~BCB} FOwnTree.RemoveNode(FCursor.Children[Index]); {$ENDIF ~BCB} SetLength(FCursor.Children, 0); FCursor.ChildrenCount := 0; end; {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; procedure TJclExtendedTreeIterator.Extract; var OldCursor: TJclExtendedTreeNode; begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} CheckValid; Valid := False; OldCursor := FCursor; FCursor := GetNextSibling; if OldCursor <> nil then FOwnTree.ExtractNode(OldCursor); {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; procedure TJclExtendedTreeIterator.ExtractChild(Index: Integer); begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} if (FCursor <> nil) and (Index >= 0) and (Index < FCursor.ChildrenCount) then {$IFDEF BCB} FOwnTree.ExtractNode(TJclExtendedTreeNode(FCursor.Children[Index])) {$ELSE ~BCB} FOwnTree.ExtractNode(FCursor.Children[Index]) {$ENDIF ~BCB} else raise EJclOutOfBoundsError.Create; {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; procedure TJclExtendedTreeIterator.ExtractChildren; var Index: Integer; begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} if FCursor <> nil then begin for Index := FCursor.ChildrenCount - 1 downto 0 do {$IFDEF BCB} FOwnTree.ExtractNode(TJclExtendedTreeNode(FCursor.Children[Index])); {$ELSE ~BCB} FOwnTree.ExtractNode(FCursor.Children[Index]); {$ENDIF ~BCB} SetLength(FCursor.Children, 0); FCursor.ChildrenCount := 0; end; {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; function TJclExtendedTreeIterator.GetChild(Index: Integer): Extended; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} Result := 0.0; if (FCursor <> nil) and (Index >= 0) and (Index < FCursor.ChildrenCount) then FCursor := TJclExtendedTreeNode(FCursor.Children[Index]); if FCursor <> nil then Result := FCursor.Value else if not FOwnTree.ReturnDefaultElements then raise EJclNoSuchElementError.Create(''); {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; function TJclExtendedTreeIterator.GetValue: Extended; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} CheckValid; Result := 0.0; if FCursor <> nil then Result := FCursor.Value else if not FOwnTree.ReturnDefaultElements then raise EJclNoSuchElementError.Create(''); {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; function TJclExtendedTreeIterator.HasChild(Index: Integer): Boolean; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} Result := (FCursor <> nil) and (Index >= 0) and (Index < FCursor.ChildrenCount); {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; function TJclExtendedTreeIterator.HasNext: Boolean; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} if Valid then Result := GetNextCursor <> nil else Result := FCursor <> nil; {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; function TJclExtendedTreeIterator.HasParent: Boolean; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} Result := (FCursor <> nil) and (FCursor.Parent <> nil); {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; function TJclExtendedTreeIterator.HasPrevious: Boolean; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} if Valid then Result := GetPreviousCursor <> nil else Result := FCursor <> nil; {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; function TJclExtendedTreeIterator.IndexOfChild(const AValue: Extended): Integer; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} if FCursor <> nil then Result := FCursor.IndexOfValue(AValue, FEqualityComparer) else Result := -1; {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; function TJclExtendedTreeIterator.Insert(const AValue: Extended): Boolean; var ParentNode, NewNode: TJclExtendedTreeNode; Index, I: Integer; begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} // insert sibling or, if FCursor is root node, behave like TJclExtendedTree.Insert Result := (FCursor <> nil) and (FOwnTree.AllowDefaultElements or not FEqualityComparer.ItemsEqual(AValue, 0.0)) and ((not FOwnTree.Contains(AValue)) or FOwnTree.CheckDuplicate); if Result then begin if FCursor.Parent <> nil then begin ParentNode := FCursor.Parent; Index := 0; while (Index < ParentNode.ChildrenCount) and (ParentNode.Children[Index] <> FCursor) do Inc(Index); end else begin ParentNode := FCursor; Index := 0; end; if ParentNode.ChildrenCount = Length(ParentNode.Children) then SetLength(ParentNode.Children, FOwnTree.CalcGrowCapacity(Length(ParentNode.Children), ParentNode.ChildrenCount)); if ParentNode.ChildrenCount < Length(ParentNode.Children) then begin NewNode := TJclExtendedTreeNode.Create; NewNode.Value := AValue; NewNode.Parent := ParentNode; for I := ParentNode.ChildrenCount - 1 downto Index do ParentNode.Children[I + 1] := ParentNode.Children[I]; ParentNode.Children[Index] := NewNode; Inc(ParentNode.ChildrenCount); Inc(FOwnTree.FSize); end; end; {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; function TJclExtendedTreeIterator.InsertChild(Index: Integer; const AValue: Extended): Boolean; var NewNode: TJclExtendedTreeNode; I: Integer; begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} // insert sibling or, if FCursor is root node, behave like TJclExtendedTree.Insert Result := (FCursor <> nil) and (FOwnTree.AllowDefaultElements or not FEqualityComparer.ItemsEqual(AValue, 0.0)) and ((not FOwnTree.Contains(AValue)) or FOwnTree.CheckDuplicate); if Result then begin if FCursor.ChildrenCount = Length(FCursor.Children) then SetLength(FCursor.Children, FOwnTree.CalcGrowCapacity(Length(FCursor.Children), FCursor.ChildrenCount)); if FCursor.ChildrenCount < Length(FCursor.Children) then begin NewNode := TJclExtendedTreeNode.Create; NewNode.Value := AValue; NewNode.Parent := FCursor; for I := FCursor.ChildrenCount - 1 downto Index do FCursor.Children[I + 1] := FCursor.Children[I]; FCursor.Children[Index] := NewNode; Inc(FCursor.ChildrenCount); Inc(FOwnTree.FSize); end; end; {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; function TJclExtendedTreeIterator.IteratorEquals(const AIterator: IJclExtendedIterator): Boolean; var Obj: TObject; ItrObj: TJclExtendedTreeIterator; begin Result := False; if AIterator = nil then Exit; Obj := AIterator.GetIteratorReference; if Obj is TJclExtendedTreeIterator then begin ItrObj := TJclExtendedTreeIterator(Obj); Result := (FOwnTree = ItrObj.FOwnTree) and (FCursor = ItrObj.FCursor) and (Valid = ItrObj.Valid); end; end; {$IFDEF SUPPORTS_FOR_IN} function TJclExtendedTreeIterator.MoveNext: Boolean; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} if Valid then FCursor := GetNextCursor else Valid := True; Result := FCursor <> nil; {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; {$ENDIF SUPPORTS_FOR_IN} function TJclExtendedTreeIterator.Next: Extended; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} if Valid then FCursor := GetNextCursor else Valid := True; Result := 0.0; if FCursor <> nil then Result := FCursor.Value else if not FOwnTree.ReturnDefaultElements then raise EJclNoSuchElementError.Create(''); {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; function TJclExtendedTreeIterator.NextIndex: Integer; begin // No index raise EJclOperationNotSupportedError.Create; end; function TJclExtendedTreeIterator.Parent: Extended; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} Result := 0.0; if FCursor <> nil then FCursor := FCursor.Parent; if FCursor <> nil then Result := FCursor.Value else if not FOwnTree.ReturnDefaultElements then raise EJclNoSuchElementError.Create(''); {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; function TJclExtendedTreeIterator.Previous: Extended; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} if Valid then FCursor := GetPreviousCursor else Valid := True; Result := 0.0; if FCursor <> nil then Result := FCursor.Value else if not FOwnTree.ReturnDefaultElements then raise EJclNoSuchElementError.Create(''); {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; function TJclExtendedTreeIterator.PreviousIndex: Integer; begin // No index raise EJclOperationNotSupportedError.Create; end; procedure TJclExtendedTreeIterator.Remove; var OldCursor: TJclExtendedTreeNode; begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} CheckValid; Valid := False; OldCursor := FCursor; FCursor := GetNextSibling; if OldCursor <> nil then FOwnTree.RemoveNode(OldCursor); {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; procedure TJclExtendedTreeIterator.Reset; var NewCursor: TJclExtendedTreeNode; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} Valid := False; case FStart of isFirst: begin NewCursor := FCursor; while NewCursor <> nil do begin NewCursor := GetPreviousCursor; if NewCursor <> nil then FCursor := NewCursor; end; end; isLast: begin NewCursor := FCursor; while NewCursor <> nil do begin NewCursor := GetNextCursor; if NewCursor <> nil then FCursor := NewCursor; end; end; isRoot: begin while (FCursor <> nil) and (FCursor.Parent <> nil) do FCursor := FCursor.Parent; end; end; {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; procedure TJclExtendedTreeIterator.SetChild(Index: Integer; const AValue: Extended); begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} if (FCursor <> nil) and (Index >= 0) and (Index < FCursor.ChildrenCount) then TJclExtendedTreeNode(FCursor.Children[Index]).Value := AValue else raise EJclOutOfBoundsError.Create; {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; procedure TJclExtendedTreeIterator.SetValue(const AValue: Extended); begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} CheckValid; if FCursor <> nil then begin FOwnTree.FreeExtended(FCursor.Value); FCursor.Value := AValue; end; {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; //=== { TJclPreOrderExtendedTreeIterator } =================================================== function TJclPreOrderExtendedTreeIterator.CreateEmptyIterator: TJclAbstractIterator; begin Result := TJclPreOrderExtendedTreeIterator.Create(FOwnTree, FCursor, Valid, FStart); end; function TJclPreOrderExtendedTreeIterator.GetNextCursor: TJclExtendedTreeNode; var LastRet: TJclExtendedTreeNode; begin Result := FCursor; if Result = nil then Exit; LastRet := Result; if Result.ChildrenCount > 0 then Result := TJclExtendedTreeNode(Result.Children[0]) else begin Result := Result.Parent; while (Result <> nil) and (Result.IndexOfChild(LastRet) = (Result.ChildrenCount - 1)) do begin LastRet := Result; Result := Result.Parent; end; if Result <> nil then // not root = return successor Result := TJclExtendedTreeNode(Result.Children[Result.IndexOfChild(LastRet) + 1]); end; end; function TJclPreOrderExtendedTreeIterator.GetNextSibling: TJclExtendedTreeNode; var LastRet: TJclExtendedTreeNode; begin Result := FCursor; if Result = nil then Exit; LastRet := Result; Result := Result.Parent; while (Result <> nil) and (Result.IndexOfChild(LastRet) = (Result.ChildrenCount - 1)) do begin LastRet := Result; Result := Result.Parent; end; if Result <> nil then // not root = return successor Result := TJclExtendedTreeNode(Result.Children[Result.IndexOfChild(LastRet) + 1]); end; function TJclPreOrderExtendedTreeIterator.GetPreviousCursor: TJclExtendedTreeNode; var LastRet: TJclExtendedTreeNode; begin Result := FCursor; if Result = nil then Exit; LastRet := Result; Result := Result.Parent; if (Result <> nil) and (Result.IndexOfChild(LastRet) > 0) then // come from Right begin Result := TJclExtendedTreeNode(Result.Children[Result.IndexOfChild(LastRet) - 1]); while (Result.ChildrenCount > 0) do // descend down the tree Result := TJclExtendedTreeNode(Result.Children[Result.ChildrenCount - 1]); end; end; //=== { TJclPostOrderExtendedTreeIterator } ================================================== function TJclPostOrderExtendedTreeIterator.CreateEmptyIterator: TJclAbstractIterator; begin Result := TJclPostOrderExtendedTreeIterator.Create(FOwnTree, FCursor, Valid, FStart); end; function TJclPostOrderExtendedTreeIterator.GetNextCursor: TJclExtendedTreeNode; var LastRet: TJclExtendedTreeNode; begin Result := FCursor; if Result = nil then Exit; LastRet := Result; Result := Result.Parent; if (Result <> nil) and (Result.IndexOfChild(LastRet) <> (Result.ChildrenCount - 1)) then begin Result := TJclExtendedTreeNode(Result.Children[Result.IndexOfChild(LastRet) + 1]); while Result.ChildrenCount > 0 do Result := TJclExtendedTreeNode(Result.Children[0]); end; end; function TJclPostOrderExtendedTreeIterator.GetNextSibling: TJclExtendedTreeNode; var LastRet: TJclExtendedTreeNode; begin Result := FCursor; if Result = nil then Exit; LastRet := Result; Result := Result.Parent; if (Result <> nil) and (Result.IndexOfChild(LastRet) <> (Result.ChildrenCount - 1)) then begin Result := TJclExtendedTreeNode(Result.Children[Result.IndexOfChild(LastRet) + 1]); while Result.ChildrenCount > 0 do Result := TJclExtendedTreeNode(Result.Children[0]); end; end; function TJclPostOrderExtendedTreeIterator.GetPreviousCursor: TJclExtendedTreeNode; var LastRet: TJclExtendedTreeNode; begin Result := FCursor; if Result = nil then Exit; if Result.ChildrenCount > 0 then Result := TJclExtendedTreeNode(Result.Children[Result.ChildrenCount - 1]) else begin LastRet := Result; Result := Result.Parent; while (Result <> nil) and (Result.IndexOfChild(LastRet) = 0) do begin LastRet := Result; Result := Result.Parent; end; if Result <> nil then // not root Result := TJclExtendedTreeNode(Result.Children[Result.IndexOfChild(LastRet) - 1]); end; end; //=== { TJclIntegerTreeNode } ======================================================= function TJclIntegerTreeNode.IndexOfChild(AChild: TJclIntegerTreeNode): Integer; begin for Result := 0 to ChildrenCount - 1 do if Children[Result] = AChild then Exit; Result := -1; end; function TJclIntegerTreeNode.IndexOfValue(AValue: Integer; const AEqualityComparer: IJclIntegerEqualityComparer): Integer; begin for Result := 0 to ChildrenCount - 1 do if AEqualityComparer.ItemsEqual(TJclIntegerTreeNode(Children[Result]).Value, AValue) then Exit; Result := -1; end; //=== { TJclIntegerTree } ======================================================= constructor TJclIntegerTree.Create(); begin inherited Create(); FTraverseOrder := toPreOrder; end; destructor TJclIntegerTree.Destroy; begin FReadOnly := False; Clear; inherited Destroy; end; function TJclIntegerTree.Add(AValue: Integer): Boolean; var NewNode: TJclIntegerTreeNode; begin if ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginWrite; try {$ENDIF THREADSAFE} Result := AllowDefaultElements or not ItemsEqual(AValue, 0); if Result then begin if FRoot <> nil then begin Result := (not Contains(AValue)) or CheckDuplicate; if Result then begin if FRoot.ChildrenCount = Length(FRoot.Children) then SetLength(FRoot.Children, CalcGrowCapacity(Length(FRoot.Children), FRoot.ChildrenCount)); if FRoot.ChildrenCount < Length(FRoot.Children) then begin NewNode := TJclIntegerTreeNode.Create; NewNode.Value := AValue; NewNode.Parent := FRoot; FRoot.Children[FRoot.ChildrenCount] := NewNode; Inc(FRoot.ChildrenCount); Inc(FSize); end else Result := False; end; end else begin FRoot := TJclIntegerTreeNode.Create; FRoot.Value := AValue; Inc(FSize); end; end; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndWrite; end; {$ENDIF THREADSAFE} end; function TJclIntegerTree.AddAll(const ACollection: IJclIntegerCollection): Boolean; var It: IJclIntegerIterator; begin if ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginWrite; try {$ENDIF THREADSAFE} Result := False; if ACollection = nil then Exit; Result := True; It := ACollection.First; while It.HasNext do Result := Add(It.Next) and Result; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndWrite; end; {$ENDIF THREADSAFE} end; procedure TJclIntegerTree.AssignDataTo(Dest: TJclAbstractContainerBase); var ADest: TJclIntegerTree; ACollection: IJclIntegerCollection; begin inherited AssignDataTo(Dest); if Dest is TJclIntegerTree then begin ADest := TJclIntegerTree(Dest); ADest.Clear; ADest.FSize := FSize; if FRoot <> nil then ADest.FRoot := CloneNode(FRoot, nil); end else if Supports(IInterface(Dest), IJclIntegerCollection, ACollection) then begin ACollection.Clear; ACollection.AddAll(Self); end; end; procedure TJclIntegerTree.AssignPropertiesTo(Dest: TJclAbstractContainerBase); begin inherited AssignPropertiesto(Dest); if Dest is TJclIntegerTree then TJclIntegerTree(Dest).FTraverseOrder := FTraverseOrder; end; procedure TJclIntegerTree.Clear; begin if ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginWrite; try {$ENDIF THREADSAFE} if FRoot <> nil then RemoveNode(FRoot); FSize := 0; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndWrite; end; {$ENDIF THREADSAFE} end; function TJclIntegerTree.CloneNode(Node, Parent: TJclIntegerTreeNode): TJclIntegerTreeNode; var Index: Integer; begin Result := TJclIntegerTreeNode.Create; Result.Value := Node.Value; Result.Parent := Parent; SetLength(Result.Children, Node.ChildrenCount); Result.ChildrenCount := Node.ChildrenCount; for Index := 0 to Node.ChildrenCount - 1 do Result.Children[Index] := CloneNode(TJclIntegerTreeNode(Node.Children[Index]), Result); // recursive call end; function TJclIntegerTree.CollectionEquals(const ACollection: IJclIntegerCollection): Boolean; var It, ItSelf: IJclIntegerIterator; begin {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginRead; try {$ENDIF THREADSAFE} Result := False; if ACollection = nil then Exit; if FSize <> ACollection.Size then Exit; Result := True; It := ACollection.First; ItSelf := First; while ItSelf.HasNext do if not ItemsEqual(ItSelf.Next, It.Next) then begin Result := False; Break; end; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndRead; end; {$ENDIF THREADSAFE} end; function TJclIntegerTree.Contains(AValue: Integer): Boolean; begin {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginRead; try {$ENDIF THREADSAFE} if FRoot <> nil then Result := NodeContains(FRoot, AValue) else Result := False; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndRead; end; {$ENDIF THREADSAFE} end; function TJclIntegerTree.ContainsAll(const ACollection: IJclIntegerCollection): Boolean; var It: IJclIntegerIterator; begin {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginRead; try {$ENDIF THREADSAFE} Result := True; if ACollection = nil then Exit; It := ACollection.First; while Result and It.HasNext do Result := Contains(It.Next); {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndRead; end; {$ENDIF THREADSAFE} end; function TJclIntegerTree.Extract(AValue: Integer): Boolean; var It: IJclIntegerIterator; begin if ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginWrite; try {$ENDIF THREADSAFE} Result := FRoot <> nil; if Result then begin It := First; while It.HasNext do if ItemsEqual(It.Next, AValue) then begin It.Extract; if RemoveSingleElement then Break; end; end; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndWrite; end; {$ENDIF THREADSAFE} end; function TJclIntegerTree.ExtractAll(const ACollection: IJclIntegerCollection): Boolean; var It: IJclIntegerIterator; begin if ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginWrite; try {$ENDIF THREADSAFE} Result := False; if ACollection = nil then Exit; Result := True; It := ACollection.First; while It.HasNext do Result := Extract(It.Next) and Result; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndWrite; end; {$ENDIF THREADSAFE} end; procedure TJclIntegerTree.ExtractNode(var ANode: TJclIntegerTreeNode); var Index, ChildIndex, NewCapacity: Integer; Parent: TJclIntegerTreeNode; begin for Index := ANode.ChildrenCount - 1 downto 0 do {$IFDEF BCB} ExtractNode(TJclIntegerTreeNode(ANode.Children[Index])); {$ELSE ~BCB} ExtractNode(ANode.Children[Index]); {$ENDIF ~BCB} Parent := ANode.Parent; if Parent <> nil then begin ChildIndex := Parent.IndexOfChild(ANode); for Index := ChildIndex + 1 to Parent.ChildrenCount - 1 do Parent.Children[Index - 1] := Parent.Children[Index]; Dec(Parent.ChildrenCount); NewCapacity := CalcPackCapacity(Length(Parent.Children), Parent.ChildrenCount); if NewCapacity < Length(Parent.Children) then SetLength(Parent.Children, NewCapacity); FreeAndNil(ANode); end else begin FreeAndNil(ANode); FRoot := nil; end; Dec(FSize); end; function TJclIntegerTree.First: IJclIntegerIterator; var Start: TJclIntegerTreeNode; begin {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginRead; try {$ENDIF THREADSAFE} Start := FRoot; case GetTraverseOrder of toPreOrder: Result := TJclPreOrderIntegerTreeIterator.Create(Self, Start, False, isFirst); toPostOrder: begin if Start <> nil then while (Start.ChildrenCount > 0) do Start := TJclIntegerTreeNode(Start.Children[0]); Result := TJclPostOrderIntegerTreeIterator.Create(Self, Start, False, isFirst); end; else Result := nil; end; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndRead; end; {$ENDIF THREADSAFE} end; {$IFDEF SUPPORTS_FOR_IN} function TJclIntegerTree.GetEnumerator: IJclIntegerIterator; begin Result := First; end; {$ENDIF SUPPORTS_FOR_IN} function TJclIntegerTree.GetRoot: IJclIntegerTreeIterator; begin {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginRead; try {$ENDIF THREADSAFE} case GetTraverseOrder of toPreOrder: Result := TJclPreOrderIntegerTreeIterator.Create(Self, FRoot, False, isRoot); toPostOrder: Result := TJclPostOrderIntegerTreeIterator.Create(Self, FRoot, False, isRoot); else Result := nil; end; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndRead; end; {$ENDIF THREADSAFE} end; function TJclIntegerTree.GetTraverseOrder: TJclTraverseOrder; begin Result := FTraverseOrder; end; function TJclIntegerTree.IsEmpty: Boolean; begin Result := FSize = 0; end; function TJclIntegerTree.Last: IJclIntegerIterator; var Start: TJclIntegerTreeNode; begin {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginRead; try {$ENDIF THREADSAFE} Start := FRoot; case FTraverseOrder of toPreOrder: begin if Start <> nil then while Start.ChildrenCount > 0 do Start := TJclIntegerTreeNode(Start.Children[Start.ChildrenCount - 1]); Result := TJclPreOrderIntegerTreeIterator.Create(Self, Start, False, isLast); end; toPostOrder: Result := TJclPostOrderIntegerTreeIterator.Create(Self, Start, False, isLast); else Result := nil; end; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndRead; end; {$ENDIF THREADSAFE} end; function TJclIntegerTree.NodeContains(ANode: TJclIntegerTreeNode; AValue: Integer): Boolean; var Index: Integer; begin Result := ItemsEqual(ANode.Value, AValue); if not Result then for Index := 0 to ANode.ChildrenCount - 1 do begin Result := NodeContains(TJclIntegerTreeNode(ANode.Children[Index]), AValue); if Result then Break; end; end; procedure TJclIntegerTree.Pack; begin if ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginWrite; try {$ENDIF THREADSAFE} if FRoot <> nil then PackNode(FRoot); {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndWrite; end; {$ENDIF THREADSAFE} end; procedure TJclIntegerTree.PackNode(ANode: TJclIntegerTreeNode); var Index: Integer; begin SetLength(ANode.Children, ANode.ChildrenCount); for Index := 0 to ANode.ChildrenCount - 1 do PackNode(TJclIntegerTreeNode(ANode.Children[Index])); end; function TJclIntegerTree.Remove(AValue: Integer): Boolean; var Extracted: Integer; begin if ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginWrite; try {$ENDIF THREADSAFE} Result := Extract(AValue); if Result then begin Extracted := AValue; FreeInteger(Extracted); end; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndWrite; end; {$ENDIF THREADSAFE} end; function TJclIntegerTree.RemoveAll(const ACollection: IJclIntegerCollection): Boolean; var It: IJclIntegerIterator; begin if ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginWrite; try {$ENDIF THREADSAFE} Result := False; if ACollection = nil then Exit; Result := True; It := ACollection.First; while It.HasNext do Result := Remove(It.Next) and Result; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndWrite; end; {$ENDIF THREADSAFE} end; procedure TJclIntegerTree.RemoveNode(var ANode: TJclIntegerTreeNode); var Index, ChildIndex, NewCapacity: Integer; Parent: TJclIntegerTreeNode; begin for Index := ANode.ChildrenCount - 1 downto 0 do {$IFDEF BCB} RemoveNode(TJclIntegerTreeNode(ANode.Children[Index])); {$ELSE ~BCB} RemoveNode(ANode.Children[Index]); {$ENDIF ~BCB} FreeInteger(ANode.Value); Parent := ANode.Parent; if Parent <> nil then begin ChildIndex := Parent.IndexOfChild(ANode); for Index := ChildIndex + 1 to Parent.ChildrenCount - 1 do Parent.Children[Index - 1] := Parent.Children[Index]; Dec(Parent.ChildrenCount); NewCapacity := CalcPackCapacity(Length(Parent.Children), Parent.ChildrenCount); if NewCapacity < Length(Parent.Children) then SetLength(Parent.Children, NewCapacity); FreeAndNil(ANode); end else begin FreeAndNil(ANode); FRoot := nil; end; Dec(FSize); end; function TJclIntegerTree.RetainAll(const ACollection: IJclIntegerCollection): Boolean; var It: IJclIntegerIterator; begin if ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginWrite; try {$ENDIF THREADSAFE} Result := False; if ACollection = nil then Exit; Result := True; It := First; while It.HasNext do if not ACollection.Contains(It.Next) then It.Remove; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndWrite; end; {$ENDIF THREADSAFE} end; procedure TJclIntegerTree.SetCapacity(Value: Integer); begin raise EJclOperationNotSupportedError.Create; end; procedure TJclIntegerTree.SetTraverseOrder(Value: TJclTraverseOrder); begin FTraverseOrder := Value; end; function TJclIntegerTree.Size: Integer; begin Result := FSize; end; function TJclIntegerTree.CreateEmptyContainer: TJclAbstractContainerBase; begin Result := TJclIntegerTree.Create; AssignPropertiesTo(Result); end; //=== { TJclIntegerTreeIterator } =========================================================== constructor TJclIntegerTreeIterator.Create(OwnTree: TJclIntegerTree; ACursor: TJclIntegerTreeNode; AValid: Boolean; AStart: TItrStart); begin inherited Create(AValid); FCursor := ACursor; FOwnTree := OwnTree; FStart := AStart; FEqualityComparer := OwnTree as IJclIntegerEqualityComparer; end; function TJclIntegerTreeIterator.Add(AValue: Integer): Boolean; var ParentNode, NewNode: TJclIntegerTreeNode; begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} // add sibling or, if FCursor is root node, behave like TJclIntegerTree.Add Result := (FCursor <> nil) and (FOwnTree.AllowDefaultElements or not FEqualityComparer.ItemsEqual(AValue, 0)) and ((not FOwnTree.Contains(AValue)) or FOwnTree.CheckDuplicate); if Result then begin ParentNode := FCursor.Parent; if ParentNode = nil then ParentNode := FCursor; if ParentNode.ChildrenCount = Length(ParentNode.Children) then SetLength(ParentNode.Children, FOwnTree.CalcGrowCapacity(Length(ParentNode.Children), ParentNode.ChildrenCount)); if ParentNode.ChildrenCount < Length(ParentNode.Children) then begin NewNode := TJclIntegerTreeNode.Create; NewNode.Value := AValue; NewNode.Parent := ParentNode; ParentNode.Children[ParentNode.ChildrenCount] := NewNode; Inc(ParentNode.ChildrenCount); Inc(FOwnTree.FSize); end; end; {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; function TJclIntegerTreeIterator.AddChild(AValue: Integer): Boolean; var NewNode: TJclIntegerTreeNode; begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} Result := (FCursor <> nil) and (FOwnTree.AllowDefaultElements or not FEqualityComparer.ItemsEqual(AValue, 0)) and ((not FOwnTree.Contains(AValue)) or FOwnTree.CheckDuplicate); if Result then begin if FCursor.ChildrenCount = Length(FCursor.Children) then SetLength(FCursor.Children, FOwnTree.CalcGrowCapacity(Length(FCursor.Children), FCursor.ChildrenCount)); if FCursor.ChildrenCount < Length(FCursor.Children) then begin NewNode := TJclIntegerTreeNode.Create; NewNode.Value := AValue; NewNode.Parent := FCursor; FCursor.Children[FCursor.ChildrenCount] := NewNode; Inc(FCursor.ChildrenCount); Inc(FOwnTree.FSize); end; end; {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; procedure TJclIntegerTreeIterator.AssignPropertiesTo(Dest: TJclAbstractIterator); var ADest: TJclIntegerTreeIterator; begin inherited AssignPropertiesTo(Dest); if Dest is TJclIntegerTreeIterator then begin ADest := TJclIntegerTreeIterator(Dest); ADest.FCursor := FCursor; ADest.FOwnTree := FOwnTree; ADest.FEqualityComparer := FEqualityComparer; ADest.FStart := FStart; end; end; function TJclIntegerTreeIterator.ChildrenCount: Integer; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} if FCursor <> nil then Result := FCursor.ChildrenCount else Result := 0; {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; procedure TJclIntegerTreeIterator.DeleteChild(Index: Integer); begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} if (FCursor <> nil) and (Index >= 0) and (Index < FCursor.ChildrenCount) then {$IFDEF BCB} FOwnTree.RemoveNode(TJclIntegerTreeNode(FCursor.Children[Index])) {$ELSE ~BCB} FOwnTree.RemoveNode(FCursor.Children[Index]) {$ENDIF ~BCB} else raise EJclOutOfBoundsError.Create; {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; procedure TJclIntegerTreeIterator.DeleteChildren; var Index: Integer; begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} if FCursor <> nil then begin for Index := FCursor.ChildrenCount - 1 downto 0 do {$IFDEF BCB} FOwnTree.RemoveNode(TJclIntegerTreeNode(FCursor.Children[Index])); {$ELSE ~BCB} FOwnTree.RemoveNode(FCursor.Children[Index]); {$ENDIF ~BCB} SetLength(FCursor.Children, 0); FCursor.ChildrenCount := 0; end; {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; procedure TJclIntegerTreeIterator.Extract; var OldCursor: TJclIntegerTreeNode; begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} CheckValid; Valid := False; OldCursor := FCursor; FCursor := GetNextSibling; if OldCursor <> nil then FOwnTree.ExtractNode(OldCursor); {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; procedure TJclIntegerTreeIterator.ExtractChild(Index: Integer); begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} if (FCursor <> nil) and (Index >= 0) and (Index < FCursor.ChildrenCount) then {$IFDEF BCB} FOwnTree.ExtractNode(TJclIntegerTreeNode(FCursor.Children[Index])) {$ELSE ~BCB} FOwnTree.ExtractNode(FCursor.Children[Index]) {$ENDIF ~BCB} else raise EJclOutOfBoundsError.Create; {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; procedure TJclIntegerTreeIterator.ExtractChildren; var Index: Integer; begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} if FCursor <> nil then begin for Index := FCursor.ChildrenCount - 1 downto 0 do {$IFDEF BCB} FOwnTree.ExtractNode(TJclIntegerTreeNode(FCursor.Children[Index])); {$ELSE ~BCB} FOwnTree.ExtractNode(FCursor.Children[Index]); {$ENDIF ~BCB} SetLength(FCursor.Children, 0); FCursor.ChildrenCount := 0; end; {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; function TJclIntegerTreeIterator.GetChild(Index: Integer): Integer; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} Result := 0; if (FCursor <> nil) and (Index >= 0) and (Index < FCursor.ChildrenCount) then FCursor := TJclIntegerTreeNode(FCursor.Children[Index]); if FCursor <> nil then Result := FCursor.Value else if not FOwnTree.ReturnDefaultElements then raise EJclNoSuchElementError.Create(''); {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; function TJclIntegerTreeIterator.GetValue: Integer; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} CheckValid; Result := 0; if FCursor <> nil then Result := FCursor.Value else if not FOwnTree.ReturnDefaultElements then raise EJclNoSuchElementError.Create(''); {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; function TJclIntegerTreeIterator.HasChild(Index: Integer): Boolean; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} Result := (FCursor <> nil) and (Index >= 0) and (Index < FCursor.ChildrenCount); {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; function TJclIntegerTreeIterator.HasNext: Boolean; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} if Valid then Result := GetNextCursor <> nil else Result := FCursor <> nil; {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; function TJclIntegerTreeIterator.HasParent: Boolean; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} Result := (FCursor <> nil) and (FCursor.Parent <> nil); {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; function TJclIntegerTreeIterator.HasPrevious: Boolean; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} if Valid then Result := GetPreviousCursor <> nil else Result := FCursor <> nil; {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; function TJclIntegerTreeIterator.IndexOfChild(AValue: Integer): Integer; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} if FCursor <> nil then Result := FCursor.IndexOfValue(AValue, FEqualityComparer) else Result := -1; {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; function TJclIntegerTreeIterator.Insert(AValue: Integer): Boolean; var ParentNode, NewNode: TJclIntegerTreeNode; Index, I: Integer; begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} // insert sibling or, if FCursor is root node, behave like TJclIntegerTree.Insert Result := (FCursor <> nil) and (FOwnTree.AllowDefaultElements or not FEqualityComparer.ItemsEqual(AValue, 0)) and ((not FOwnTree.Contains(AValue)) or FOwnTree.CheckDuplicate); if Result then begin if FCursor.Parent <> nil then begin ParentNode := FCursor.Parent; Index := 0; while (Index < ParentNode.ChildrenCount) and (ParentNode.Children[Index] <> FCursor) do Inc(Index); end else begin ParentNode := FCursor; Index := 0; end; if ParentNode.ChildrenCount = Length(ParentNode.Children) then SetLength(ParentNode.Children, FOwnTree.CalcGrowCapacity(Length(ParentNode.Children), ParentNode.ChildrenCount)); if ParentNode.ChildrenCount < Length(ParentNode.Children) then begin NewNode := TJclIntegerTreeNode.Create; NewNode.Value := AValue; NewNode.Parent := ParentNode; for I := ParentNode.ChildrenCount - 1 downto Index do ParentNode.Children[I + 1] := ParentNode.Children[I]; ParentNode.Children[Index] := NewNode; Inc(ParentNode.ChildrenCount); Inc(FOwnTree.FSize); end; end; {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; function TJclIntegerTreeIterator.InsertChild(Index: Integer; AValue: Integer): Boolean; var NewNode: TJclIntegerTreeNode; I: Integer; begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} // insert sibling or, if FCursor is root node, behave like TJclIntegerTree.Insert Result := (FCursor <> nil) and (FOwnTree.AllowDefaultElements or not FEqualityComparer.ItemsEqual(AValue, 0)) and ((not FOwnTree.Contains(AValue)) or FOwnTree.CheckDuplicate); if Result then begin if FCursor.ChildrenCount = Length(FCursor.Children) then SetLength(FCursor.Children, FOwnTree.CalcGrowCapacity(Length(FCursor.Children), FCursor.ChildrenCount)); if FCursor.ChildrenCount < Length(FCursor.Children) then begin NewNode := TJclIntegerTreeNode.Create; NewNode.Value := AValue; NewNode.Parent := FCursor; for I := FCursor.ChildrenCount - 1 downto Index do FCursor.Children[I + 1] := FCursor.Children[I]; FCursor.Children[Index] := NewNode; Inc(FCursor.ChildrenCount); Inc(FOwnTree.FSize); end; end; {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; function TJclIntegerTreeIterator.IteratorEquals(const AIterator: IJclIntegerIterator): Boolean; var Obj: TObject; ItrObj: TJclIntegerTreeIterator; begin Result := False; if AIterator = nil then Exit; Obj := AIterator.GetIteratorReference; if Obj is TJclIntegerTreeIterator then begin ItrObj := TJclIntegerTreeIterator(Obj); Result := (FOwnTree = ItrObj.FOwnTree) and (FCursor = ItrObj.FCursor) and (Valid = ItrObj.Valid); end; end; {$IFDEF SUPPORTS_FOR_IN} function TJclIntegerTreeIterator.MoveNext: Boolean; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} if Valid then FCursor := GetNextCursor else Valid := True; Result := FCursor <> nil; {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; {$ENDIF SUPPORTS_FOR_IN} function TJclIntegerTreeIterator.Next: Integer; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} if Valid then FCursor := GetNextCursor else Valid := True; Result := 0; if FCursor <> nil then Result := FCursor.Value else if not FOwnTree.ReturnDefaultElements then raise EJclNoSuchElementError.Create(''); {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; function TJclIntegerTreeIterator.NextIndex: Integer; begin // No index raise EJclOperationNotSupportedError.Create; end; function TJclIntegerTreeIterator.Parent: Integer; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} Result := 0; if FCursor <> nil then FCursor := FCursor.Parent; if FCursor <> nil then Result := FCursor.Value else if not FOwnTree.ReturnDefaultElements then raise EJclNoSuchElementError.Create(''); {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; function TJclIntegerTreeIterator.Previous: Integer; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} if Valid then FCursor := GetPreviousCursor else Valid := True; Result := 0; if FCursor <> nil then Result := FCursor.Value else if not FOwnTree.ReturnDefaultElements then raise EJclNoSuchElementError.Create(''); {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; function TJclIntegerTreeIterator.PreviousIndex: Integer; begin // No index raise EJclOperationNotSupportedError.Create; end; procedure TJclIntegerTreeIterator.Remove; var OldCursor: TJclIntegerTreeNode; begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} CheckValid; Valid := False; OldCursor := FCursor; FCursor := GetNextSibling; if OldCursor <> nil then FOwnTree.RemoveNode(OldCursor); {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; procedure TJclIntegerTreeIterator.Reset; var NewCursor: TJclIntegerTreeNode; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} Valid := False; case FStart of isFirst: begin NewCursor := FCursor; while NewCursor <> nil do begin NewCursor := GetPreviousCursor; if NewCursor <> nil then FCursor := NewCursor; end; end; isLast: begin NewCursor := FCursor; while NewCursor <> nil do begin NewCursor := GetNextCursor; if NewCursor <> nil then FCursor := NewCursor; end; end; isRoot: begin while (FCursor <> nil) and (FCursor.Parent <> nil) do FCursor := FCursor.Parent; end; end; {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; procedure TJclIntegerTreeIterator.SetChild(Index: Integer; AValue: Integer); begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} if (FCursor <> nil) and (Index >= 0) and (Index < FCursor.ChildrenCount) then TJclIntegerTreeNode(FCursor.Children[Index]).Value := AValue else raise EJclOutOfBoundsError.Create; {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; procedure TJclIntegerTreeIterator.SetValue(AValue: Integer); begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} CheckValid; if FCursor <> nil then begin FOwnTree.FreeInteger(FCursor.Value); FCursor.Value := AValue; end; {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; //=== { TJclPreOrderIntegerTreeIterator } =================================================== function TJclPreOrderIntegerTreeIterator.CreateEmptyIterator: TJclAbstractIterator; begin Result := TJclPreOrderIntegerTreeIterator.Create(FOwnTree, FCursor, Valid, FStart); end; function TJclPreOrderIntegerTreeIterator.GetNextCursor: TJclIntegerTreeNode; var LastRet: TJclIntegerTreeNode; begin Result := FCursor; if Result = nil then Exit; LastRet := Result; if Result.ChildrenCount > 0 then Result := TJclIntegerTreeNode(Result.Children[0]) else begin Result := Result.Parent; while (Result <> nil) and (Result.IndexOfChild(LastRet) = (Result.ChildrenCount - 1)) do begin LastRet := Result; Result := Result.Parent; end; if Result <> nil then // not root = return successor Result := TJclIntegerTreeNode(Result.Children[Result.IndexOfChild(LastRet) + 1]); end; end; function TJclPreOrderIntegerTreeIterator.GetNextSibling: TJclIntegerTreeNode; var LastRet: TJclIntegerTreeNode; begin Result := FCursor; if Result = nil then Exit; LastRet := Result; Result := Result.Parent; while (Result <> nil) and (Result.IndexOfChild(LastRet) = (Result.ChildrenCount - 1)) do begin LastRet := Result; Result := Result.Parent; end; if Result <> nil then // not root = return successor Result := TJclIntegerTreeNode(Result.Children[Result.IndexOfChild(LastRet) + 1]); end; function TJclPreOrderIntegerTreeIterator.GetPreviousCursor: TJclIntegerTreeNode; var LastRet: TJclIntegerTreeNode; begin Result := FCursor; if Result = nil then Exit; LastRet := Result; Result := Result.Parent; if (Result <> nil) and (Result.IndexOfChild(LastRet) > 0) then // come from Right begin Result := TJclIntegerTreeNode(Result.Children[Result.IndexOfChild(LastRet) - 1]); while (Result.ChildrenCount > 0) do // descend down the tree Result := TJclIntegerTreeNode(Result.Children[Result.ChildrenCount - 1]); end; end; //=== { TJclPostOrderIntegerTreeIterator } ================================================== function TJclPostOrderIntegerTreeIterator.CreateEmptyIterator: TJclAbstractIterator; begin Result := TJclPostOrderIntegerTreeIterator.Create(FOwnTree, FCursor, Valid, FStart); end; function TJclPostOrderIntegerTreeIterator.GetNextCursor: TJclIntegerTreeNode; var LastRet: TJclIntegerTreeNode; begin Result := FCursor; if Result = nil then Exit; LastRet := Result; Result := Result.Parent; if (Result <> nil) and (Result.IndexOfChild(LastRet) <> (Result.ChildrenCount - 1)) then begin Result := TJclIntegerTreeNode(Result.Children[Result.IndexOfChild(LastRet) + 1]); while Result.ChildrenCount > 0 do Result := TJclIntegerTreeNode(Result.Children[0]); end; end; function TJclPostOrderIntegerTreeIterator.GetNextSibling: TJclIntegerTreeNode; var LastRet: TJclIntegerTreeNode; begin Result := FCursor; if Result = nil then Exit; LastRet := Result; Result := Result.Parent; if (Result <> nil) and (Result.IndexOfChild(LastRet) <> (Result.ChildrenCount - 1)) then begin Result := TJclIntegerTreeNode(Result.Children[Result.IndexOfChild(LastRet) + 1]); while Result.ChildrenCount > 0 do Result := TJclIntegerTreeNode(Result.Children[0]); end; end; function TJclPostOrderIntegerTreeIterator.GetPreviousCursor: TJclIntegerTreeNode; var LastRet: TJclIntegerTreeNode; begin Result := FCursor; if Result = nil then Exit; if Result.ChildrenCount > 0 then Result := TJclIntegerTreeNode(Result.Children[Result.ChildrenCount - 1]) else begin LastRet := Result; Result := Result.Parent; while (Result <> nil) and (Result.IndexOfChild(LastRet) = 0) do begin LastRet := Result; Result := Result.Parent; end; if Result <> nil then // not root Result := TJclIntegerTreeNode(Result.Children[Result.IndexOfChild(LastRet) - 1]); end; end; //=== { TJclCardinalTreeNode } ======================================================= function TJclCardinalTreeNode.IndexOfChild(AChild: TJclCardinalTreeNode): Integer; begin for Result := 0 to ChildrenCount - 1 do if Children[Result] = AChild then Exit; Result := -1; end; function TJclCardinalTreeNode.IndexOfValue(AValue: Cardinal; const AEqualityComparer: IJclCardinalEqualityComparer): Integer; begin for Result := 0 to ChildrenCount - 1 do if AEqualityComparer.ItemsEqual(TJclCardinalTreeNode(Children[Result]).Value, AValue) then Exit; Result := -1; end; //=== { TJclCardinalTree } ======================================================= constructor TJclCardinalTree.Create(); begin inherited Create(); FTraverseOrder := toPreOrder; end; destructor TJclCardinalTree.Destroy; begin FReadOnly := False; Clear; inherited Destroy; end; function TJclCardinalTree.Add(AValue: Cardinal): Boolean; var NewNode: TJclCardinalTreeNode; begin if ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginWrite; try {$ENDIF THREADSAFE} Result := AllowDefaultElements or not ItemsEqual(AValue, 0); if Result then begin if FRoot <> nil then begin Result := (not Contains(AValue)) or CheckDuplicate; if Result then begin if FRoot.ChildrenCount = Length(FRoot.Children) then SetLength(FRoot.Children, CalcGrowCapacity(Length(FRoot.Children), FRoot.ChildrenCount)); if FRoot.ChildrenCount < Length(FRoot.Children) then begin NewNode := TJclCardinalTreeNode.Create; NewNode.Value := AValue; NewNode.Parent := FRoot; FRoot.Children[FRoot.ChildrenCount] := NewNode; Inc(FRoot.ChildrenCount); Inc(FSize); end else Result := False; end; end else begin FRoot := TJclCardinalTreeNode.Create; FRoot.Value := AValue; Inc(FSize); end; end; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndWrite; end; {$ENDIF THREADSAFE} end; function TJclCardinalTree.AddAll(const ACollection: IJclCardinalCollection): Boolean; var It: IJclCardinalIterator; begin if ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginWrite; try {$ENDIF THREADSAFE} Result := False; if ACollection = nil then Exit; Result := True; It := ACollection.First; while It.HasNext do Result := Add(It.Next) and Result; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndWrite; end; {$ENDIF THREADSAFE} end; procedure TJclCardinalTree.AssignDataTo(Dest: TJclAbstractContainerBase); var ADest: TJclCardinalTree; ACollection: IJclCardinalCollection; begin inherited AssignDataTo(Dest); if Dest is TJclCardinalTree then begin ADest := TJclCardinalTree(Dest); ADest.Clear; ADest.FSize := FSize; if FRoot <> nil then ADest.FRoot := CloneNode(FRoot, nil); end else if Supports(IInterface(Dest), IJclCardinalCollection, ACollection) then begin ACollection.Clear; ACollection.AddAll(Self); end; end; procedure TJclCardinalTree.AssignPropertiesTo(Dest: TJclAbstractContainerBase); begin inherited AssignPropertiesto(Dest); if Dest is TJclCardinalTree then TJclCardinalTree(Dest).FTraverseOrder := FTraverseOrder; end; procedure TJclCardinalTree.Clear; begin if ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginWrite; try {$ENDIF THREADSAFE} if FRoot <> nil then RemoveNode(FRoot); FSize := 0; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndWrite; end; {$ENDIF THREADSAFE} end; function TJclCardinalTree.CloneNode(Node, Parent: TJclCardinalTreeNode): TJclCardinalTreeNode; var Index: Integer; begin Result := TJclCardinalTreeNode.Create; Result.Value := Node.Value; Result.Parent := Parent; SetLength(Result.Children, Node.ChildrenCount); Result.ChildrenCount := Node.ChildrenCount; for Index := 0 to Node.ChildrenCount - 1 do Result.Children[Index] := CloneNode(TJclCardinalTreeNode(Node.Children[Index]), Result); // recursive call end; function TJclCardinalTree.CollectionEquals(const ACollection: IJclCardinalCollection): Boolean; var It, ItSelf: IJclCardinalIterator; begin {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginRead; try {$ENDIF THREADSAFE} Result := False; if ACollection = nil then Exit; if FSize <> ACollection.Size then Exit; Result := True; It := ACollection.First; ItSelf := First; while ItSelf.HasNext do if not ItemsEqual(ItSelf.Next, It.Next) then begin Result := False; Break; end; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndRead; end; {$ENDIF THREADSAFE} end; function TJclCardinalTree.Contains(AValue: Cardinal): Boolean; begin {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginRead; try {$ENDIF THREADSAFE} if FRoot <> nil then Result := NodeContains(FRoot, AValue) else Result := False; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndRead; end; {$ENDIF THREADSAFE} end; function TJclCardinalTree.ContainsAll(const ACollection: IJclCardinalCollection): Boolean; var It: IJclCardinalIterator; begin {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginRead; try {$ENDIF THREADSAFE} Result := True; if ACollection = nil then Exit; It := ACollection.First; while Result and It.HasNext do Result := Contains(It.Next); {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndRead; end; {$ENDIF THREADSAFE} end; function TJclCardinalTree.Extract(AValue: Cardinal): Boolean; var It: IJclCardinalIterator; begin if ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginWrite; try {$ENDIF THREADSAFE} Result := FRoot <> nil; if Result then begin It := First; while It.HasNext do if ItemsEqual(It.Next, AValue) then begin It.Extract; if RemoveSingleElement then Break; end; end; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndWrite; end; {$ENDIF THREADSAFE} end; function TJclCardinalTree.ExtractAll(const ACollection: IJclCardinalCollection): Boolean; var It: IJclCardinalIterator; begin if ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginWrite; try {$ENDIF THREADSAFE} Result := False; if ACollection = nil then Exit; Result := True; It := ACollection.First; while It.HasNext do Result := Extract(It.Next) and Result; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndWrite; end; {$ENDIF THREADSAFE} end; procedure TJclCardinalTree.ExtractNode(var ANode: TJclCardinalTreeNode); var Index, ChildIndex, NewCapacity: Integer; Parent: TJclCardinalTreeNode; begin for Index := ANode.ChildrenCount - 1 downto 0 do {$IFDEF BCB} ExtractNode(TJclCardinalTreeNode(ANode.Children[Index])); {$ELSE ~BCB} ExtractNode(ANode.Children[Index]); {$ENDIF ~BCB} Parent := ANode.Parent; if Parent <> nil then begin ChildIndex := Parent.IndexOfChild(ANode); for Index := ChildIndex + 1 to Parent.ChildrenCount - 1 do Parent.Children[Index - 1] := Parent.Children[Index]; Dec(Parent.ChildrenCount); NewCapacity := CalcPackCapacity(Length(Parent.Children), Parent.ChildrenCount); if NewCapacity < Length(Parent.Children) then SetLength(Parent.Children, NewCapacity); FreeAndNil(ANode); end else begin FreeAndNil(ANode); FRoot := nil; end; Dec(FSize); end; function TJclCardinalTree.First: IJclCardinalIterator; var Start: TJclCardinalTreeNode; begin {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginRead; try {$ENDIF THREADSAFE} Start := FRoot; case GetTraverseOrder of toPreOrder: Result := TJclPreOrderCardinalTreeIterator.Create(Self, Start, False, isFirst); toPostOrder: begin if Start <> nil then while (Start.ChildrenCount > 0) do Start := TJclCardinalTreeNode(Start.Children[0]); Result := TJclPostOrderCardinalTreeIterator.Create(Self, Start, False, isFirst); end; else Result := nil; end; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndRead; end; {$ENDIF THREADSAFE} end; {$IFDEF SUPPORTS_FOR_IN} function TJclCardinalTree.GetEnumerator: IJclCardinalIterator; begin Result := First; end; {$ENDIF SUPPORTS_FOR_IN} function TJclCardinalTree.GetRoot: IJclCardinalTreeIterator; begin {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginRead; try {$ENDIF THREADSAFE} case GetTraverseOrder of toPreOrder: Result := TJclPreOrderCardinalTreeIterator.Create(Self, FRoot, False, isRoot); toPostOrder: Result := TJclPostOrderCardinalTreeIterator.Create(Self, FRoot, False, isRoot); else Result := nil; end; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndRead; end; {$ENDIF THREADSAFE} end; function TJclCardinalTree.GetTraverseOrder: TJclTraverseOrder; begin Result := FTraverseOrder; end; function TJclCardinalTree.IsEmpty: Boolean; begin Result := FSize = 0; end; function TJclCardinalTree.Last: IJclCardinalIterator; var Start: TJclCardinalTreeNode; begin {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginRead; try {$ENDIF THREADSAFE} Start := FRoot; case FTraverseOrder of toPreOrder: begin if Start <> nil then while Start.ChildrenCount > 0 do Start := TJclCardinalTreeNode(Start.Children[Start.ChildrenCount - 1]); Result := TJclPreOrderCardinalTreeIterator.Create(Self, Start, False, isLast); end; toPostOrder: Result := TJclPostOrderCardinalTreeIterator.Create(Self, Start, False, isLast); else Result := nil; end; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndRead; end; {$ENDIF THREADSAFE} end; function TJclCardinalTree.NodeContains(ANode: TJclCardinalTreeNode; AValue: Cardinal): Boolean; var Index: Integer; begin Result := ItemsEqual(ANode.Value, AValue); if not Result then for Index := 0 to ANode.ChildrenCount - 1 do begin Result := NodeContains(TJclCardinalTreeNode(ANode.Children[Index]), AValue); if Result then Break; end; end; procedure TJclCardinalTree.Pack; begin if ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginWrite; try {$ENDIF THREADSAFE} if FRoot <> nil then PackNode(FRoot); {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndWrite; end; {$ENDIF THREADSAFE} end; procedure TJclCardinalTree.PackNode(ANode: TJclCardinalTreeNode); var Index: Integer; begin SetLength(ANode.Children, ANode.ChildrenCount); for Index := 0 to ANode.ChildrenCount - 1 do PackNode(TJclCardinalTreeNode(ANode.Children[Index])); end; function TJclCardinalTree.Remove(AValue: Cardinal): Boolean; var Extracted: Cardinal; begin if ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginWrite; try {$ENDIF THREADSAFE} Result := Extract(AValue); if Result then begin Extracted := AValue; FreeCardinal(Extracted); end; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndWrite; end; {$ENDIF THREADSAFE} end; function TJclCardinalTree.RemoveAll(const ACollection: IJclCardinalCollection): Boolean; var It: IJclCardinalIterator; begin if ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginWrite; try {$ENDIF THREADSAFE} Result := False; if ACollection = nil then Exit; Result := True; It := ACollection.First; while It.HasNext do Result := Remove(It.Next) and Result; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndWrite; end; {$ENDIF THREADSAFE} end; procedure TJclCardinalTree.RemoveNode(var ANode: TJclCardinalTreeNode); var Index, ChildIndex, NewCapacity: Integer; Parent: TJclCardinalTreeNode; begin for Index := ANode.ChildrenCount - 1 downto 0 do {$IFDEF BCB} RemoveNode(TJclCardinalTreeNode(ANode.Children[Index])); {$ELSE ~BCB} RemoveNode(ANode.Children[Index]); {$ENDIF ~BCB} FreeCardinal(ANode.Value); Parent := ANode.Parent; if Parent <> nil then begin ChildIndex := Parent.IndexOfChild(ANode); for Index := ChildIndex + 1 to Parent.ChildrenCount - 1 do Parent.Children[Index - 1] := Parent.Children[Index]; Dec(Parent.ChildrenCount); NewCapacity := CalcPackCapacity(Length(Parent.Children), Parent.ChildrenCount); if NewCapacity < Length(Parent.Children) then SetLength(Parent.Children, NewCapacity); FreeAndNil(ANode); end else begin FreeAndNil(ANode); FRoot := nil; end; Dec(FSize); end; function TJclCardinalTree.RetainAll(const ACollection: IJclCardinalCollection): Boolean; var It: IJclCardinalIterator; begin if ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginWrite; try {$ENDIF THREADSAFE} Result := False; if ACollection = nil then Exit; Result := True; It := First; while It.HasNext do if not ACollection.Contains(It.Next) then It.Remove; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndWrite; end; {$ENDIF THREADSAFE} end; procedure TJclCardinalTree.SetCapacity(Value: Integer); begin raise EJclOperationNotSupportedError.Create; end; procedure TJclCardinalTree.SetTraverseOrder(Value: TJclTraverseOrder); begin FTraverseOrder := Value; end; function TJclCardinalTree.Size: Integer; begin Result := FSize; end; function TJclCardinalTree.CreateEmptyContainer: TJclAbstractContainerBase; begin Result := TJclCardinalTree.Create; AssignPropertiesTo(Result); end; //=== { TJclCardinalTreeIterator } =========================================================== constructor TJclCardinalTreeIterator.Create(OwnTree: TJclCardinalTree; ACursor: TJclCardinalTreeNode; AValid: Boolean; AStart: TItrStart); begin inherited Create(AValid); FCursor := ACursor; FOwnTree := OwnTree; FStart := AStart; FEqualityComparer := OwnTree as IJclCardinalEqualityComparer; end; function TJclCardinalTreeIterator.Add(AValue: Cardinal): Boolean; var ParentNode, NewNode: TJclCardinalTreeNode; begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} // add sibling or, if FCursor is root node, behave like TJclCardinalTree.Add Result := (FCursor <> nil) and (FOwnTree.AllowDefaultElements or not FEqualityComparer.ItemsEqual(AValue, 0)) and ((not FOwnTree.Contains(AValue)) or FOwnTree.CheckDuplicate); if Result then begin ParentNode := FCursor.Parent; if ParentNode = nil then ParentNode := FCursor; if ParentNode.ChildrenCount = Length(ParentNode.Children) then SetLength(ParentNode.Children, FOwnTree.CalcGrowCapacity(Length(ParentNode.Children), ParentNode.ChildrenCount)); if ParentNode.ChildrenCount < Length(ParentNode.Children) then begin NewNode := TJclCardinalTreeNode.Create; NewNode.Value := AValue; NewNode.Parent := ParentNode; ParentNode.Children[ParentNode.ChildrenCount] := NewNode; Inc(ParentNode.ChildrenCount); Inc(FOwnTree.FSize); end; end; {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; function TJclCardinalTreeIterator.AddChild(AValue: Cardinal): Boolean; var NewNode: TJclCardinalTreeNode; begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} Result := (FCursor <> nil) and (FOwnTree.AllowDefaultElements or not FEqualityComparer.ItemsEqual(AValue, 0)) and ((not FOwnTree.Contains(AValue)) or FOwnTree.CheckDuplicate); if Result then begin if FCursor.ChildrenCount = Length(FCursor.Children) then SetLength(FCursor.Children, FOwnTree.CalcGrowCapacity(Length(FCursor.Children), FCursor.ChildrenCount)); if FCursor.ChildrenCount < Length(FCursor.Children) then begin NewNode := TJclCardinalTreeNode.Create; NewNode.Value := AValue; NewNode.Parent := FCursor; FCursor.Children[FCursor.ChildrenCount] := NewNode; Inc(FCursor.ChildrenCount); Inc(FOwnTree.FSize); end; end; {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; procedure TJclCardinalTreeIterator.AssignPropertiesTo(Dest: TJclAbstractIterator); var ADest: TJclCardinalTreeIterator; begin inherited AssignPropertiesTo(Dest); if Dest is TJclCardinalTreeIterator then begin ADest := TJclCardinalTreeIterator(Dest); ADest.FCursor := FCursor; ADest.FOwnTree := FOwnTree; ADest.FEqualityComparer := FEqualityComparer; ADest.FStart := FStart; end; end; function TJclCardinalTreeIterator.ChildrenCount: Integer; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} if FCursor <> nil then Result := FCursor.ChildrenCount else Result := 0; {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; procedure TJclCardinalTreeIterator.DeleteChild(Index: Integer); begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} if (FCursor <> nil) and (Index >= 0) and (Index < FCursor.ChildrenCount) then {$IFDEF BCB} FOwnTree.RemoveNode(TJclCardinalTreeNode(FCursor.Children[Index])) {$ELSE ~BCB} FOwnTree.RemoveNode(FCursor.Children[Index]) {$ENDIF ~BCB} else raise EJclOutOfBoundsError.Create; {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; procedure TJclCardinalTreeIterator.DeleteChildren; var Index: Integer; begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} if FCursor <> nil then begin for Index := FCursor.ChildrenCount - 1 downto 0 do {$IFDEF BCB} FOwnTree.RemoveNode(TJclCardinalTreeNode(FCursor.Children[Index])); {$ELSE ~BCB} FOwnTree.RemoveNode(FCursor.Children[Index]); {$ENDIF ~BCB} SetLength(FCursor.Children, 0); FCursor.ChildrenCount := 0; end; {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; procedure TJclCardinalTreeIterator.Extract; var OldCursor: TJclCardinalTreeNode; begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} CheckValid; Valid := False; OldCursor := FCursor; FCursor := GetNextSibling; if OldCursor <> nil then FOwnTree.ExtractNode(OldCursor); {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; procedure TJclCardinalTreeIterator.ExtractChild(Index: Integer); begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} if (FCursor <> nil) and (Index >= 0) and (Index < FCursor.ChildrenCount) then {$IFDEF BCB} FOwnTree.ExtractNode(TJclCardinalTreeNode(FCursor.Children[Index])) {$ELSE ~BCB} FOwnTree.ExtractNode(FCursor.Children[Index]) {$ENDIF ~BCB} else raise EJclOutOfBoundsError.Create; {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; procedure TJclCardinalTreeIterator.ExtractChildren; var Index: Integer; begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} if FCursor <> nil then begin for Index := FCursor.ChildrenCount - 1 downto 0 do {$IFDEF BCB} FOwnTree.ExtractNode(TJclCardinalTreeNode(FCursor.Children[Index])); {$ELSE ~BCB} FOwnTree.ExtractNode(FCursor.Children[Index]); {$ENDIF ~BCB} SetLength(FCursor.Children, 0); FCursor.ChildrenCount := 0; end; {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; function TJclCardinalTreeIterator.GetChild(Index: Integer): Cardinal; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} Result := 0; if (FCursor <> nil) and (Index >= 0) and (Index < FCursor.ChildrenCount) then FCursor := TJclCardinalTreeNode(FCursor.Children[Index]); if FCursor <> nil then Result := FCursor.Value else if not FOwnTree.ReturnDefaultElements then raise EJclNoSuchElementError.Create(''); {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; function TJclCardinalTreeIterator.GetValue: Cardinal; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} CheckValid; Result := 0; if FCursor <> nil then Result := FCursor.Value else if not FOwnTree.ReturnDefaultElements then raise EJclNoSuchElementError.Create(''); {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; function TJclCardinalTreeIterator.HasChild(Index: Integer): Boolean; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} Result := (FCursor <> nil) and (Index >= 0) and (Index < FCursor.ChildrenCount); {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; function TJclCardinalTreeIterator.HasNext: Boolean; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} if Valid then Result := GetNextCursor <> nil else Result := FCursor <> nil; {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; function TJclCardinalTreeIterator.HasParent: Boolean; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} Result := (FCursor <> nil) and (FCursor.Parent <> nil); {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; function TJclCardinalTreeIterator.HasPrevious: Boolean; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} if Valid then Result := GetPreviousCursor <> nil else Result := FCursor <> nil; {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; function TJclCardinalTreeIterator.IndexOfChild(AValue: Cardinal): Integer; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} if FCursor <> nil then Result := FCursor.IndexOfValue(AValue, FEqualityComparer) else Result := -1; {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; function TJclCardinalTreeIterator.Insert(AValue: Cardinal): Boolean; var ParentNode, NewNode: TJclCardinalTreeNode; Index, I: Integer; begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} // insert sibling or, if FCursor is root node, behave like TJclCardinalTree.Insert Result := (FCursor <> nil) and (FOwnTree.AllowDefaultElements or not FEqualityComparer.ItemsEqual(AValue, 0)) and ((not FOwnTree.Contains(AValue)) or FOwnTree.CheckDuplicate); if Result then begin if FCursor.Parent <> nil then begin ParentNode := FCursor.Parent; Index := 0; while (Index < ParentNode.ChildrenCount) and (ParentNode.Children[Index] <> FCursor) do Inc(Index); end else begin ParentNode := FCursor; Index := 0; end; if ParentNode.ChildrenCount = Length(ParentNode.Children) then SetLength(ParentNode.Children, FOwnTree.CalcGrowCapacity(Length(ParentNode.Children), ParentNode.ChildrenCount)); if ParentNode.ChildrenCount < Length(ParentNode.Children) then begin NewNode := TJclCardinalTreeNode.Create; NewNode.Value := AValue; NewNode.Parent := ParentNode; for I := ParentNode.ChildrenCount - 1 downto Index do ParentNode.Children[I + 1] := ParentNode.Children[I]; ParentNode.Children[Index] := NewNode; Inc(ParentNode.ChildrenCount); Inc(FOwnTree.FSize); end; end; {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; function TJclCardinalTreeIterator.InsertChild(Index: Integer; AValue: Cardinal): Boolean; var NewNode: TJclCardinalTreeNode; I: Integer; begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} // insert sibling or, if FCursor is root node, behave like TJclCardinalTree.Insert Result := (FCursor <> nil) and (FOwnTree.AllowDefaultElements or not FEqualityComparer.ItemsEqual(AValue, 0)) and ((not FOwnTree.Contains(AValue)) or FOwnTree.CheckDuplicate); if Result then begin if FCursor.ChildrenCount = Length(FCursor.Children) then SetLength(FCursor.Children, FOwnTree.CalcGrowCapacity(Length(FCursor.Children), FCursor.ChildrenCount)); if FCursor.ChildrenCount < Length(FCursor.Children) then begin NewNode := TJclCardinalTreeNode.Create; NewNode.Value := AValue; NewNode.Parent := FCursor; for I := FCursor.ChildrenCount - 1 downto Index do FCursor.Children[I + 1] := FCursor.Children[I]; FCursor.Children[Index] := NewNode; Inc(FCursor.ChildrenCount); Inc(FOwnTree.FSize); end; end; {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; function TJclCardinalTreeIterator.IteratorEquals(const AIterator: IJclCardinalIterator): Boolean; var Obj: TObject; ItrObj: TJclCardinalTreeIterator; begin Result := False; if AIterator = nil then Exit; Obj := AIterator.GetIteratorReference; if Obj is TJclCardinalTreeIterator then begin ItrObj := TJclCardinalTreeIterator(Obj); Result := (FOwnTree = ItrObj.FOwnTree) and (FCursor = ItrObj.FCursor) and (Valid = ItrObj.Valid); end; end; {$IFDEF SUPPORTS_FOR_IN} function TJclCardinalTreeIterator.MoveNext: Boolean; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} if Valid then FCursor := GetNextCursor else Valid := True; Result := FCursor <> nil; {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; {$ENDIF SUPPORTS_FOR_IN} function TJclCardinalTreeIterator.Next: Cardinal; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} if Valid then FCursor := GetNextCursor else Valid := True; Result := 0; if FCursor <> nil then Result := FCursor.Value else if not FOwnTree.ReturnDefaultElements then raise EJclNoSuchElementError.Create(''); {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; function TJclCardinalTreeIterator.NextIndex: Integer; begin // No index raise EJclOperationNotSupportedError.Create; end; function TJclCardinalTreeIterator.Parent: Cardinal; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} Result := 0; if FCursor <> nil then FCursor := FCursor.Parent; if FCursor <> nil then Result := FCursor.Value else if not FOwnTree.ReturnDefaultElements then raise EJclNoSuchElementError.Create(''); {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; function TJclCardinalTreeIterator.Previous: Cardinal; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} if Valid then FCursor := GetPreviousCursor else Valid := True; Result := 0; if FCursor <> nil then Result := FCursor.Value else if not FOwnTree.ReturnDefaultElements then raise EJclNoSuchElementError.Create(''); {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; function TJclCardinalTreeIterator.PreviousIndex: Integer; begin // No index raise EJclOperationNotSupportedError.Create; end; procedure TJclCardinalTreeIterator.Remove; var OldCursor: TJclCardinalTreeNode; begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} CheckValid; Valid := False; OldCursor := FCursor; FCursor := GetNextSibling; if OldCursor <> nil then FOwnTree.RemoveNode(OldCursor); {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; procedure TJclCardinalTreeIterator.Reset; var NewCursor: TJclCardinalTreeNode; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} Valid := False; case FStart of isFirst: begin NewCursor := FCursor; while NewCursor <> nil do begin NewCursor := GetPreviousCursor; if NewCursor <> nil then FCursor := NewCursor; end; end; isLast: begin NewCursor := FCursor; while NewCursor <> nil do begin NewCursor := GetNextCursor; if NewCursor <> nil then FCursor := NewCursor; end; end; isRoot: begin while (FCursor <> nil) and (FCursor.Parent <> nil) do FCursor := FCursor.Parent; end; end; {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; procedure TJclCardinalTreeIterator.SetChild(Index: Integer; AValue: Cardinal); begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} if (FCursor <> nil) and (Index >= 0) and (Index < FCursor.ChildrenCount) then TJclCardinalTreeNode(FCursor.Children[Index]).Value := AValue else raise EJclOutOfBoundsError.Create; {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; procedure TJclCardinalTreeIterator.SetValue(AValue: Cardinal); begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} CheckValid; if FCursor <> nil then begin FOwnTree.FreeCardinal(FCursor.Value); FCursor.Value := AValue; end; {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; //=== { TJclPreOrderCardinalTreeIterator } =================================================== function TJclPreOrderCardinalTreeIterator.CreateEmptyIterator: TJclAbstractIterator; begin Result := TJclPreOrderCardinalTreeIterator.Create(FOwnTree, FCursor, Valid, FStart); end; function TJclPreOrderCardinalTreeIterator.GetNextCursor: TJclCardinalTreeNode; var LastRet: TJclCardinalTreeNode; begin Result := FCursor; if Result = nil then Exit; LastRet := Result; if Result.ChildrenCount > 0 then Result := TJclCardinalTreeNode(Result.Children[0]) else begin Result := Result.Parent; while (Result <> nil) and (Result.IndexOfChild(LastRet) = (Result.ChildrenCount - 1)) do begin LastRet := Result; Result := Result.Parent; end; if Result <> nil then // not root = return successor Result := TJclCardinalTreeNode(Result.Children[Result.IndexOfChild(LastRet) + 1]); end; end; function TJclPreOrderCardinalTreeIterator.GetNextSibling: TJclCardinalTreeNode; var LastRet: TJclCardinalTreeNode; begin Result := FCursor; if Result = nil then Exit; LastRet := Result; Result := Result.Parent; while (Result <> nil) and (Result.IndexOfChild(LastRet) = (Result.ChildrenCount - 1)) do begin LastRet := Result; Result := Result.Parent; end; if Result <> nil then // not root = return successor Result := TJclCardinalTreeNode(Result.Children[Result.IndexOfChild(LastRet) + 1]); end; function TJclPreOrderCardinalTreeIterator.GetPreviousCursor: TJclCardinalTreeNode; var LastRet: TJclCardinalTreeNode; begin Result := FCursor; if Result = nil then Exit; LastRet := Result; Result := Result.Parent; if (Result <> nil) and (Result.IndexOfChild(LastRet) > 0) then // come from Right begin Result := TJclCardinalTreeNode(Result.Children[Result.IndexOfChild(LastRet) - 1]); while (Result.ChildrenCount > 0) do // descend down the tree Result := TJclCardinalTreeNode(Result.Children[Result.ChildrenCount - 1]); end; end; //=== { TJclPostOrderCardinalTreeIterator } ================================================== function TJclPostOrderCardinalTreeIterator.CreateEmptyIterator: TJclAbstractIterator; begin Result := TJclPostOrderCardinalTreeIterator.Create(FOwnTree, FCursor, Valid, FStart); end; function TJclPostOrderCardinalTreeIterator.GetNextCursor: TJclCardinalTreeNode; var LastRet: TJclCardinalTreeNode; begin Result := FCursor; if Result = nil then Exit; LastRet := Result; Result := Result.Parent; if (Result <> nil) and (Result.IndexOfChild(LastRet) <> (Result.ChildrenCount - 1)) then begin Result := TJclCardinalTreeNode(Result.Children[Result.IndexOfChild(LastRet) + 1]); while Result.ChildrenCount > 0 do Result := TJclCardinalTreeNode(Result.Children[0]); end; end; function TJclPostOrderCardinalTreeIterator.GetNextSibling: TJclCardinalTreeNode; var LastRet: TJclCardinalTreeNode; begin Result := FCursor; if Result = nil then Exit; LastRet := Result; Result := Result.Parent; if (Result <> nil) and (Result.IndexOfChild(LastRet) <> (Result.ChildrenCount - 1)) then begin Result := TJclCardinalTreeNode(Result.Children[Result.IndexOfChild(LastRet) + 1]); while Result.ChildrenCount > 0 do Result := TJclCardinalTreeNode(Result.Children[0]); end; end; function TJclPostOrderCardinalTreeIterator.GetPreviousCursor: TJclCardinalTreeNode; var LastRet: TJclCardinalTreeNode; begin Result := FCursor; if Result = nil then Exit; if Result.ChildrenCount > 0 then Result := TJclCardinalTreeNode(Result.Children[Result.ChildrenCount - 1]) else begin LastRet := Result; Result := Result.Parent; while (Result <> nil) and (Result.IndexOfChild(LastRet) = 0) do begin LastRet := Result; Result := Result.Parent; end; if Result <> nil then // not root Result := TJclCardinalTreeNode(Result.Children[Result.IndexOfChild(LastRet) - 1]); end; end; //=== { TJclInt64TreeNode } ======================================================= function TJclInt64TreeNode.IndexOfChild(AChild: TJclInt64TreeNode): Integer; begin for Result := 0 to ChildrenCount - 1 do if Children[Result] = AChild then Exit; Result := -1; end; function TJclInt64TreeNode.IndexOfValue(const AValue: Int64; const AEqualityComparer: IJclInt64EqualityComparer): Integer; begin for Result := 0 to ChildrenCount - 1 do if AEqualityComparer.ItemsEqual(TJclInt64TreeNode(Children[Result]).Value, AValue) then Exit; Result := -1; end; //=== { TJclInt64Tree } ======================================================= constructor TJclInt64Tree.Create(); begin inherited Create(); FTraverseOrder := toPreOrder; end; destructor TJclInt64Tree.Destroy; begin FReadOnly := False; Clear; inherited Destroy; end; function TJclInt64Tree.Add(const AValue: Int64): Boolean; var NewNode: TJclInt64TreeNode; begin if ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginWrite; try {$ENDIF THREADSAFE} Result := AllowDefaultElements or not ItemsEqual(AValue, 0); if Result then begin if FRoot <> nil then begin Result := (not Contains(AValue)) or CheckDuplicate; if Result then begin if FRoot.ChildrenCount = Length(FRoot.Children) then SetLength(FRoot.Children, CalcGrowCapacity(Length(FRoot.Children), FRoot.ChildrenCount)); if FRoot.ChildrenCount < Length(FRoot.Children) then begin NewNode := TJclInt64TreeNode.Create; NewNode.Value := AValue; NewNode.Parent := FRoot; FRoot.Children[FRoot.ChildrenCount] := NewNode; Inc(FRoot.ChildrenCount); Inc(FSize); end else Result := False; end; end else begin FRoot := TJclInt64TreeNode.Create; FRoot.Value := AValue; Inc(FSize); end; end; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndWrite; end; {$ENDIF THREADSAFE} end; function TJclInt64Tree.AddAll(const ACollection: IJclInt64Collection): Boolean; var It: IJclInt64Iterator; begin if ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginWrite; try {$ENDIF THREADSAFE} Result := False; if ACollection = nil then Exit; Result := True; It := ACollection.First; while It.HasNext do Result := Add(It.Next) and Result; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndWrite; end; {$ENDIF THREADSAFE} end; procedure TJclInt64Tree.AssignDataTo(Dest: TJclAbstractContainerBase); var ADest: TJclInt64Tree; ACollection: IJclInt64Collection; begin inherited AssignDataTo(Dest); if Dest is TJclInt64Tree then begin ADest := TJclInt64Tree(Dest); ADest.Clear; ADest.FSize := FSize; if FRoot <> nil then ADest.FRoot := CloneNode(FRoot, nil); end else if Supports(IInterface(Dest), IJclInt64Collection, ACollection) then begin ACollection.Clear; ACollection.AddAll(Self); end; end; procedure TJclInt64Tree.AssignPropertiesTo(Dest: TJclAbstractContainerBase); begin inherited AssignPropertiesto(Dest); if Dest is TJclInt64Tree then TJclInt64Tree(Dest).FTraverseOrder := FTraverseOrder; end; procedure TJclInt64Tree.Clear; begin if ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginWrite; try {$ENDIF THREADSAFE} if FRoot <> nil then RemoveNode(FRoot); FSize := 0; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndWrite; end; {$ENDIF THREADSAFE} end; function TJclInt64Tree.CloneNode(Node, Parent: TJclInt64TreeNode): TJclInt64TreeNode; var Index: Integer; begin Result := TJclInt64TreeNode.Create; Result.Value := Node.Value; Result.Parent := Parent; SetLength(Result.Children, Node.ChildrenCount); Result.ChildrenCount := Node.ChildrenCount; for Index := 0 to Node.ChildrenCount - 1 do Result.Children[Index] := CloneNode(TJclInt64TreeNode(Node.Children[Index]), Result); // recursive call end; function TJclInt64Tree.CollectionEquals(const ACollection: IJclInt64Collection): Boolean; var It, ItSelf: IJclInt64Iterator; begin {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginRead; try {$ENDIF THREADSAFE} Result := False; if ACollection = nil then Exit; if FSize <> ACollection.Size then Exit; Result := True; It := ACollection.First; ItSelf := First; while ItSelf.HasNext do if not ItemsEqual(ItSelf.Next, It.Next) then begin Result := False; Break; end; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndRead; end; {$ENDIF THREADSAFE} end; function TJclInt64Tree.Contains(const AValue: Int64): Boolean; begin {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginRead; try {$ENDIF THREADSAFE} if FRoot <> nil then Result := NodeContains(FRoot, AValue) else Result := False; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndRead; end; {$ENDIF THREADSAFE} end; function TJclInt64Tree.ContainsAll(const ACollection: IJclInt64Collection): Boolean; var It: IJclInt64Iterator; begin {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginRead; try {$ENDIF THREADSAFE} Result := True; if ACollection = nil then Exit; It := ACollection.First; while Result and It.HasNext do Result := Contains(It.Next); {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndRead; end; {$ENDIF THREADSAFE} end; function TJclInt64Tree.Extract(const AValue: Int64): Boolean; var It: IJclInt64Iterator; begin if ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginWrite; try {$ENDIF THREADSAFE} Result := FRoot <> nil; if Result then begin It := First; while It.HasNext do if ItemsEqual(It.Next, AValue) then begin It.Extract; if RemoveSingleElement then Break; end; end; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndWrite; end; {$ENDIF THREADSAFE} end; function TJclInt64Tree.ExtractAll(const ACollection: IJclInt64Collection): Boolean; var It: IJclInt64Iterator; begin if ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginWrite; try {$ENDIF THREADSAFE} Result := False; if ACollection = nil then Exit; Result := True; It := ACollection.First; while It.HasNext do Result := Extract(It.Next) and Result; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndWrite; end; {$ENDIF THREADSAFE} end; procedure TJclInt64Tree.ExtractNode(var ANode: TJclInt64TreeNode); var Index, ChildIndex, NewCapacity: Integer; Parent: TJclInt64TreeNode; begin for Index := ANode.ChildrenCount - 1 downto 0 do {$IFDEF BCB} ExtractNode(TJclInt64TreeNode(ANode.Children[Index])); {$ELSE ~BCB} ExtractNode(ANode.Children[Index]); {$ENDIF ~BCB} Parent := ANode.Parent; if Parent <> nil then begin ChildIndex := Parent.IndexOfChild(ANode); for Index := ChildIndex + 1 to Parent.ChildrenCount - 1 do Parent.Children[Index - 1] := Parent.Children[Index]; Dec(Parent.ChildrenCount); NewCapacity := CalcPackCapacity(Length(Parent.Children), Parent.ChildrenCount); if NewCapacity < Length(Parent.Children) then SetLength(Parent.Children, NewCapacity); FreeAndNil(ANode); end else begin FreeAndNil(ANode); FRoot := nil; end; Dec(FSize); end; function TJclInt64Tree.First: IJclInt64Iterator; var Start: TJclInt64TreeNode; begin {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginRead; try {$ENDIF THREADSAFE} Start := FRoot; case GetTraverseOrder of toPreOrder: Result := TJclPreOrderInt64TreeIterator.Create(Self, Start, False, isFirst); toPostOrder: begin if Start <> nil then while (Start.ChildrenCount > 0) do Start := TJclInt64TreeNode(Start.Children[0]); Result := TJclPostOrderInt64TreeIterator.Create(Self, Start, False, isFirst); end; else Result := nil; end; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndRead; end; {$ENDIF THREADSAFE} end; {$IFDEF SUPPORTS_FOR_IN} function TJclInt64Tree.GetEnumerator: IJclInt64Iterator; begin Result := First; end; {$ENDIF SUPPORTS_FOR_IN} function TJclInt64Tree.GetRoot: IJclInt64TreeIterator; begin {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginRead; try {$ENDIF THREADSAFE} case GetTraverseOrder of toPreOrder: Result := TJclPreOrderInt64TreeIterator.Create(Self, FRoot, False, isRoot); toPostOrder: Result := TJclPostOrderInt64TreeIterator.Create(Self, FRoot, False, isRoot); else Result := nil; end; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndRead; end; {$ENDIF THREADSAFE} end; function TJclInt64Tree.GetTraverseOrder: TJclTraverseOrder; begin Result := FTraverseOrder; end; function TJclInt64Tree.IsEmpty: Boolean; begin Result := FSize = 0; end; function TJclInt64Tree.Last: IJclInt64Iterator; var Start: TJclInt64TreeNode; begin {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginRead; try {$ENDIF THREADSAFE} Start := FRoot; case FTraverseOrder of toPreOrder: begin if Start <> nil then while Start.ChildrenCount > 0 do Start := TJclInt64TreeNode(Start.Children[Start.ChildrenCount - 1]); Result := TJclPreOrderInt64TreeIterator.Create(Self, Start, False, isLast); end; toPostOrder: Result := TJclPostOrderInt64TreeIterator.Create(Self, Start, False, isLast); else Result := nil; end; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndRead; end; {$ENDIF THREADSAFE} end; function TJclInt64Tree.NodeContains(ANode: TJclInt64TreeNode; const AValue: Int64): Boolean; var Index: Integer; begin Result := ItemsEqual(ANode.Value, AValue); if not Result then for Index := 0 to ANode.ChildrenCount - 1 do begin Result := NodeContains(TJclInt64TreeNode(ANode.Children[Index]), AValue); if Result then Break; end; end; procedure TJclInt64Tree.Pack; begin if ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginWrite; try {$ENDIF THREADSAFE} if FRoot <> nil then PackNode(FRoot); {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndWrite; end; {$ENDIF THREADSAFE} end; procedure TJclInt64Tree.PackNode(ANode: TJclInt64TreeNode); var Index: Integer; begin SetLength(ANode.Children, ANode.ChildrenCount); for Index := 0 to ANode.ChildrenCount - 1 do PackNode(TJclInt64TreeNode(ANode.Children[Index])); end; function TJclInt64Tree.Remove(const AValue: Int64): Boolean; var Extracted: Int64; begin if ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginWrite; try {$ENDIF THREADSAFE} Result := Extract(AValue); if Result then begin Extracted := AValue; FreeInt64(Extracted); end; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndWrite; end; {$ENDIF THREADSAFE} end; function TJclInt64Tree.RemoveAll(const ACollection: IJclInt64Collection): Boolean; var It: IJclInt64Iterator; begin if ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginWrite; try {$ENDIF THREADSAFE} Result := False; if ACollection = nil then Exit; Result := True; It := ACollection.First; while It.HasNext do Result := Remove(It.Next) and Result; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndWrite; end; {$ENDIF THREADSAFE} end; procedure TJclInt64Tree.RemoveNode(var ANode: TJclInt64TreeNode); var Index, ChildIndex, NewCapacity: Integer; Parent: TJclInt64TreeNode; begin for Index := ANode.ChildrenCount - 1 downto 0 do {$IFDEF BCB} RemoveNode(TJclInt64TreeNode(ANode.Children[Index])); {$ELSE ~BCB} RemoveNode(ANode.Children[Index]); {$ENDIF ~BCB} FreeInt64(ANode.Value); Parent := ANode.Parent; if Parent <> nil then begin ChildIndex := Parent.IndexOfChild(ANode); for Index := ChildIndex + 1 to Parent.ChildrenCount - 1 do Parent.Children[Index - 1] := Parent.Children[Index]; Dec(Parent.ChildrenCount); NewCapacity := CalcPackCapacity(Length(Parent.Children), Parent.ChildrenCount); if NewCapacity < Length(Parent.Children) then SetLength(Parent.Children, NewCapacity); FreeAndNil(ANode); end else begin FreeAndNil(ANode); FRoot := nil; end; Dec(FSize); end; function TJclInt64Tree.RetainAll(const ACollection: IJclInt64Collection): Boolean; var It: IJclInt64Iterator; begin if ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginWrite; try {$ENDIF THREADSAFE} Result := False; if ACollection = nil then Exit; Result := True; It := First; while It.HasNext do if not ACollection.Contains(It.Next) then It.Remove; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndWrite; end; {$ENDIF THREADSAFE} end; procedure TJclInt64Tree.SetCapacity(Value: Integer); begin raise EJclOperationNotSupportedError.Create; end; procedure TJclInt64Tree.SetTraverseOrder(Value: TJclTraverseOrder); begin FTraverseOrder := Value; end; function TJclInt64Tree.Size: Integer; begin Result := FSize; end; function TJclInt64Tree.CreateEmptyContainer: TJclAbstractContainerBase; begin Result := TJclInt64Tree.Create; AssignPropertiesTo(Result); end; //=== { TJclInt64TreeIterator } =========================================================== constructor TJclInt64TreeIterator.Create(OwnTree: TJclInt64Tree; ACursor: TJclInt64TreeNode; AValid: Boolean; AStart: TItrStart); begin inherited Create(AValid); FCursor := ACursor; FOwnTree := OwnTree; FStart := AStart; FEqualityComparer := OwnTree as IJclInt64EqualityComparer; end; function TJclInt64TreeIterator.Add(const AValue: Int64): Boolean; var ParentNode, NewNode: TJclInt64TreeNode; begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} // add sibling or, if FCursor is root node, behave like TJclInt64Tree.Add Result := (FCursor <> nil) and (FOwnTree.AllowDefaultElements or not FEqualityComparer.ItemsEqual(AValue, 0)) and ((not FOwnTree.Contains(AValue)) or FOwnTree.CheckDuplicate); if Result then begin ParentNode := FCursor.Parent; if ParentNode = nil then ParentNode := FCursor; if ParentNode.ChildrenCount = Length(ParentNode.Children) then SetLength(ParentNode.Children, FOwnTree.CalcGrowCapacity(Length(ParentNode.Children), ParentNode.ChildrenCount)); if ParentNode.ChildrenCount < Length(ParentNode.Children) then begin NewNode := TJclInt64TreeNode.Create; NewNode.Value := AValue; NewNode.Parent := ParentNode; ParentNode.Children[ParentNode.ChildrenCount] := NewNode; Inc(ParentNode.ChildrenCount); Inc(FOwnTree.FSize); end; end; {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; function TJclInt64TreeIterator.AddChild(const AValue: Int64): Boolean; var NewNode: TJclInt64TreeNode; begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} Result := (FCursor <> nil) and (FOwnTree.AllowDefaultElements or not FEqualityComparer.ItemsEqual(AValue, 0)) and ((not FOwnTree.Contains(AValue)) or FOwnTree.CheckDuplicate); if Result then begin if FCursor.ChildrenCount = Length(FCursor.Children) then SetLength(FCursor.Children, FOwnTree.CalcGrowCapacity(Length(FCursor.Children), FCursor.ChildrenCount)); if FCursor.ChildrenCount < Length(FCursor.Children) then begin NewNode := TJclInt64TreeNode.Create; NewNode.Value := AValue; NewNode.Parent := FCursor; FCursor.Children[FCursor.ChildrenCount] := NewNode; Inc(FCursor.ChildrenCount); Inc(FOwnTree.FSize); end; end; {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; procedure TJclInt64TreeIterator.AssignPropertiesTo(Dest: TJclAbstractIterator); var ADest: TJclInt64TreeIterator; begin inherited AssignPropertiesTo(Dest); if Dest is TJclInt64TreeIterator then begin ADest := TJclInt64TreeIterator(Dest); ADest.FCursor := FCursor; ADest.FOwnTree := FOwnTree; ADest.FEqualityComparer := FEqualityComparer; ADest.FStart := FStart; end; end; function TJclInt64TreeIterator.ChildrenCount: Integer; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} if FCursor <> nil then Result := FCursor.ChildrenCount else Result := 0; {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; procedure TJclInt64TreeIterator.DeleteChild(Index: Integer); begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} if (FCursor <> nil) and (Index >= 0) and (Index < FCursor.ChildrenCount) then {$IFDEF BCB} FOwnTree.RemoveNode(TJclInt64TreeNode(FCursor.Children[Index])) {$ELSE ~BCB} FOwnTree.RemoveNode(FCursor.Children[Index]) {$ENDIF ~BCB} else raise EJclOutOfBoundsError.Create; {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; procedure TJclInt64TreeIterator.DeleteChildren; var Index: Integer; begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} if FCursor <> nil then begin for Index := FCursor.ChildrenCount - 1 downto 0 do {$IFDEF BCB} FOwnTree.RemoveNode(TJclInt64TreeNode(FCursor.Children[Index])); {$ELSE ~BCB} FOwnTree.RemoveNode(FCursor.Children[Index]); {$ENDIF ~BCB} SetLength(FCursor.Children, 0); FCursor.ChildrenCount := 0; end; {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; procedure TJclInt64TreeIterator.Extract; var OldCursor: TJclInt64TreeNode; begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} CheckValid; Valid := False; OldCursor := FCursor; FCursor := GetNextSibling; if OldCursor <> nil then FOwnTree.ExtractNode(OldCursor); {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; procedure TJclInt64TreeIterator.ExtractChild(Index: Integer); begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} if (FCursor <> nil) and (Index >= 0) and (Index < FCursor.ChildrenCount) then {$IFDEF BCB} FOwnTree.ExtractNode(TJclInt64TreeNode(FCursor.Children[Index])) {$ELSE ~BCB} FOwnTree.ExtractNode(FCursor.Children[Index]) {$ENDIF ~BCB} else raise EJclOutOfBoundsError.Create; {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; procedure TJclInt64TreeIterator.ExtractChildren; var Index: Integer; begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} if FCursor <> nil then begin for Index := FCursor.ChildrenCount - 1 downto 0 do {$IFDEF BCB} FOwnTree.ExtractNode(TJclInt64TreeNode(FCursor.Children[Index])); {$ELSE ~BCB} FOwnTree.ExtractNode(FCursor.Children[Index]); {$ENDIF ~BCB} SetLength(FCursor.Children, 0); FCursor.ChildrenCount := 0; end; {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; function TJclInt64TreeIterator.GetChild(Index: Integer): Int64; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} Result := 0; if (FCursor <> nil) and (Index >= 0) and (Index < FCursor.ChildrenCount) then FCursor := TJclInt64TreeNode(FCursor.Children[Index]); if FCursor <> nil then Result := FCursor.Value else if not FOwnTree.ReturnDefaultElements then raise EJclNoSuchElementError.Create(''); {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; function TJclInt64TreeIterator.GetValue: Int64; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} CheckValid; Result := 0; if FCursor <> nil then Result := FCursor.Value else if not FOwnTree.ReturnDefaultElements then raise EJclNoSuchElementError.Create(''); {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; function TJclInt64TreeIterator.HasChild(Index: Integer): Boolean; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} Result := (FCursor <> nil) and (Index >= 0) and (Index < FCursor.ChildrenCount); {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; function TJclInt64TreeIterator.HasNext: Boolean; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} if Valid then Result := GetNextCursor <> nil else Result := FCursor <> nil; {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; function TJclInt64TreeIterator.HasParent: Boolean; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} Result := (FCursor <> nil) and (FCursor.Parent <> nil); {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; function TJclInt64TreeIterator.HasPrevious: Boolean; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} if Valid then Result := GetPreviousCursor <> nil else Result := FCursor <> nil; {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; function TJclInt64TreeIterator.IndexOfChild(const AValue: Int64): Integer; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} if FCursor <> nil then Result := FCursor.IndexOfValue(AValue, FEqualityComparer) else Result := -1; {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; function TJclInt64TreeIterator.Insert(const AValue: Int64): Boolean; var ParentNode, NewNode: TJclInt64TreeNode; Index, I: Integer; begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} // insert sibling or, if FCursor is root node, behave like TJclInt64Tree.Insert Result := (FCursor <> nil) and (FOwnTree.AllowDefaultElements or not FEqualityComparer.ItemsEqual(AValue, 0)) and ((not FOwnTree.Contains(AValue)) or FOwnTree.CheckDuplicate); if Result then begin if FCursor.Parent <> nil then begin ParentNode := FCursor.Parent; Index := 0; while (Index < ParentNode.ChildrenCount) and (ParentNode.Children[Index] <> FCursor) do Inc(Index); end else begin ParentNode := FCursor; Index := 0; end; if ParentNode.ChildrenCount = Length(ParentNode.Children) then SetLength(ParentNode.Children, FOwnTree.CalcGrowCapacity(Length(ParentNode.Children), ParentNode.ChildrenCount)); if ParentNode.ChildrenCount < Length(ParentNode.Children) then begin NewNode := TJclInt64TreeNode.Create; NewNode.Value := AValue; NewNode.Parent := ParentNode; for I := ParentNode.ChildrenCount - 1 downto Index do ParentNode.Children[I + 1] := ParentNode.Children[I]; ParentNode.Children[Index] := NewNode; Inc(ParentNode.ChildrenCount); Inc(FOwnTree.FSize); end; end; {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; function TJclInt64TreeIterator.InsertChild(Index: Integer; const AValue: Int64): Boolean; var NewNode: TJclInt64TreeNode; I: Integer; begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} // insert sibling or, if FCursor is root node, behave like TJclInt64Tree.Insert Result := (FCursor <> nil) and (FOwnTree.AllowDefaultElements or not FEqualityComparer.ItemsEqual(AValue, 0)) and ((not FOwnTree.Contains(AValue)) or FOwnTree.CheckDuplicate); if Result then begin if FCursor.ChildrenCount = Length(FCursor.Children) then SetLength(FCursor.Children, FOwnTree.CalcGrowCapacity(Length(FCursor.Children), FCursor.ChildrenCount)); if FCursor.ChildrenCount < Length(FCursor.Children) then begin NewNode := TJclInt64TreeNode.Create; NewNode.Value := AValue; NewNode.Parent := FCursor; for I := FCursor.ChildrenCount - 1 downto Index do FCursor.Children[I + 1] := FCursor.Children[I]; FCursor.Children[Index] := NewNode; Inc(FCursor.ChildrenCount); Inc(FOwnTree.FSize); end; end; {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; function TJclInt64TreeIterator.IteratorEquals(const AIterator: IJclInt64Iterator): Boolean; var Obj: TObject; ItrObj: TJclInt64TreeIterator; begin Result := False; if AIterator = nil then Exit; Obj := AIterator.GetIteratorReference; if Obj is TJclInt64TreeIterator then begin ItrObj := TJclInt64TreeIterator(Obj); Result := (FOwnTree = ItrObj.FOwnTree) and (FCursor = ItrObj.FCursor) and (Valid = ItrObj.Valid); end; end; {$IFDEF SUPPORTS_FOR_IN} function TJclInt64TreeIterator.MoveNext: Boolean; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} if Valid then FCursor := GetNextCursor else Valid := True; Result := FCursor <> nil; {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; {$ENDIF SUPPORTS_FOR_IN} function TJclInt64TreeIterator.Next: Int64; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} if Valid then FCursor := GetNextCursor else Valid := True; Result := 0; if FCursor <> nil then Result := FCursor.Value else if not FOwnTree.ReturnDefaultElements then raise EJclNoSuchElementError.Create(''); {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; function TJclInt64TreeIterator.NextIndex: Integer; begin // No index raise EJclOperationNotSupportedError.Create; end; function TJclInt64TreeIterator.Parent: Int64; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} Result := 0; if FCursor <> nil then FCursor := FCursor.Parent; if FCursor <> nil then Result := FCursor.Value else if not FOwnTree.ReturnDefaultElements then raise EJclNoSuchElementError.Create(''); {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; function TJclInt64TreeIterator.Previous: Int64; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} if Valid then FCursor := GetPreviousCursor else Valid := True; Result := 0; if FCursor <> nil then Result := FCursor.Value else if not FOwnTree.ReturnDefaultElements then raise EJclNoSuchElementError.Create(''); {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; function TJclInt64TreeIterator.PreviousIndex: Integer; begin // No index raise EJclOperationNotSupportedError.Create; end; procedure TJclInt64TreeIterator.Remove; var OldCursor: TJclInt64TreeNode; begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} CheckValid; Valid := False; OldCursor := FCursor; FCursor := GetNextSibling; if OldCursor <> nil then FOwnTree.RemoveNode(OldCursor); {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; procedure TJclInt64TreeIterator.Reset; var NewCursor: TJclInt64TreeNode; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} Valid := False; case FStart of isFirst: begin NewCursor := FCursor; while NewCursor <> nil do begin NewCursor := GetPreviousCursor; if NewCursor <> nil then FCursor := NewCursor; end; end; isLast: begin NewCursor := FCursor; while NewCursor <> nil do begin NewCursor := GetNextCursor; if NewCursor <> nil then FCursor := NewCursor; end; end; isRoot: begin while (FCursor <> nil) and (FCursor.Parent <> nil) do FCursor := FCursor.Parent; end; end; {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; procedure TJclInt64TreeIterator.SetChild(Index: Integer; const AValue: Int64); begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} if (FCursor <> nil) and (Index >= 0) and (Index < FCursor.ChildrenCount) then TJclInt64TreeNode(FCursor.Children[Index]).Value := AValue else raise EJclOutOfBoundsError.Create; {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; procedure TJclInt64TreeIterator.SetValue(const AValue: Int64); begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} CheckValid; if FCursor <> nil then begin FOwnTree.FreeInt64(FCursor.Value); FCursor.Value := AValue; end; {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; //=== { TJclPreOrderInt64TreeIterator } =================================================== function TJclPreOrderInt64TreeIterator.CreateEmptyIterator: TJclAbstractIterator; begin Result := TJclPreOrderInt64TreeIterator.Create(FOwnTree, FCursor, Valid, FStart); end; function TJclPreOrderInt64TreeIterator.GetNextCursor: TJclInt64TreeNode; var LastRet: TJclInt64TreeNode; begin Result := FCursor; if Result = nil then Exit; LastRet := Result; if Result.ChildrenCount > 0 then Result := TJclInt64TreeNode(Result.Children[0]) else begin Result := Result.Parent; while (Result <> nil) and (Result.IndexOfChild(LastRet) = (Result.ChildrenCount - 1)) do begin LastRet := Result; Result := Result.Parent; end; if Result <> nil then // not root = return successor Result := TJclInt64TreeNode(Result.Children[Result.IndexOfChild(LastRet) + 1]); end; end; function TJclPreOrderInt64TreeIterator.GetNextSibling: TJclInt64TreeNode; var LastRet: TJclInt64TreeNode; begin Result := FCursor; if Result = nil then Exit; LastRet := Result; Result := Result.Parent; while (Result <> nil) and (Result.IndexOfChild(LastRet) = (Result.ChildrenCount - 1)) do begin LastRet := Result; Result := Result.Parent; end; if Result <> nil then // not root = return successor Result := TJclInt64TreeNode(Result.Children[Result.IndexOfChild(LastRet) + 1]); end; function TJclPreOrderInt64TreeIterator.GetPreviousCursor: TJclInt64TreeNode; var LastRet: TJclInt64TreeNode; begin Result := FCursor; if Result = nil then Exit; LastRet := Result; Result := Result.Parent; if (Result <> nil) and (Result.IndexOfChild(LastRet) > 0) then // come from Right begin Result := TJclInt64TreeNode(Result.Children[Result.IndexOfChild(LastRet) - 1]); while (Result.ChildrenCount > 0) do // descend down the tree Result := TJclInt64TreeNode(Result.Children[Result.ChildrenCount - 1]); end; end; //=== { TJclPostOrderInt64TreeIterator } ================================================== function TJclPostOrderInt64TreeIterator.CreateEmptyIterator: TJclAbstractIterator; begin Result := TJclPostOrderInt64TreeIterator.Create(FOwnTree, FCursor, Valid, FStart); end; function TJclPostOrderInt64TreeIterator.GetNextCursor: TJclInt64TreeNode; var LastRet: TJclInt64TreeNode; begin Result := FCursor; if Result = nil then Exit; LastRet := Result; Result := Result.Parent; if (Result <> nil) and (Result.IndexOfChild(LastRet) <> (Result.ChildrenCount - 1)) then begin Result := TJclInt64TreeNode(Result.Children[Result.IndexOfChild(LastRet) + 1]); while Result.ChildrenCount > 0 do Result := TJclInt64TreeNode(Result.Children[0]); end; end; function TJclPostOrderInt64TreeIterator.GetNextSibling: TJclInt64TreeNode; var LastRet: TJclInt64TreeNode; begin Result := FCursor; if Result = nil then Exit; LastRet := Result; Result := Result.Parent; if (Result <> nil) and (Result.IndexOfChild(LastRet) <> (Result.ChildrenCount - 1)) then begin Result := TJclInt64TreeNode(Result.Children[Result.IndexOfChild(LastRet) + 1]); while Result.ChildrenCount > 0 do Result := TJclInt64TreeNode(Result.Children[0]); end; end; function TJclPostOrderInt64TreeIterator.GetPreviousCursor: TJclInt64TreeNode; var LastRet: TJclInt64TreeNode; begin Result := FCursor; if Result = nil then Exit; if Result.ChildrenCount > 0 then Result := TJclInt64TreeNode(Result.Children[Result.ChildrenCount - 1]) else begin LastRet := Result; Result := Result.Parent; while (Result <> nil) and (Result.IndexOfChild(LastRet) = 0) do begin LastRet := Result; Result := Result.Parent; end; if Result <> nil then // not root Result := TJclInt64TreeNode(Result.Children[Result.IndexOfChild(LastRet) - 1]); end; end; //=== { TJclPtrTreeNode } ======================================================= function TJclPtrTreeNode.IndexOfChild(AChild: TJclPtrTreeNode): Integer; begin for Result := 0 to ChildrenCount - 1 do if Children[Result] = AChild then Exit; Result := -1; end; function TJclPtrTreeNode.IndexOfValue(APtr: Pointer; const AEqualityComparer: IJclPtrEqualityComparer): Integer; begin for Result := 0 to ChildrenCount - 1 do if AEqualityComparer.ItemsEqual(TJclPtrTreeNode(Children[Result]).Value, APtr) then Exit; Result := -1; end; //=== { TJclPtrTree } ======================================================= constructor TJclPtrTree.Create(); begin inherited Create(); FTraverseOrder := toPreOrder; end; destructor TJclPtrTree.Destroy; begin FReadOnly := False; Clear; inherited Destroy; end; function TJclPtrTree.Add(APtr: Pointer): Boolean; var NewNode: TJclPtrTreeNode; begin if ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginWrite; try {$ENDIF THREADSAFE} Result := AllowDefaultElements or not ItemsEqual(APtr, nil); if Result then begin if FRoot <> nil then begin Result := (not Contains(APtr)) or CheckDuplicate; if Result then begin if FRoot.ChildrenCount = Length(FRoot.Children) then SetLength(FRoot.Children, CalcGrowCapacity(Length(FRoot.Children), FRoot.ChildrenCount)); if FRoot.ChildrenCount < Length(FRoot.Children) then begin NewNode := TJclPtrTreeNode.Create; NewNode.Value := APtr; NewNode.Parent := FRoot; FRoot.Children[FRoot.ChildrenCount] := NewNode; Inc(FRoot.ChildrenCount); Inc(FSize); end else Result := False; end; end else begin FRoot := TJclPtrTreeNode.Create; FRoot.Value := APtr; Inc(FSize); end; end; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndWrite; end; {$ENDIF THREADSAFE} end; function TJclPtrTree.AddAll(const ACollection: IJclPtrCollection): Boolean; var It: IJclPtrIterator; begin if ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginWrite; try {$ENDIF THREADSAFE} Result := False; if ACollection = nil then Exit; Result := True; It := ACollection.First; while It.HasNext do Result := Add(It.Next) and Result; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndWrite; end; {$ENDIF THREADSAFE} end; procedure TJclPtrTree.AssignDataTo(Dest: TJclAbstractContainerBase); var ADest: TJclPtrTree; ACollection: IJclPtrCollection; begin inherited AssignDataTo(Dest); if Dest is TJclPtrTree then begin ADest := TJclPtrTree(Dest); ADest.Clear; ADest.FSize := FSize; if FRoot <> nil then ADest.FRoot := CloneNode(FRoot, nil); end else if Supports(IInterface(Dest), IJclPtrCollection, ACollection) then begin ACollection.Clear; ACollection.AddAll(Self); end; end; procedure TJclPtrTree.AssignPropertiesTo(Dest: TJclAbstractContainerBase); begin inherited AssignPropertiesto(Dest); if Dest is TJclPtrTree then TJclPtrTree(Dest).FTraverseOrder := FTraverseOrder; end; procedure TJclPtrTree.Clear; begin if ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginWrite; try {$ENDIF THREADSAFE} if FRoot <> nil then RemoveNode(FRoot); FSize := 0; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndWrite; end; {$ENDIF THREADSAFE} end; function TJclPtrTree.CloneNode(Node, Parent: TJclPtrTreeNode): TJclPtrTreeNode; var Index: Integer; begin Result := TJclPtrTreeNode.Create; Result.Value := Node.Value; Result.Parent := Parent; SetLength(Result.Children, Node.ChildrenCount); Result.ChildrenCount := Node.ChildrenCount; for Index := 0 to Node.ChildrenCount - 1 do Result.Children[Index] := CloneNode(TJclPtrTreeNode(Node.Children[Index]), Result); // recursive call end; function TJclPtrTree.CollectionEquals(const ACollection: IJclPtrCollection): Boolean; var It, ItSelf: IJclPtrIterator; begin {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginRead; try {$ENDIF THREADSAFE} Result := False; if ACollection = nil then Exit; if FSize <> ACollection.Size then Exit; Result := True; It := ACollection.First; ItSelf := First; while ItSelf.HasNext do if not ItemsEqual(ItSelf.Next, It.Next) then begin Result := False; Break; end; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndRead; end; {$ENDIF THREADSAFE} end; function TJclPtrTree.Contains(APtr: Pointer): Boolean; begin {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginRead; try {$ENDIF THREADSAFE} if FRoot <> nil then Result := NodeContains(FRoot, APtr) else Result := False; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndRead; end; {$ENDIF THREADSAFE} end; function TJclPtrTree.ContainsAll(const ACollection: IJclPtrCollection): Boolean; var It: IJclPtrIterator; begin {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginRead; try {$ENDIF THREADSAFE} Result := True; if ACollection = nil then Exit; It := ACollection.First; while Result and It.HasNext do Result := Contains(It.Next); {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndRead; end; {$ENDIF THREADSAFE} end; function TJclPtrTree.Extract(APtr: Pointer): Boolean; var It: IJclPtrIterator; begin if ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginWrite; try {$ENDIF THREADSAFE} Result := FRoot <> nil; if Result then begin It := First; while It.HasNext do if ItemsEqual(It.Next, APtr) then begin It.Extract; if RemoveSingleElement then Break; end; end; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndWrite; end; {$ENDIF THREADSAFE} end; function TJclPtrTree.ExtractAll(const ACollection: IJclPtrCollection): Boolean; var It: IJclPtrIterator; begin if ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginWrite; try {$ENDIF THREADSAFE} Result := False; if ACollection = nil then Exit; Result := True; It := ACollection.First; while It.HasNext do Result := Extract(It.Next) and Result; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndWrite; end; {$ENDIF THREADSAFE} end; procedure TJclPtrTree.ExtractNode(var ANode: TJclPtrTreeNode); var Index, ChildIndex, NewCapacity: Integer; Parent: TJclPtrTreeNode; begin for Index := ANode.ChildrenCount - 1 downto 0 do {$IFDEF BCB} ExtractNode(TJclPtrTreeNode(ANode.Children[Index])); {$ELSE ~BCB} ExtractNode(ANode.Children[Index]); {$ENDIF ~BCB} Parent := ANode.Parent; if Parent <> nil then begin ChildIndex := Parent.IndexOfChild(ANode); for Index := ChildIndex + 1 to Parent.ChildrenCount - 1 do Parent.Children[Index - 1] := Parent.Children[Index]; Dec(Parent.ChildrenCount); NewCapacity := CalcPackCapacity(Length(Parent.Children), Parent.ChildrenCount); if NewCapacity < Length(Parent.Children) then SetLength(Parent.Children, NewCapacity); FreeAndNil(ANode); end else begin FreeAndNil(ANode); FRoot := nil; end; Dec(FSize); end; function TJclPtrTree.First: IJclPtrIterator; var Start: TJclPtrTreeNode; begin {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginRead; try {$ENDIF THREADSAFE} Start := FRoot; case GetTraverseOrder of toPreOrder: Result := TJclPreOrderPtrTreeIterator.Create(Self, Start, False, isFirst); toPostOrder: begin if Start <> nil then while (Start.ChildrenCount > 0) do Start := TJclPtrTreeNode(Start.Children[0]); Result := TJclPostOrderPtrTreeIterator.Create(Self, Start, False, isFirst); end; else Result := nil; end; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndRead; end; {$ENDIF THREADSAFE} end; {$IFDEF SUPPORTS_FOR_IN} function TJclPtrTree.GetEnumerator: IJclPtrIterator; begin Result := First; end; {$ENDIF SUPPORTS_FOR_IN} function TJclPtrTree.GetRoot: IJclPtrTreeIterator; begin {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginRead; try {$ENDIF THREADSAFE} case GetTraverseOrder of toPreOrder: Result := TJclPreOrderPtrTreeIterator.Create(Self, FRoot, False, isRoot); toPostOrder: Result := TJclPostOrderPtrTreeIterator.Create(Self, FRoot, False, isRoot); else Result := nil; end; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndRead; end; {$ENDIF THREADSAFE} end; function TJclPtrTree.GetTraverseOrder: TJclTraverseOrder; begin Result := FTraverseOrder; end; function TJclPtrTree.IsEmpty: Boolean; begin Result := FSize = 0; end; function TJclPtrTree.Last: IJclPtrIterator; var Start: TJclPtrTreeNode; begin {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginRead; try {$ENDIF THREADSAFE} Start := FRoot; case FTraverseOrder of toPreOrder: begin if Start <> nil then while Start.ChildrenCount > 0 do Start := TJclPtrTreeNode(Start.Children[Start.ChildrenCount - 1]); Result := TJclPreOrderPtrTreeIterator.Create(Self, Start, False, isLast); end; toPostOrder: Result := TJclPostOrderPtrTreeIterator.Create(Self, Start, False, isLast); else Result := nil; end; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndRead; end; {$ENDIF THREADSAFE} end; function TJclPtrTree.NodeContains(ANode: TJclPtrTreeNode; APtr: Pointer): Boolean; var Index: Integer; begin Result := ItemsEqual(ANode.Value, APtr); if not Result then for Index := 0 to ANode.ChildrenCount - 1 do begin Result := NodeContains(TJclPtrTreeNode(ANode.Children[Index]), APtr); if Result then Break; end; end; procedure TJclPtrTree.Pack; begin if ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginWrite; try {$ENDIF THREADSAFE} if FRoot <> nil then PackNode(FRoot); {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndWrite; end; {$ENDIF THREADSAFE} end; procedure TJclPtrTree.PackNode(ANode: TJclPtrTreeNode); var Index: Integer; begin SetLength(ANode.Children, ANode.ChildrenCount); for Index := 0 to ANode.ChildrenCount - 1 do PackNode(TJclPtrTreeNode(ANode.Children[Index])); end; function TJclPtrTree.Remove(APtr: Pointer): Boolean; var Extracted: Pointer; begin if ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginWrite; try {$ENDIF THREADSAFE} Result := Extract(APtr); if Result then begin Extracted := APtr; FreePointer(Extracted); end; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndWrite; end; {$ENDIF THREADSAFE} end; function TJclPtrTree.RemoveAll(const ACollection: IJclPtrCollection): Boolean; var It: IJclPtrIterator; begin if ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginWrite; try {$ENDIF THREADSAFE} Result := False; if ACollection = nil then Exit; Result := True; It := ACollection.First; while It.HasNext do Result := Remove(It.Next) and Result; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndWrite; end; {$ENDIF THREADSAFE} end; procedure TJclPtrTree.RemoveNode(var ANode: TJclPtrTreeNode); var Index, ChildIndex, NewCapacity: Integer; Parent: TJclPtrTreeNode; begin for Index := ANode.ChildrenCount - 1 downto 0 do {$IFDEF BCB} RemoveNode(TJclPtrTreeNode(ANode.Children[Index])); {$ELSE ~BCB} RemoveNode(ANode.Children[Index]); {$ENDIF ~BCB} FreePointer(ANode.Value); Parent := ANode.Parent; if Parent <> nil then begin ChildIndex := Parent.IndexOfChild(ANode); for Index := ChildIndex + 1 to Parent.ChildrenCount - 1 do Parent.Children[Index - 1] := Parent.Children[Index]; Dec(Parent.ChildrenCount); NewCapacity := CalcPackCapacity(Length(Parent.Children), Parent.ChildrenCount); if NewCapacity < Length(Parent.Children) then SetLength(Parent.Children, NewCapacity); FreeAndNil(ANode); end else begin FreeAndNil(ANode); FRoot := nil; end; Dec(FSize); end; function TJclPtrTree.RetainAll(const ACollection: IJclPtrCollection): Boolean; var It: IJclPtrIterator; begin if ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginWrite; try {$ENDIF THREADSAFE} Result := False; if ACollection = nil then Exit; Result := True; It := First; while It.HasNext do if not ACollection.Contains(It.Next) then It.Remove; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndWrite; end; {$ENDIF THREADSAFE} end; procedure TJclPtrTree.SetCapacity(Value: Integer); begin raise EJclOperationNotSupportedError.Create; end; procedure TJclPtrTree.SetTraverseOrder(Value: TJclTraverseOrder); begin FTraverseOrder := Value; end; function TJclPtrTree.Size: Integer; begin Result := FSize; end; function TJclPtrTree.CreateEmptyContainer: TJclAbstractContainerBase; begin Result := TJclPtrTree.Create; AssignPropertiesTo(Result); end; //=== { TJclPtrTreeIterator } =========================================================== constructor TJclPtrTreeIterator.Create(OwnTree: TJclPtrTree; ACursor: TJclPtrTreeNode; AValid: Boolean; AStart: TItrStart); begin inherited Create(AValid); FCursor := ACursor; FOwnTree := OwnTree; FStart := AStart; FEqualityComparer := OwnTree as IJclPtrEqualityComparer; end; function TJclPtrTreeIterator.Add(APtr: Pointer): Boolean; var ParentNode, NewNode: TJclPtrTreeNode; begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} // add sibling or, if FCursor is root node, behave like TJclPtrTree.Add Result := (FCursor <> nil) and (FOwnTree.AllowDefaultElements or not FEqualityComparer.ItemsEqual(APtr, nil)) and ((not FOwnTree.Contains(APtr)) or FOwnTree.CheckDuplicate); if Result then begin ParentNode := FCursor.Parent; if ParentNode = nil then ParentNode := FCursor; if ParentNode.ChildrenCount = Length(ParentNode.Children) then SetLength(ParentNode.Children, FOwnTree.CalcGrowCapacity(Length(ParentNode.Children), ParentNode.ChildrenCount)); if ParentNode.ChildrenCount < Length(ParentNode.Children) then begin NewNode := TJclPtrTreeNode.Create; NewNode.Value := APtr; NewNode.Parent := ParentNode; ParentNode.Children[ParentNode.ChildrenCount] := NewNode; Inc(ParentNode.ChildrenCount); Inc(FOwnTree.FSize); end; end; {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; function TJclPtrTreeIterator.AddChild(APtr: Pointer): Boolean; var NewNode: TJclPtrTreeNode; begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} Result := (FCursor <> nil) and (FOwnTree.AllowDefaultElements or not FEqualityComparer.ItemsEqual(APtr, nil)) and ((not FOwnTree.Contains(APtr)) or FOwnTree.CheckDuplicate); if Result then begin if FCursor.ChildrenCount = Length(FCursor.Children) then SetLength(FCursor.Children, FOwnTree.CalcGrowCapacity(Length(FCursor.Children), FCursor.ChildrenCount)); if FCursor.ChildrenCount < Length(FCursor.Children) then begin NewNode := TJclPtrTreeNode.Create; NewNode.Value := APtr; NewNode.Parent := FCursor; FCursor.Children[FCursor.ChildrenCount] := NewNode; Inc(FCursor.ChildrenCount); Inc(FOwnTree.FSize); end; end; {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; procedure TJclPtrTreeIterator.AssignPropertiesTo(Dest: TJclAbstractIterator); var ADest: TJclPtrTreeIterator; begin inherited AssignPropertiesTo(Dest); if Dest is TJclPtrTreeIterator then begin ADest := TJclPtrTreeIterator(Dest); ADest.FCursor := FCursor; ADest.FOwnTree := FOwnTree; ADest.FEqualityComparer := FEqualityComparer; ADest.FStart := FStart; end; end; function TJclPtrTreeIterator.ChildrenCount: Integer; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} if FCursor <> nil then Result := FCursor.ChildrenCount else Result := 0; {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; procedure TJclPtrTreeIterator.DeleteChild(Index: Integer); begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} if (FCursor <> nil) and (Index >= 0) and (Index < FCursor.ChildrenCount) then {$IFDEF BCB} FOwnTree.RemoveNode(TJclPtrTreeNode(FCursor.Children[Index])) {$ELSE ~BCB} FOwnTree.RemoveNode(FCursor.Children[Index]) {$ENDIF ~BCB} else raise EJclOutOfBoundsError.Create; {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; procedure TJclPtrTreeIterator.DeleteChildren; var Index: Integer; begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} if FCursor <> nil then begin for Index := FCursor.ChildrenCount - 1 downto 0 do {$IFDEF BCB} FOwnTree.RemoveNode(TJclPtrTreeNode(FCursor.Children[Index])); {$ELSE ~BCB} FOwnTree.RemoveNode(FCursor.Children[Index]); {$ENDIF ~BCB} SetLength(FCursor.Children, 0); FCursor.ChildrenCount := 0; end; {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; procedure TJclPtrTreeIterator.Extract; var OldCursor: TJclPtrTreeNode; begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} CheckValid; Valid := False; OldCursor := FCursor; FCursor := GetNextSibling; if OldCursor <> nil then FOwnTree.ExtractNode(OldCursor); {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; procedure TJclPtrTreeIterator.ExtractChild(Index: Integer); begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} if (FCursor <> nil) and (Index >= 0) and (Index < FCursor.ChildrenCount) then {$IFDEF BCB} FOwnTree.ExtractNode(TJclPtrTreeNode(FCursor.Children[Index])) {$ELSE ~BCB} FOwnTree.ExtractNode(FCursor.Children[Index]) {$ENDIF ~BCB} else raise EJclOutOfBoundsError.Create; {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; procedure TJclPtrTreeIterator.ExtractChildren; var Index: Integer; begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} if FCursor <> nil then begin for Index := FCursor.ChildrenCount - 1 downto 0 do {$IFDEF BCB} FOwnTree.ExtractNode(TJclPtrTreeNode(FCursor.Children[Index])); {$ELSE ~BCB} FOwnTree.ExtractNode(FCursor.Children[Index]); {$ENDIF ~BCB} SetLength(FCursor.Children, 0); FCursor.ChildrenCount := 0; end; {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; function TJclPtrTreeIterator.GetChild(Index: Integer): Pointer; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} Result := nil; if (FCursor <> nil) and (Index >= 0) and (Index < FCursor.ChildrenCount) then FCursor := TJclPtrTreeNode(FCursor.Children[Index]); if FCursor <> nil then Result := FCursor.Value else if not FOwnTree.ReturnDefaultElements then raise EJclNoSuchElementError.Create(''); {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; function TJclPtrTreeIterator.GetPointer: Pointer; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} CheckValid; Result := nil; if FCursor <> nil then Result := FCursor.Value else if not FOwnTree.ReturnDefaultElements then raise EJclNoSuchElementError.Create(''); {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; function TJclPtrTreeIterator.HasChild(Index: Integer): Boolean; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} Result := (FCursor <> nil) and (Index >= 0) and (Index < FCursor.ChildrenCount); {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; function TJclPtrTreeIterator.HasNext: Boolean; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} if Valid then Result := GetNextCursor <> nil else Result := FCursor <> nil; {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; function TJclPtrTreeIterator.HasParent: Boolean; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} Result := (FCursor <> nil) and (FCursor.Parent <> nil); {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; function TJclPtrTreeIterator.HasPrevious: Boolean; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} if Valid then Result := GetPreviousCursor <> nil else Result := FCursor <> nil; {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; function TJclPtrTreeIterator.IndexOfChild(APtr: Pointer): Integer; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} if FCursor <> nil then Result := FCursor.IndexOfValue(APtr, FEqualityComparer) else Result := -1; {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; function TJclPtrTreeIterator.Insert(APtr: Pointer): Boolean; var ParentNode, NewNode: TJclPtrTreeNode; Index, I: Integer; begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} // insert sibling or, if FCursor is root node, behave like TJclPtrTree.Insert Result := (FCursor <> nil) and (FOwnTree.AllowDefaultElements or not FEqualityComparer.ItemsEqual(APtr, nil)) and ((not FOwnTree.Contains(APtr)) or FOwnTree.CheckDuplicate); if Result then begin if FCursor.Parent <> nil then begin ParentNode := FCursor.Parent; Index := 0; while (Index < ParentNode.ChildrenCount) and (ParentNode.Children[Index] <> FCursor) do Inc(Index); end else begin ParentNode := FCursor; Index := 0; end; if ParentNode.ChildrenCount = Length(ParentNode.Children) then SetLength(ParentNode.Children, FOwnTree.CalcGrowCapacity(Length(ParentNode.Children), ParentNode.ChildrenCount)); if ParentNode.ChildrenCount < Length(ParentNode.Children) then begin NewNode := TJclPtrTreeNode.Create; NewNode.Value := APtr; NewNode.Parent := ParentNode; for I := ParentNode.ChildrenCount - 1 downto Index do ParentNode.Children[I + 1] := ParentNode.Children[I]; ParentNode.Children[Index] := NewNode; Inc(ParentNode.ChildrenCount); Inc(FOwnTree.FSize); end; end; {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; function TJclPtrTreeIterator.InsertChild(Index: Integer; APtr: Pointer): Boolean; var NewNode: TJclPtrTreeNode; I: Integer; begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} // insert sibling or, if FCursor is root node, behave like TJclPtrTree.Insert Result := (FCursor <> nil) and (FOwnTree.AllowDefaultElements or not FEqualityComparer.ItemsEqual(APtr, nil)) and ((not FOwnTree.Contains(APtr)) or FOwnTree.CheckDuplicate); if Result then begin if FCursor.ChildrenCount = Length(FCursor.Children) then SetLength(FCursor.Children, FOwnTree.CalcGrowCapacity(Length(FCursor.Children), FCursor.ChildrenCount)); if FCursor.ChildrenCount < Length(FCursor.Children) then begin NewNode := TJclPtrTreeNode.Create; NewNode.Value := APtr; NewNode.Parent := FCursor; for I := FCursor.ChildrenCount - 1 downto Index do FCursor.Children[I + 1] := FCursor.Children[I]; FCursor.Children[Index] := NewNode; Inc(FCursor.ChildrenCount); Inc(FOwnTree.FSize); end; end; {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; function TJclPtrTreeIterator.IteratorEquals(const AIterator: IJclPtrIterator): Boolean; var Obj: TObject; ItrObj: TJclPtrTreeIterator; begin Result := False; if AIterator = nil then Exit; Obj := AIterator.GetIteratorReference; if Obj is TJclPtrTreeIterator then begin ItrObj := TJclPtrTreeIterator(Obj); Result := (FOwnTree = ItrObj.FOwnTree) and (FCursor = ItrObj.FCursor) and (Valid = ItrObj.Valid); end; end; {$IFDEF SUPPORTS_FOR_IN} function TJclPtrTreeIterator.MoveNext: Boolean; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} if Valid then FCursor := GetNextCursor else Valid := True; Result := FCursor <> nil; {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; {$ENDIF SUPPORTS_FOR_IN} function TJclPtrTreeIterator.Next: Pointer; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} if Valid then FCursor := GetNextCursor else Valid := True; Result := nil; if FCursor <> nil then Result := FCursor.Value else if not FOwnTree.ReturnDefaultElements then raise EJclNoSuchElementError.Create(''); {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; function TJclPtrTreeIterator.NextIndex: Integer; begin // No index raise EJclOperationNotSupportedError.Create; end; function TJclPtrTreeIterator.Parent: Pointer; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} Result := nil; if FCursor <> nil then FCursor := FCursor.Parent; if FCursor <> nil then Result := FCursor.Value else if not FOwnTree.ReturnDefaultElements then raise EJclNoSuchElementError.Create(''); {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; function TJclPtrTreeIterator.Previous: Pointer; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} if Valid then FCursor := GetPreviousCursor else Valid := True; Result := nil; if FCursor <> nil then Result := FCursor.Value else if not FOwnTree.ReturnDefaultElements then raise EJclNoSuchElementError.Create(''); {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; function TJclPtrTreeIterator.PreviousIndex: Integer; begin // No index raise EJclOperationNotSupportedError.Create; end; procedure TJclPtrTreeIterator.Remove; var OldCursor: TJclPtrTreeNode; begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} CheckValid; Valid := False; OldCursor := FCursor; FCursor := GetNextSibling; if OldCursor <> nil then FOwnTree.RemoveNode(OldCursor); {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; procedure TJclPtrTreeIterator.Reset; var NewCursor: TJclPtrTreeNode; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} Valid := False; case FStart of isFirst: begin NewCursor := FCursor; while NewCursor <> nil do begin NewCursor := GetPreviousCursor; if NewCursor <> nil then FCursor := NewCursor; end; end; isLast: begin NewCursor := FCursor; while NewCursor <> nil do begin NewCursor := GetNextCursor; if NewCursor <> nil then FCursor := NewCursor; end; end; isRoot: begin while (FCursor <> nil) and (FCursor.Parent <> nil) do FCursor := FCursor.Parent; end; end; {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; procedure TJclPtrTreeIterator.SetChild(Index: Integer; APtr: Pointer); begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} if (FCursor <> nil) and (Index >= 0) and (Index < FCursor.ChildrenCount) then TJclPtrTreeNode(FCursor.Children[Index]).Value := APtr else raise EJclOutOfBoundsError.Create; {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; procedure TJclPtrTreeIterator.SetPointer(APtr: Pointer); begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} CheckValid; if FCursor <> nil then begin FOwnTree.FreePointer(FCursor.Value); FCursor.Value := APtr; end; {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; //=== { TJclPreOrderPtrTreeIterator } =================================================== function TJclPreOrderPtrTreeIterator.CreateEmptyIterator: TJclAbstractIterator; begin Result := TJclPreOrderPtrTreeIterator.Create(FOwnTree, FCursor, Valid, FStart); end; function TJclPreOrderPtrTreeIterator.GetNextCursor: TJclPtrTreeNode; var LastRet: TJclPtrTreeNode; begin Result := FCursor; if Result = nil then Exit; LastRet := Result; if Result.ChildrenCount > 0 then Result := TJclPtrTreeNode(Result.Children[0]) else begin Result := Result.Parent; while (Result <> nil) and (Result.IndexOfChild(LastRet) = (Result.ChildrenCount - 1)) do begin LastRet := Result; Result := Result.Parent; end; if Result <> nil then // not root = return successor Result := TJclPtrTreeNode(Result.Children[Result.IndexOfChild(LastRet) + 1]); end; end; function TJclPreOrderPtrTreeIterator.GetNextSibling: TJclPtrTreeNode; var LastRet: TJclPtrTreeNode; begin Result := FCursor; if Result = nil then Exit; LastRet := Result; Result := Result.Parent; while (Result <> nil) and (Result.IndexOfChild(LastRet) = (Result.ChildrenCount - 1)) do begin LastRet := Result; Result := Result.Parent; end; if Result <> nil then // not root = return successor Result := TJclPtrTreeNode(Result.Children[Result.IndexOfChild(LastRet) + 1]); end; function TJclPreOrderPtrTreeIterator.GetPreviousCursor: TJclPtrTreeNode; var LastRet: TJclPtrTreeNode; begin Result := FCursor; if Result = nil then Exit; LastRet := Result; Result := Result.Parent; if (Result <> nil) and (Result.IndexOfChild(LastRet) > 0) then // come from Right begin Result := TJclPtrTreeNode(Result.Children[Result.IndexOfChild(LastRet) - 1]); while (Result.ChildrenCount > 0) do // descend down the tree Result := TJclPtrTreeNode(Result.Children[Result.ChildrenCount - 1]); end; end; //=== { TJclPostOrderPtrTreeIterator } ================================================== function TJclPostOrderPtrTreeIterator.CreateEmptyIterator: TJclAbstractIterator; begin Result := TJclPostOrderPtrTreeIterator.Create(FOwnTree, FCursor, Valid, FStart); end; function TJclPostOrderPtrTreeIterator.GetNextCursor: TJclPtrTreeNode; var LastRet: TJclPtrTreeNode; begin Result := FCursor; if Result = nil then Exit; LastRet := Result; Result := Result.Parent; if (Result <> nil) and (Result.IndexOfChild(LastRet) <> (Result.ChildrenCount - 1)) then begin Result := TJclPtrTreeNode(Result.Children[Result.IndexOfChild(LastRet) + 1]); while Result.ChildrenCount > 0 do Result := TJclPtrTreeNode(Result.Children[0]); end; end; function TJclPostOrderPtrTreeIterator.GetNextSibling: TJclPtrTreeNode; var LastRet: TJclPtrTreeNode; begin Result := FCursor; if Result = nil then Exit; LastRet := Result; Result := Result.Parent; if (Result <> nil) and (Result.IndexOfChild(LastRet) <> (Result.ChildrenCount - 1)) then begin Result := TJclPtrTreeNode(Result.Children[Result.IndexOfChild(LastRet) + 1]); while Result.ChildrenCount > 0 do Result := TJclPtrTreeNode(Result.Children[0]); end; end; function TJclPostOrderPtrTreeIterator.GetPreviousCursor: TJclPtrTreeNode; var LastRet: TJclPtrTreeNode; begin Result := FCursor; if Result = nil then Exit; if Result.ChildrenCount > 0 then Result := TJclPtrTreeNode(Result.Children[Result.ChildrenCount - 1]) else begin LastRet := Result; Result := Result.Parent; while (Result <> nil) and (Result.IndexOfChild(LastRet) = 0) do begin LastRet := Result; Result := Result.Parent; end; if Result <> nil then // not root Result := TJclPtrTreeNode(Result.Children[Result.IndexOfChild(LastRet) - 1]); end; end; //=== { TJclTreeNode } ======================================================= function TJclTreeNode.IndexOfChild(AChild: TJclTreeNode): Integer; begin for Result := 0 to ChildrenCount - 1 do if Children[Result] = AChild then Exit; Result := -1; end; function TJclTreeNode.IndexOfValue(AObject: TObject; const AEqualityComparer: IJclEqualityComparer): Integer; begin for Result := 0 to ChildrenCount - 1 do if AEqualityComparer.ItemsEqual(TJclTreeNode(Children[Result]).Value, AObject) then Exit; Result := -1; end; //=== { TJclTree } ======================================================= constructor TJclTree.Create(AOwnsObjects: Boolean); begin inherited Create(AOwnsObjects); FTraverseOrder := toPreOrder; end; destructor TJclTree.Destroy; begin FReadOnly := False; Clear; inherited Destroy; end; function TJclTree.Add(AObject: TObject): Boolean; var NewNode: TJclTreeNode; begin if ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginWrite; try {$ENDIF THREADSAFE} Result := AllowDefaultElements or not ItemsEqual(AObject, nil); if Result then begin if FRoot <> nil then begin Result := (not Contains(AObject)) or CheckDuplicate; if Result then begin if FRoot.ChildrenCount = Length(FRoot.Children) then SetLength(FRoot.Children, CalcGrowCapacity(Length(FRoot.Children), FRoot.ChildrenCount)); if FRoot.ChildrenCount < Length(FRoot.Children) then begin NewNode := TJclTreeNode.Create; NewNode.Value := AObject; NewNode.Parent := FRoot; FRoot.Children[FRoot.ChildrenCount] := NewNode; Inc(FRoot.ChildrenCount); Inc(FSize); end else Result := False; end; end else begin FRoot := TJclTreeNode.Create; FRoot.Value := AObject; Inc(FSize); end; end; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndWrite; end; {$ENDIF THREADSAFE} end; function TJclTree.AddAll(const ACollection: IJclCollection): Boolean; var It: IJclIterator; begin if ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginWrite; try {$ENDIF THREADSAFE} Result := False; if ACollection = nil then Exit; Result := True; It := ACollection.First; while It.HasNext do Result := Add(It.Next) and Result; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndWrite; end; {$ENDIF THREADSAFE} end; procedure TJclTree.AssignDataTo(Dest: TJclAbstractContainerBase); var ADest: TJclTree; ACollection: IJclCollection; begin inherited AssignDataTo(Dest); if Dest is TJclTree then begin ADest := TJclTree(Dest); ADest.Clear; ADest.FSize := FSize; if FRoot <> nil then ADest.FRoot := CloneNode(FRoot, nil); end else if Supports(IInterface(Dest), IJclCollection, ACollection) then begin ACollection.Clear; ACollection.AddAll(Self); end; end; procedure TJclTree.AssignPropertiesTo(Dest: TJclAbstractContainerBase); begin inherited AssignPropertiesto(Dest); if Dest is TJclTree then TJclTree(Dest).FTraverseOrder := FTraverseOrder; end; procedure TJclTree.Clear; begin if ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginWrite; try {$ENDIF THREADSAFE} if FRoot <> nil then RemoveNode(FRoot); FSize := 0; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndWrite; end; {$ENDIF THREADSAFE} end; function TJclTree.CloneNode(Node, Parent: TJclTreeNode): TJclTreeNode; var Index: Integer; begin Result := TJclTreeNode.Create; Result.Value := Node.Value; Result.Parent := Parent; SetLength(Result.Children, Node.ChildrenCount); Result.ChildrenCount := Node.ChildrenCount; for Index := 0 to Node.ChildrenCount - 1 do Result.Children[Index] := CloneNode(TJclTreeNode(Node.Children[Index]), Result); // recursive call end; function TJclTree.CollectionEquals(const ACollection: IJclCollection): Boolean; var It, ItSelf: IJclIterator; begin {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginRead; try {$ENDIF THREADSAFE} Result := False; if ACollection = nil then Exit; if FSize <> ACollection.Size then Exit; Result := True; It := ACollection.First; ItSelf := First; while ItSelf.HasNext do if not ItemsEqual(ItSelf.Next, It.Next) then begin Result := False; Break; end; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndRead; end; {$ENDIF THREADSAFE} end; function TJclTree.Contains(AObject: TObject): Boolean; begin {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginRead; try {$ENDIF THREADSAFE} if FRoot <> nil then Result := NodeContains(FRoot, AObject) else Result := False; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndRead; end; {$ENDIF THREADSAFE} end; function TJclTree.ContainsAll(const ACollection: IJclCollection): Boolean; var It: IJclIterator; begin {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginRead; try {$ENDIF THREADSAFE} Result := True; if ACollection = nil then Exit; It := ACollection.First; while Result and It.HasNext do Result := Contains(It.Next); {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndRead; end; {$ENDIF THREADSAFE} end; function TJclTree.Extract(AObject: TObject): Boolean; var It: IJclIterator; begin if ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginWrite; try {$ENDIF THREADSAFE} Result := FRoot <> nil; if Result then begin It := First; while It.HasNext do if ItemsEqual(It.Next, AObject) then begin It.Extract; if RemoveSingleElement then Break; end; end; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndWrite; end; {$ENDIF THREADSAFE} end; function TJclTree.ExtractAll(const ACollection: IJclCollection): Boolean; var It: IJclIterator; begin if ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginWrite; try {$ENDIF THREADSAFE} Result := False; if ACollection = nil then Exit; Result := True; It := ACollection.First; while It.HasNext do Result := Extract(It.Next) and Result; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndWrite; end; {$ENDIF THREADSAFE} end; procedure TJclTree.ExtractNode(var ANode: TJclTreeNode); var Index, ChildIndex, NewCapacity: Integer; Parent: TJclTreeNode; begin for Index := ANode.ChildrenCount - 1 downto 0 do {$IFDEF BCB} ExtractNode(TJclTreeNode(ANode.Children[Index])); {$ELSE ~BCB} ExtractNode(ANode.Children[Index]); {$ENDIF ~BCB} Parent := ANode.Parent; if Parent <> nil then begin ChildIndex := Parent.IndexOfChild(ANode); for Index := ChildIndex + 1 to Parent.ChildrenCount - 1 do Parent.Children[Index - 1] := Parent.Children[Index]; Dec(Parent.ChildrenCount); NewCapacity := CalcPackCapacity(Length(Parent.Children), Parent.ChildrenCount); if NewCapacity < Length(Parent.Children) then SetLength(Parent.Children, NewCapacity); FreeAndNil(ANode); end else begin FreeAndNil(ANode); FRoot := nil; end; Dec(FSize); end; function TJclTree.First: IJclIterator; var Start: TJclTreeNode; begin {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginRead; try {$ENDIF THREADSAFE} Start := FRoot; case GetTraverseOrder of toPreOrder: Result := TJclPreOrderTreeIterator.Create(Self, Start, False, isFirst); toPostOrder: begin if Start <> nil then while (Start.ChildrenCount > 0) do Start := TJclTreeNode(Start.Children[0]); Result := TJclPostOrderTreeIterator.Create(Self, Start, False, isFirst); end; else Result := nil; end; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndRead; end; {$ENDIF THREADSAFE} end; {$IFDEF SUPPORTS_FOR_IN} function TJclTree.GetEnumerator: IJclIterator; begin Result := First; end; {$ENDIF SUPPORTS_FOR_IN} function TJclTree.GetRoot: IJclTreeIterator; begin {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginRead; try {$ENDIF THREADSAFE} case GetTraverseOrder of toPreOrder: Result := TJclPreOrderTreeIterator.Create(Self, FRoot, False, isRoot); toPostOrder: Result := TJclPostOrderTreeIterator.Create(Self, FRoot, False, isRoot); else Result := nil; end; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndRead; end; {$ENDIF THREADSAFE} end; function TJclTree.GetTraverseOrder: TJclTraverseOrder; begin Result := FTraverseOrder; end; function TJclTree.IsEmpty: Boolean; begin Result := FSize = 0; end; function TJclTree.Last: IJclIterator; var Start: TJclTreeNode; begin {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginRead; try {$ENDIF THREADSAFE} Start := FRoot; case FTraverseOrder of toPreOrder: begin if Start <> nil then while Start.ChildrenCount > 0 do Start := TJclTreeNode(Start.Children[Start.ChildrenCount - 1]); Result := TJclPreOrderTreeIterator.Create(Self, Start, False, isLast); end; toPostOrder: Result := TJclPostOrderTreeIterator.Create(Self, Start, False, isLast); else Result := nil; end; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndRead; end; {$ENDIF THREADSAFE} end; function TJclTree.NodeContains(ANode: TJclTreeNode; AObject: TObject): Boolean; var Index: Integer; begin Result := ItemsEqual(ANode.Value, AObject); if not Result then for Index := 0 to ANode.ChildrenCount - 1 do begin Result := NodeContains(TJclTreeNode(ANode.Children[Index]), AObject); if Result then Break; end; end; procedure TJclTree.Pack; begin if ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginWrite; try {$ENDIF THREADSAFE} if FRoot <> nil then PackNode(FRoot); {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndWrite; end; {$ENDIF THREADSAFE} end; procedure TJclTree.PackNode(ANode: TJclTreeNode); var Index: Integer; begin SetLength(ANode.Children, ANode.ChildrenCount); for Index := 0 to ANode.ChildrenCount - 1 do PackNode(TJclTreeNode(ANode.Children[Index])); end; function TJclTree.Remove(AObject: TObject): Boolean; var Extracted: TObject; begin if ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginWrite; try {$ENDIF THREADSAFE} Result := Extract(AObject); if Result then begin Extracted := AObject; FreeObject(Extracted); end; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndWrite; end; {$ENDIF THREADSAFE} end; function TJclTree.RemoveAll(const ACollection: IJclCollection): Boolean; var It: IJclIterator; begin if ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginWrite; try {$ENDIF THREADSAFE} Result := False; if ACollection = nil then Exit; Result := True; It := ACollection.First; while It.HasNext do Result := Remove(It.Next) and Result; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndWrite; end; {$ENDIF THREADSAFE} end; procedure TJclTree.RemoveNode(var ANode: TJclTreeNode); var Index, ChildIndex, NewCapacity: Integer; Parent: TJclTreeNode; begin for Index := ANode.ChildrenCount - 1 downto 0 do {$IFDEF BCB} RemoveNode(TJclTreeNode(ANode.Children[Index])); {$ELSE ~BCB} RemoveNode(ANode.Children[Index]); {$ENDIF ~BCB} FreeObject(ANode.Value); Parent := ANode.Parent; if Parent <> nil then begin ChildIndex := Parent.IndexOfChild(ANode); for Index := ChildIndex + 1 to Parent.ChildrenCount - 1 do Parent.Children[Index - 1] := Parent.Children[Index]; Dec(Parent.ChildrenCount); NewCapacity := CalcPackCapacity(Length(Parent.Children), Parent.ChildrenCount); if NewCapacity < Length(Parent.Children) then SetLength(Parent.Children, NewCapacity); FreeAndNil(ANode); end else begin FreeAndNil(ANode); FRoot := nil; end; Dec(FSize); end; function TJclTree.RetainAll(const ACollection: IJclCollection): Boolean; var It: IJclIterator; begin if ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginWrite; try {$ENDIF THREADSAFE} Result := False; if ACollection = nil then Exit; Result := True; It := First; while It.HasNext do if not ACollection.Contains(It.Next) then It.Remove; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndWrite; end; {$ENDIF THREADSAFE} end; procedure TJclTree.SetCapacity(Value: Integer); begin raise EJclOperationNotSupportedError.Create; end; procedure TJclTree.SetTraverseOrder(Value: TJclTraverseOrder); begin FTraverseOrder := Value; end; function TJclTree.Size: Integer; begin Result := FSize; end; function TJclTree.CreateEmptyContainer: TJclAbstractContainerBase; begin Result := TJclTree.Create(False); AssignPropertiesTo(Result); end; //=== { TJclTreeIterator } =========================================================== constructor TJclTreeIterator.Create(OwnTree: TJclTree; ACursor: TJclTreeNode; AValid: Boolean; AStart: TItrStart); begin inherited Create(AValid); FCursor := ACursor; FOwnTree := OwnTree; FStart := AStart; FEqualityComparer := OwnTree as IJclEqualityComparer; end; function TJclTreeIterator.Add(AObject: TObject): Boolean; var ParentNode, NewNode: TJclTreeNode; begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} // add sibling or, if FCursor is root node, behave like TJclTree.Add Result := (FCursor <> nil) and (FOwnTree.AllowDefaultElements or not FEqualityComparer.ItemsEqual(AObject, nil)) and ((not FOwnTree.Contains(AObject)) or FOwnTree.CheckDuplicate); if Result then begin ParentNode := FCursor.Parent; if ParentNode = nil then ParentNode := FCursor; if ParentNode.ChildrenCount = Length(ParentNode.Children) then SetLength(ParentNode.Children, FOwnTree.CalcGrowCapacity(Length(ParentNode.Children), ParentNode.ChildrenCount)); if ParentNode.ChildrenCount < Length(ParentNode.Children) then begin NewNode := TJclTreeNode.Create; NewNode.Value := AObject; NewNode.Parent := ParentNode; ParentNode.Children[ParentNode.ChildrenCount] := NewNode; Inc(ParentNode.ChildrenCount); Inc(FOwnTree.FSize); end; end; {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; function TJclTreeIterator.AddChild(AObject: TObject): Boolean; var NewNode: TJclTreeNode; begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} Result := (FCursor <> nil) and (FOwnTree.AllowDefaultElements or not FEqualityComparer.ItemsEqual(AObject, nil)) and ((not FOwnTree.Contains(AObject)) or FOwnTree.CheckDuplicate); if Result then begin if FCursor.ChildrenCount = Length(FCursor.Children) then SetLength(FCursor.Children, FOwnTree.CalcGrowCapacity(Length(FCursor.Children), FCursor.ChildrenCount)); if FCursor.ChildrenCount < Length(FCursor.Children) then begin NewNode := TJclTreeNode.Create; NewNode.Value := AObject; NewNode.Parent := FCursor; FCursor.Children[FCursor.ChildrenCount] := NewNode; Inc(FCursor.ChildrenCount); Inc(FOwnTree.FSize); end; end; {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; procedure TJclTreeIterator.AssignPropertiesTo(Dest: TJclAbstractIterator); var ADest: TJclTreeIterator; begin inherited AssignPropertiesTo(Dest); if Dest is TJclTreeIterator then begin ADest := TJclTreeIterator(Dest); ADest.FCursor := FCursor; ADest.FOwnTree := FOwnTree; ADest.FEqualityComparer := FEqualityComparer; ADest.FStart := FStart; end; end; function TJclTreeIterator.ChildrenCount: Integer; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} if FCursor <> nil then Result := FCursor.ChildrenCount else Result := 0; {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; procedure TJclTreeIterator.DeleteChild(Index: Integer); begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} if (FCursor <> nil) and (Index >= 0) and (Index < FCursor.ChildrenCount) then {$IFDEF BCB} FOwnTree.RemoveNode(TJclTreeNode(FCursor.Children[Index])) {$ELSE ~BCB} FOwnTree.RemoveNode(FCursor.Children[Index]) {$ENDIF ~BCB} else raise EJclOutOfBoundsError.Create; {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; procedure TJclTreeIterator.DeleteChildren; var Index: Integer; begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} if FCursor <> nil then begin for Index := FCursor.ChildrenCount - 1 downto 0 do {$IFDEF BCB} FOwnTree.RemoveNode(TJclTreeNode(FCursor.Children[Index])); {$ELSE ~BCB} FOwnTree.RemoveNode(FCursor.Children[Index]); {$ENDIF ~BCB} SetLength(FCursor.Children, 0); FCursor.ChildrenCount := 0; end; {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; procedure TJclTreeIterator.Extract; var OldCursor: TJclTreeNode; begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} CheckValid; Valid := False; OldCursor := FCursor; FCursor := GetNextSibling; if OldCursor <> nil then FOwnTree.ExtractNode(OldCursor); {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; procedure TJclTreeIterator.ExtractChild(Index: Integer); begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} if (FCursor <> nil) and (Index >= 0) and (Index < FCursor.ChildrenCount) then {$IFDEF BCB} FOwnTree.ExtractNode(TJclTreeNode(FCursor.Children[Index])) {$ELSE ~BCB} FOwnTree.ExtractNode(FCursor.Children[Index]) {$ENDIF ~BCB} else raise EJclOutOfBoundsError.Create; {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; procedure TJclTreeIterator.ExtractChildren; var Index: Integer; begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} if FCursor <> nil then begin for Index := FCursor.ChildrenCount - 1 downto 0 do {$IFDEF BCB} FOwnTree.ExtractNode(TJclTreeNode(FCursor.Children[Index])); {$ELSE ~BCB} FOwnTree.ExtractNode(FCursor.Children[Index]); {$ENDIF ~BCB} SetLength(FCursor.Children, 0); FCursor.ChildrenCount := 0; end; {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; function TJclTreeIterator.GetChild(Index: Integer): TObject; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} Result := nil; if (FCursor <> nil) and (Index >= 0) and (Index < FCursor.ChildrenCount) then FCursor := TJclTreeNode(FCursor.Children[Index]); if FCursor <> nil then Result := FCursor.Value else if not FOwnTree.ReturnDefaultElements then raise EJclNoSuchElementError.Create(''); {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; function TJclTreeIterator.GetObject: TObject; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} CheckValid; Result := nil; if FCursor <> nil then Result := FCursor.Value else if not FOwnTree.ReturnDefaultElements then raise EJclNoSuchElementError.Create(''); {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; function TJclTreeIterator.HasChild(Index: Integer): Boolean; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} Result := (FCursor <> nil) and (Index >= 0) and (Index < FCursor.ChildrenCount); {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; function TJclTreeIterator.HasNext: Boolean; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} if Valid then Result := GetNextCursor <> nil else Result := FCursor <> nil; {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; function TJclTreeIterator.HasParent: Boolean; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} Result := (FCursor <> nil) and (FCursor.Parent <> nil); {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; function TJclTreeIterator.HasPrevious: Boolean; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} if Valid then Result := GetPreviousCursor <> nil else Result := FCursor <> nil; {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; function TJclTreeIterator.IndexOfChild(AObject: TObject): Integer; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} if FCursor <> nil then Result := FCursor.IndexOfValue(AObject, FEqualityComparer) else Result := -1; {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; function TJclTreeIterator.Insert(AObject: TObject): Boolean; var ParentNode, NewNode: TJclTreeNode; Index, I: Integer; begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} // insert sibling or, if FCursor is root node, behave like TJclTree.Insert Result := (FCursor <> nil) and (FOwnTree.AllowDefaultElements or not FEqualityComparer.ItemsEqual(AObject, nil)) and ((not FOwnTree.Contains(AObject)) or FOwnTree.CheckDuplicate); if Result then begin if FCursor.Parent <> nil then begin ParentNode := FCursor.Parent; Index := 0; while (Index < ParentNode.ChildrenCount) and (ParentNode.Children[Index] <> FCursor) do Inc(Index); end else begin ParentNode := FCursor; Index := 0; end; if ParentNode.ChildrenCount = Length(ParentNode.Children) then SetLength(ParentNode.Children, FOwnTree.CalcGrowCapacity(Length(ParentNode.Children), ParentNode.ChildrenCount)); if ParentNode.ChildrenCount < Length(ParentNode.Children) then begin NewNode := TJclTreeNode.Create; NewNode.Value := AObject; NewNode.Parent := ParentNode; for I := ParentNode.ChildrenCount - 1 downto Index do ParentNode.Children[I + 1] := ParentNode.Children[I]; ParentNode.Children[Index] := NewNode; Inc(ParentNode.ChildrenCount); Inc(FOwnTree.FSize); end; end; {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; function TJclTreeIterator.InsertChild(Index: Integer; AObject: TObject): Boolean; var NewNode: TJclTreeNode; I: Integer; begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} // insert sibling or, if FCursor is root node, behave like TJclTree.Insert Result := (FCursor <> nil) and (FOwnTree.AllowDefaultElements or not FEqualityComparer.ItemsEqual(AObject, nil)) and ((not FOwnTree.Contains(AObject)) or FOwnTree.CheckDuplicate); if Result then begin if FCursor.ChildrenCount = Length(FCursor.Children) then SetLength(FCursor.Children, FOwnTree.CalcGrowCapacity(Length(FCursor.Children), FCursor.ChildrenCount)); if FCursor.ChildrenCount < Length(FCursor.Children) then begin NewNode := TJclTreeNode.Create; NewNode.Value := AObject; NewNode.Parent := FCursor; for I := FCursor.ChildrenCount - 1 downto Index do FCursor.Children[I + 1] := FCursor.Children[I]; FCursor.Children[Index] := NewNode; Inc(FCursor.ChildrenCount); Inc(FOwnTree.FSize); end; end; {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; function TJclTreeIterator.IteratorEquals(const AIterator: IJclIterator): Boolean; var Obj: TObject; ItrObj: TJclTreeIterator; begin Result := False; if AIterator = nil then Exit; Obj := AIterator.GetIteratorReference; if Obj is TJclTreeIterator then begin ItrObj := TJclTreeIterator(Obj); Result := (FOwnTree = ItrObj.FOwnTree) and (FCursor = ItrObj.FCursor) and (Valid = ItrObj.Valid); end; end; {$IFDEF SUPPORTS_FOR_IN} function TJclTreeIterator.MoveNext: Boolean; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} if Valid then FCursor := GetNextCursor else Valid := True; Result := FCursor <> nil; {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; {$ENDIF SUPPORTS_FOR_IN} function TJclTreeIterator.Next: TObject; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} if Valid then FCursor := GetNextCursor else Valid := True; Result := nil; if FCursor <> nil then Result := FCursor.Value else if not FOwnTree.ReturnDefaultElements then raise EJclNoSuchElementError.Create(''); {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; function TJclTreeIterator.NextIndex: Integer; begin // No index raise EJclOperationNotSupportedError.Create; end; function TJclTreeIterator.Parent: TObject; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} Result := nil; if FCursor <> nil then FCursor := FCursor.Parent; if FCursor <> nil then Result := FCursor.Value else if not FOwnTree.ReturnDefaultElements then raise EJclNoSuchElementError.Create(''); {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; function TJclTreeIterator.Previous: TObject; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} if Valid then FCursor := GetPreviousCursor else Valid := True; Result := nil; if FCursor <> nil then Result := FCursor.Value else if not FOwnTree.ReturnDefaultElements then raise EJclNoSuchElementError.Create(''); {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; function TJclTreeIterator.PreviousIndex: Integer; begin // No index raise EJclOperationNotSupportedError.Create; end; procedure TJclTreeIterator.Remove; var OldCursor: TJclTreeNode; begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} CheckValid; Valid := False; OldCursor := FCursor; FCursor := GetNextSibling; if OldCursor <> nil then FOwnTree.RemoveNode(OldCursor); {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; procedure TJclTreeIterator.Reset; var NewCursor: TJclTreeNode; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} Valid := False; case FStart of isFirst: begin NewCursor := FCursor; while NewCursor <> nil do begin NewCursor := GetPreviousCursor; if NewCursor <> nil then FCursor := NewCursor; end; end; isLast: begin NewCursor := FCursor; while NewCursor <> nil do begin NewCursor := GetNextCursor; if NewCursor <> nil then FCursor := NewCursor; end; end; isRoot: begin while (FCursor <> nil) and (FCursor.Parent <> nil) do FCursor := FCursor.Parent; end; end; {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; procedure TJclTreeIterator.SetChild(Index: Integer; AObject: TObject); begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} if (FCursor <> nil) and (Index >= 0) and (Index < FCursor.ChildrenCount) then TJclTreeNode(FCursor.Children[Index]).Value := AObject else raise EJclOutOfBoundsError.Create; {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; procedure TJclTreeIterator.SetObject(AObject: TObject); begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} CheckValid; if FCursor <> nil then begin FOwnTree.FreeObject(FCursor.Value); FCursor.Value := AObject; end; {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; //=== { TJclPreOrderTreeIterator } =================================================== function TJclPreOrderTreeIterator.CreateEmptyIterator: TJclAbstractIterator; begin Result := TJclPreOrderTreeIterator.Create(FOwnTree, FCursor, Valid, FStart); end; function TJclPreOrderTreeIterator.GetNextCursor: TJclTreeNode; var LastRet: TJclTreeNode; begin Result := FCursor; if Result = nil then Exit; LastRet := Result; if Result.ChildrenCount > 0 then Result := TJclTreeNode(Result.Children[0]) else begin Result := Result.Parent; while (Result <> nil) and (Result.IndexOfChild(LastRet) = (Result.ChildrenCount - 1)) do begin LastRet := Result; Result := Result.Parent; end; if Result <> nil then // not root = return successor Result := TJclTreeNode(Result.Children[Result.IndexOfChild(LastRet) + 1]); end; end; function TJclPreOrderTreeIterator.GetNextSibling: TJclTreeNode; var LastRet: TJclTreeNode; begin Result := FCursor; if Result = nil then Exit; LastRet := Result; Result := Result.Parent; while (Result <> nil) and (Result.IndexOfChild(LastRet) = (Result.ChildrenCount - 1)) do begin LastRet := Result; Result := Result.Parent; end; if Result <> nil then // not root = return successor Result := TJclTreeNode(Result.Children[Result.IndexOfChild(LastRet) + 1]); end; function TJclPreOrderTreeIterator.GetPreviousCursor: TJclTreeNode; var LastRet: TJclTreeNode; begin Result := FCursor; if Result = nil then Exit; LastRet := Result; Result := Result.Parent; if (Result <> nil) and (Result.IndexOfChild(LastRet) > 0) then // come from Right begin Result := TJclTreeNode(Result.Children[Result.IndexOfChild(LastRet) - 1]); while (Result.ChildrenCount > 0) do // descend down the tree Result := TJclTreeNode(Result.Children[Result.ChildrenCount - 1]); end; end; //=== { TJclPostOrderTreeIterator } ================================================== function TJclPostOrderTreeIterator.CreateEmptyIterator: TJclAbstractIterator; begin Result := TJclPostOrderTreeIterator.Create(FOwnTree, FCursor, Valid, FStart); end; function TJclPostOrderTreeIterator.GetNextCursor: TJclTreeNode; var LastRet: TJclTreeNode; begin Result := FCursor; if Result = nil then Exit; LastRet := Result; Result := Result.Parent; if (Result <> nil) and (Result.IndexOfChild(LastRet) <> (Result.ChildrenCount - 1)) then begin Result := TJclTreeNode(Result.Children[Result.IndexOfChild(LastRet) + 1]); while Result.ChildrenCount > 0 do Result := TJclTreeNode(Result.Children[0]); end; end; function TJclPostOrderTreeIterator.GetNextSibling: TJclTreeNode; var LastRet: TJclTreeNode; begin Result := FCursor; if Result = nil then Exit; LastRet := Result; Result := Result.Parent; if (Result <> nil) and (Result.IndexOfChild(LastRet) <> (Result.ChildrenCount - 1)) then begin Result := TJclTreeNode(Result.Children[Result.IndexOfChild(LastRet) + 1]); while Result.ChildrenCount > 0 do Result := TJclTreeNode(Result.Children[0]); end; end; function TJclPostOrderTreeIterator.GetPreviousCursor: TJclTreeNode; var LastRet: TJclTreeNode; begin Result := FCursor; if Result = nil then Exit; if Result.ChildrenCount > 0 then Result := TJclTreeNode(Result.Children[Result.ChildrenCount - 1]) else begin LastRet := Result; Result := Result.Parent; while (Result <> nil) and (Result.IndexOfChild(LastRet) = 0) do begin LastRet := Result; Result := Result.Parent; end; if Result <> nil then // not root Result := TJclTreeNode(Result.Children[Result.IndexOfChild(LastRet) - 1]); end; end; {$IFDEF SUPPORTS_GENERICS} //=== { TJclTreeNode } ======================================================= function TJclTreeNode.IndexOfChild(AChild: TJclTreeNode): Integer; begin for Result := 0 to ChildrenCount - 1 do if Children[Result] = AChild then Exit; Result := -1; end; function TJclTreeNode.IndexOfValue(const AItem: T; const AEqualityComparer: IJclEqualityComparer): Integer; begin for Result := 0 to ChildrenCount - 1 do if AEqualityComparer.ItemsEqual(TJclTreeNode(Children[Result]).Value, AItem) then Exit; Result := -1; end; //=== { TJclTree } ======================================================= constructor TJclTree.Create(AOwnsItems: Boolean); begin inherited Create(AOwnsItems); FTraverseOrder := toPreOrder; end; destructor TJclTree.Destroy; begin FReadOnly := False; Clear; inherited Destroy; end; function TJclTree.Add(const AItem: T): Boolean; var NewNode: TTreeNode; begin if ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginWrite; try {$ENDIF THREADSAFE} Result := AllowDefaultElements or not ItemsEqual(AItem, Default(T)); if Result then begin if FRoot <> nil then begin Result := (not Contains(AItem)) or CheckDuplicate; if Result then begin if FRoot.ChildrenCount = Length(FRoot.Children) then SetLength(FRoot.Children, CalcGrowCapacity(Length(FRoot.Children), FRoot.ChildrenCount)); if FRoot.ChildrenCount < Length(FRoot.Children) then begin NewNode := TTreeNode.Create; NewNode.Value := AItem; NewNode.Parent := FRoot; FRoot.Children[FRoot.ChildrenCount] := NewNode; Inc(FRoot.ChildrenCount); Inc(FSize); end else Result := False; end; end else begin FRoot := TTreeNode.Create; FRoot.Value := AItem; Inc(FSize); end; end; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndWrite; end; {$ENDIF THREADSAFE} end; function TJclTree.AddAll(const ACollection: IJclCollection): Boolean; var It: IJclIterator; begin if ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginWrite; try {$ENDIF THREADSAFE} Result := False; if ACollection = nil then Exit; Result := True; It := ACollection.First; while It.HasNext do Result := Add(It.Next) and Result; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndWrite; end; {$ENDIF THREADSAFE} end; procedure TJclTree.AssignDataTo(Dest: TJclAbstractContainerBase); var ADest: TJclTree; ACollection: IJclCollection; begin inherited AssignDataTo(Dest); if Dest is TJclTree then begin ADest := TJclTree(Dest); ADest.Clear; ADest.FSize := FSize; if FRoot <> nil then ADest.FRoot := CloneNode(FRoot, nil); end else if Supports(IInterface(Dest), IJclCollection, ACollection) then begin ACollection.Clear; ACollection.AddAll(Self); end; end; procedure TJclTree.AssignPropertiesTo(Dest: TJclAbstractContainerBase); begin inherited AssignPropertiesto(Dest); if Dest is TJclTree then TJclTree(Dest).FTraverseOrder := FTraverseOrder; end; procedure TJclTree.Clear; begin if ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginWrite; try {$ENDIF THREADSAFE} if FRoot <> nil then RemoveNode(FRoot); FSize := 0; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndWrite; end; {$ENDIF THREADSAFE} end; function TJclTree.CloneNode(Node, Parent: TTreeNode): TTreeNode; var Index: Integer; begin Result := TTreeNode.Create; Result.Value := Node.Value; Result.Parent := Parent; SetLength(Result.Children, Node.ChildrenCount); Result.ChildrenCount := Node.ChildrenCount; for Index := 0 to Node.ChildrenCount - 1 do Result.Children[Index] := CloneNode(TTreeNode(Node.Children[Index]), Result); // recursive call end; function TJclTree.CollectionEquals(const ACollection: IJclCollection): Boolean; var It, ItSelf: IJclIterator; begin {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginRead; try {$ENDIF THREADSAFE} Result := False; if ACollection = nil then Exit; if FSize <> ACollection.Size then Exit; Result := True; It := ACollection.First; ItSelf := First; while ItSelf.HasNext do if not ItemsEqual(ItSelf.Next, It.Next) then begin Result := False; Break; end; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndRead; end; {$ENDIF THREADSAFE} end; function TJclTree.Contains(const AItem: T): Boolean; begin {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginRead; try {$ENDIF THREADSAFE} if FRoot <> nil then Result := NodeContains(FRoot, AItem) else Result := False; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndRead; end; {$ENDIF THREADSAFE} end; function TJclTree.ContainsAll(const ACollection: IJclCollection): Boolean; var It: IJclIterator; begin {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginRead; try {$ENDIF THREADSAFE} Result := True; if ACollection = nil then Exit; It := ACollection.First; while Result and It.HasNext do Result := Contains(It.Next); {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndRead; end; {$ENDIF THREADSAFE} end; function TJclTree.Extract(const AItem: T): Boolean; var It: IJclIterator; begin if ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginWrite; try {$ENDIF THREADSAFE} Result := FRoot <> nil; if Result then begin It := First; while It.HasNext do if ItemsEqual(It.Next, AItem) then begin It.Extract; if RemoveSingleElement then Break; end; end; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndWrite; end; {$ENDIF THREADSAFE} end; function TJclTree.ExtractAll(const ACollection: IJclCollection): Boolean; var It: IJclIterator; begin if ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginWrite; try {$ENDIF THREADSAFE} Result := False; if ACollection = nil then Exit; Result := True; It := ACollection.First; while It.HasNext do Result := Extract(It.Next) and Result; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndWrite; end; {$ENDIF THREADSAFE} end; procedure TJclTree.ExtractNode(var ANode: TTreeNode); var Index, ChildIndex, NewCapacity: Integer; Parent: TTreeNode; begin for Index := ANode.ChildrenCount - 1 downto 0 do {$IFDEF BCB} ExtractNode(TTreeNode(ANode.Children[Index])); {$ELSE ~BCB} ExtractNode(ANode.Children[Index]); {$ENDIF ~BCB} Parent := ANode.Parent; if Parent <> nil then begin ChildIndex := Parent.IndexOfChild(ANode); for Index := ChildIndex + 1 to Parent.ChildrenCount - 1 do Parent.Children[Index - 1] := Parent.Children[Index]; Dec(Parent.ChildrenCount); NewCapacity := CalcPackCapacity(Length(Parent.Children), Parent.ChildrenCount); if NewCapacity < Length(Parent.Children) then SetLength(Parent.Children, NewCapacity); FreeAndNil(ANode); end else begin FreeAndNil(ANode); FRoot := nil; end; Dec(FSize); end; function TJclTree.First: IJclIterator; var Start: TTreeNode; begin {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginRead; try {$ENDIF THREADSAFE} Start := FRoot; case GetTraverseOrder of toPreOrder: Result := TPreOrderTreeIterator.Create(Self, Start, False, isFirst); toPostOrder: begin if Start <> nil then while (Start.ChildrenCount > 0) do Start := TTreeNode(Start.Children[0]); Result := TPostOrderTreeIterator.Create(Self, Start, False, isFirst); end; else Result := nil; end; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndRead; end; {$ENDIF THREADSAFE} end; {$IFDEF SUPPORTS_FOR_IN} function TJclTree.GetEnumerator: IJclIterator; begin Result := First; end; {$ENDIF SUPPORTS_FOR_IN} function TJclTree.GetRoot: IJclTreeIterator; begin {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginRead; try {$ENDIF THREADSAFE} case GetTraverseOrder of toPreOrder: Result := TPreOrderTreeIterator.Create(Self, FRoot, False, isRoot); toPostOrder: Result := TPostOrderTreeIterator.Create(Self, FRoot, False, isRoot); else Result := nil; end; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndRead; end; {$ENDIF THREADSAFE} end; function TJclTree.GetTraverseOrder: TJclTraverseOrder; begin Result := FTraverseOrder; end; function TJclTree.IsEmpty: Boolean; begin Result := FSize = 0; end; function TJclTree.Last: IJclIterator; var Start: TTreeNode; begin {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginRead; try {$ENDIF THREADSAFE} Start := FRoot; case FTraverseOrder of toPreOrder: begin if Start <> nil then while Start.ChildrenCount > 0 do Start := TTreeNode(Start.Children[Start.ChildrenCount - 1]); Result := TPreOrderTreeIterator.Create(Self, Start, False, isLast); end; toPostOrder: Result := TPostOrderTreeIterator.Create(Self, Start, False, isLast); else Result := nil; end; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndRead; end; {$ENDIF THREADSAFE} end; function TJclTree.NodeContains(ANode: TTreeNode; const AItem: T): Boolean; var Index: Integer; begin Result := ItemsEqual(ANode.Value, AItem); if not Result then for Index := 0 to ANode.ChildrenCount - 1 do begin Result := NodeContains(TTreeNode(ANode.Children[Index]), AItem); if Result then Break; end; end; procedure TJclTree.Pack; begin if ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginWrite; try {$ENDIF THREADSAFE} if FRoot <> nil then PackNode(FRoot); {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndWrite; end; {$ENDIF THREADSAFE} end; procedure TJclTree.PackNode(ANode: TTreeNode); var Index: Integer; begin SetLength(ANode.Children, ANode.ChildrenCount); for Index := 0 to ANode.ChildrenCount - 1 do PackNode(TTreeNode(ANode.Children[Index])); end; function TJclTree.Remove(const AItem: T): Boolean; var Extracted: T; begin if ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginWrite; try {$ENDIF THREADSAFE} Result := Extract(AItem); if Result then begin Extracted := AItem; FreeItem(Extracted); end; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndWrite; end; {$ENDIF THREADSAFE} end; function TJclTree.RemoveAll(const ACollection: IJclCollection): Boolean; var It: IJclIterator; begin if ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginWrite; try {$ENDIF THREADSAFE} Result := False; if ACollection = nil then Exit; Result := True; It := ACollection.First; while It.HasNext do Result := Remove(It.Next) and Result; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndWrite; end; {$ENDIF THREADSAFE} end; procedure TJclTree.RemoveNode(var ANode: TTreeNode); var Index, ChildIndex, NewCapacity: Integer; Parent: TTreeNode; begin for Index := ANode.ChildrenCount - 1 downto 0 do {$IFDEF BCB} RemoveNode(TTreeNode(ANode.Children[Index])); {$ELSE ~BCB} RemoveNode(ANode.Children[Index]); {$ENDIF ~BCB} FreeItem(ANode.Value); Parent := ANode.Parent; if Parent <> nil then begin ChildIndex := Parent.IndexOfChild(ANode); for Index := ChildIndex + 1 to Parent.ChildrenCount - 1 do Parent.Children[Index - 1] := Parent.Children[Index]; Dec(Parent.ChildrenCount); NewCapacity := CalcPackCapacity(Length(Parent.Children), Parent.ChildrenCount); if NewCapacity < Length(Parent.Children) then SetLength(Parent.Children, NewCapacity); FreeAndNil(ANode); end else begin FreeAndNil(ANode); FRoot := nil; end; Dec(FSize); end; function TJclTree.RetainAll(const ACollection: IJclCollection): Boolean; var It: IJclIterator; begin if ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} if FThreadSafe then SyncReaderWriter.BeginWrite; try {$ENDIF THREADSAFE} Result := False; if ACollection = nil then Exit; Result := True; It := First; while It.HasNext do if not ACollection.Contains(It.Next) then It.Remove; {$IFDEF THREADSAFE} finally if FThreadSafe then SyncReaderWriter.EndWrite; end; {$ENDIF THREADSAFE} end; procedure TJclTree.SetCapacity(Value: Integer); begin raise EJclOperationNotSupportedError.Create; end; procedure TJclTree.SetTraverseOrder(Value: TJclTraverseOrder); begin FTraverseOrder := Value; end; function TJclTree.Size: Integer; begin Result := FSize; end; //=== { TJclTreeIterator } =========================================================== constructor TJclTreeIterator.Create(OwnTree: TJclTree; ACursor: TJclTreeNode; AValid: Boolean; AStart: TItrStart); begin inherited Create(AValid); FCursor := ACursor; FOwnTree := OwnTree; FStart := AStart; FEqualityComparer := OwnTree as IJclEqualityComparer; end; function TJclTreeIterator.Add(const AItem: T): Boolean; var ParentNode, NewNode: TJclTreeNode; begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} // add sibling or, if FCursor is root node, behave like TJclTree.Add Result := (FCursor <> nil) and (FOwnTree.AllowDefaultElements or not FEqualityComparer.ItemsEqual(AItem, Default(T))) and ((not FOwnTree.Contains(AItem)) or FOwnTree.CheckDuplicate); if Result then begin ParentNode := FCursor.Parent; if ParentNode = nil then ParentNode := FCursor; if ParentNode.ChildrenCount = Length(ParentNode.Children) then SetLength(ParentNode.Children, FOwnTree.CalcGrowCapacity(Length(ParentNode.Children), ParentNode.ChildrenCount)); if ParentNode.ChildrenCount < Length(ParentNode.Children) then begin NewNode := TJclTreeNode.Create; NewNode.Value := AItem; NewNode.Parent := ParentNode; ParentNode.Children[ParentNode.ChildrenCount] := NewNode; Inc(ParentNode.ChildrenCount); Inc(FOwnTree.FSize); end; end; {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; function TJclTreeIterator.AddChild(const AItem: T): Boolean; var NewNode: TJclTreeNode; begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} Result := (FCursor <> nil) and (FOwnTree.AllowDefaultElements or not FEqualityComparer.ItemsEqual(AItem, Default(T))) and ((not FOwnTree.Contains(AItem)) or FOwnTree.CheckDuplicate); if Result then begin if FCursor.ChildrenCount = Length(FCursor.Children) then SetLength(FCursor.Children, FOwnTree.CalcGrowCapacity(Length(FCursor.Children), FCursor.ChildrenCount)); if FCursor.ChildrenCount < Length(FCursor.Children) then begin NewNode := TJclTreeNode.Create; NewNode.Value := AItem; NewNode.Parent := FCursor; FCursor.Children[FCursor.ChildrenCount] := NewNode; Inc(FCursor.ChildrenCount); Inc(FOwnTree.FSize); end; end; {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; procedure TJclTreeIterator.AssignPropertiesTo(Dest: TJclAbstractIterator); var ADest: TJclTreeIterator; begin inherited AssignPropertiesTo(Dest); if Dest is TJclTreeIterator then begin ADest := TJclTreeIterator(Dest); ADest.FCursor := FCursor; ADest.FOwnTree := FOwnTree; ADest.FEqualityComparer := FEqualityComparer; ADest.FStart := FStart; end; end; function TJclTreeIterator.ChildrenCount: Integer; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} if FCursor <> nil then Result := FCursor.ChildrenCount else Result := 0; {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; procedure TJclTreeIterator.DeleteChild(Index: Integer); begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} if (FCursor <> nil) and (Index >= 0) and (Index < FCursor.ChildrenCount) then {$IFDEF BCB} FOwnTree.RemoveNode(TJclTreeNode(FCursor.Children[Index])) {$ELSE ~BCB} FOwnTree.RemoveNode(FCursor.Children[Index]) {$ENDIF ~BCB} else raise EJclOutOfBoundsError.Create; {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; procedure TJclTreeIterator.DeleteChildren; var Index: Integer; begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} if FCursor <> nil then begin for Index := FCursor.ChildrenCount - 1 downto 0 do {$IFDEF BCB} FOwnTree.RemoveNode(TJclTreeNode(FCursor.Children[Index])); {$ELSE ~BCB} FOwnTree.RemoveNode(FCursor.Children[Index]); {$ENDIF ~BCB} SetLength(FCursor.Children, 0); FCursor.ChildrenCount := 0; end; {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; procedure TJclTreeIterator.Extract; var OldCursor: TJclTreeNode; begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} CheckValid; Valid := False; OldCursor := FCursor; FCursor := GetNextSibling; if OldCursor <> nil then FOwnTree.ExtractNode(OldCursor); {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; procedure TJclTreeIterator.ExtractChild(Index: Integer); begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} if (FCursor <> nil) and (Index >= 0) and (Index < FCursor.ChildrenCount) then {$IFDEF BCB} FOwnTree.ExtractNode(TJclTreeNode(FCursor.Children[Index])) {$ELSE ~BCB} FOwnTree.ExtractNode(FCursor.Children[Index]) {$ENDIF ~BCB} else raise EJclOutOfBoundsError.Create; {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; procedure TJclTreeIterator.ExtractChildren; var Index: Integer; begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} if FCursor <> nil then begin for Index := FCursor.ChildrenCount - 1 downto 0 do {$IFDEF BCB} FOwnTree.ExtractNode(TJclTreeNode(FCursor.Children[Index])); {$ELSE ~BCB} FOwnTree.ExtractNode(FCursor.Children[Index]); {$ENDIF ~BCB} SetLength(FCursor.Children, 0); FCursor.ChildrenCount := 0; end; {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; function TJclTreeIterator.GetChild(Index: Integer): T; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} Result := Default(T); if (FCursor <> nil) and (Index >= 0) and (Index < FCursor.ChildrenCount) then FCursor := TJclTreeNode(FCursor.Children[Index]); if FCursor <> nil then Result := FCursor.Value else if not FOwnTree.ReturnDefaultElements then raise EJclNoSuchElementError.Create(''); {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; function TJclTreeIterator.GetItem: T; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} CheckValid; Result := Default(T); if FCursor <> nil then Result := FCursor.Value else if not FOwnTree.ReturnDefaultElements then raise EJclNoSuchElementError.Create(''); {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; function TJclTreeIterator.HasChild(Index: Integer): Boolean; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} Result := (FCursor <> nil) and (Index >= 0) and (Index < FCursor.ChildrenCount); {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; function TJclTreeIterator.HasNext: Boolean; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} if Valid then Result := GetNextCursor <> nil else Result := FCursor <> nil; {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; function TJclTreeIterator.HasParent: Boolean; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} Result := (FCursor <> nil) and (FCursor.Parent <> nil); {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; function TJclTreeIterator.HasPrevious: Boolean; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} if Valid then Result := GetPreviousCursor <> nil else Result := FCursor <> nil; {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; function TJclTreeIterator.IndexOfChild(const AItem: T): Integer; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} if FCursor <> nil then Result := FCursor.IndexOfValue(AItem, FEqualityComparer) else Result := -1; {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; function TJclTreeIterator.Insert(const AItem: T): Boolean; var ParentNode, NewNode: TJclTreeNode; Index, I: Integer; begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} // insert sibling or, if FCursor is root node, behave like TJclTree.Insert Result := (FCursor <> nil) and (FOwnTree.AllowDefaultElements or not FEqualityComparer.ItemsEqual(AItem, Default(T))) and ((not FOwnTree.Contains(AItem)) or FOwnTree.CheckDuplicate); if Result then begin if FCursor.Parent <> nil then begin ParentNode := FCursor.Parent; Index := 0; while (Index < ParentNode.ChildrenCount) and (ParentNode.Children[Index] <> FCursor) do Inc(Index); end else begin ParentNode := FCursor; Index := 0; end; if ParentNode.ChildrenCount = Length(ParentNode.Children) then SetLength(ParentNode.Children, FOwnTree.CalcGrowCapacity(Length(ParentNode.Children), ParentNode.ChildrenCount)); if ParentNode.ChildrenCount < Length(ParentNode.Children) then begin NewNode := TJclTreeNode.Create; NewNode.Value := AItem; NewNode.Parent := ParentNode; for I := ParentNode.ChildrenCount - 1 downto Index do ParentNode.Children[I + 1] := ParentNode.Children[I]; ParentNode.Children[Index] := NewNode; Inc(ParentNode.ChildrenCount); Inc(FOwnTree.FSize); end; end; {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; function TJclTreeIterator.InsertChild(Index: Integer; const AItem: T): Boolean; var NewNode: TJclTreeNode; I: Integer; begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} // insert sibling or, if FCursor is root node, behave like TJclTree.Insert Result := (FCursor <> nil) and (FOwnTree.AllowDefaultElements or not FEqualityComparer.ItemsEqual(AItem, Default(T))) and ((not FOwnTree.Contains(AItem)) or FOwnTree.CheckDuplicate); if Result then begin if FCursor.ChildrenCount = Length(FCursor.Children) then SetLength(FCursor.Children, FOwnTree.CalcGrowCapacity(Length(FCursor.Children), FCursor.ChildrenCount)); if FCursor.ChildrenCount < Length(FCursor.Children) then begin NewNode := TJclTreeNode.Create; NewNode.Value := AItem; NewNode.Parent := FCursor; for I := FCursor.ChildrenCount - 1 downto Index do FCursor.Children[I + 1] := FCursor.Children[I]; FCursor.Children[Index] := NewNode; Inc(FCursor.ChildrenCount); Inc(FOwnTree.FSize); end; end; {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; function TJclTreeIterator.IteratorEquals(const AIterator: IJclIterator): Boolean; var Obj: TObject; ItrObj: TJclTreeIterator; begin Result := False; if AIterator = nil then Exit; Obj := AIterator.GetIteratorReference; if Obj is TJclTreeIterator then begin ItrObj := TJclTreeIterator(Obj); Result := (FOwnTree = ItrObj.FOwnTree) and (FCursor = ItrObj.FCursor) and (Valid = ItrObj.Valid); end; end; {$IFDEF SUPPORTS_FOR_IN} function TJclTreeIterator.MoveNext: Boolean; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} if Valid then FCursor := GetNextCursor else Valid := True; Result := FCursor <> nil; {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; {$ENDIF SUPPORTS_FOR_IN} function TJclTreeIterator.Next: T; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} if Valid then FCursor := GetNextCursor else Valid := True; Result := Default(T); if FCursor <> nil then Result := FCursor.Value else if not FOwnTree.ReturnDefaultElements then raise EJclNoSuchElementError.Create(''); {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; function TJclTreeIterator.NextIndex: Integer; begin // No index raise EJclOperationNotSupportedError.Create; end; function TJclTreeIterator.Parent: T; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} Result := Default(T); if FCursor <> nil then FCursor := FCursor.Parent; if FCursor <> nil then Result := FCursor.Value else if not FOwnTree.ReturnDefaultElements then raise EJclNoSuchElementError.Create(''); {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; function TJclTreeIterator.Previous: T; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} if Valid then FCursor := GetPreviousCursor else Valid := True; Result := Default(T); if FCursor <> nil then Result := FCursor.Value else if not FOwnTree.ReturnDefaultElements then raise EJclNoSuchElementError.Create(''); {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; function TJclTreeIterator.PreviousIndex: Integer; begin // No index raise EJclOperationNotSupportedError.Create; end; procedure TJclTreeIterator.Remove; var OldCursor: TJclTreeNode; begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} CheckValid; Valid := False; OldCursor := FCursor; FCursor := GetNextSibling; if OldCursor <> nil then FOwnTree.RemoveNode(OldCursor); {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; procedure TJclTreeIterator.Reset; var NewCursor: TJclTreeNode; begin {$IFDEF THREADSAFE} FOwnTree.ReadLock; try {$ENDIF THREADSAFE} Valid := False; case FStart of isFirst: begin NewCursor := FCursor; while NewCursor <> nil do begin NewCursor := GetPreviousCursor; if NewCursor <> nil then FCursor := NewCursor; end; end; isLast: begin NewCursor := FCursor; while NewCursor <> nil do begin NewCursor := GetNextCursor; if NewCursor <> nil then FCursor := NewCursor; end; end; isRoot: begin while (FCursor <> nil) and (FCursor.Parent <> nil) do FCursor := FCursor.Parent; end; end; {$IFDEF THREADSAFE} finally FOwnTree.ReadUnlock; end; {$ENDIF THREADSAFE} end; procedure TJclTreeIterator.SetChild(Index: Integer; const AItem: T); begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} if (FCursor <> nil) and (Index >= 0) and (Index < FCursor.ChildrenCount) then TJclTreeNode(FCursor.Children[Index]).Value := AItem else raise EJclOutOfBoundsError.Create; {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; procedure TJclTreeIterator.SetItem(const AItem: T); begin if FOwnTree.ReadOnly then raise EJclReadOnlyError.Create; {$IFDEF THREADSAFE} FOwnTree.WriteLock; try {$ENDIF THREADSAFE} CheckValid; if FCursor <> nil then begin FOwnTree.FreeItem(FCursor.Value); FCursor.Value := AItem; end; {$IFDEF THREADSAFE} finally FOwnTree.WriteUnlock; end; {$ENDIF THREADSAFE} end; //=== { TJclPreOrderTreeIterator } =================================================== function TJclPreOrderTreeIterator.CreateEmptyIterator: TJclAbstractIterator; begin Result := TJclPreOrderTreeIterator.Create(FOwnTree, FCursor, Valid, FStart); end; function TJclPreOrderTreeIterator.GetNextCursor: TJclTreeNode; var LastRet: TJclTreeNode; begin Result := FCursor; if Result = nil then Exit; LastRet := Result; if Result.ChildrenCount > 0 then Result := TJclTreeNode(Result.Children[0]) else begin Result := Result.Parent; while (Result <> nil) and (Result.IndexOfChild(LastRet) = (Result.ChildrenCount - 1)) do begin LastRet := Result; Result := Result.Parent; end; if Result <> nil then // not root = return successor Result := TJclTreeNode(Result.Children[Result.IndexOfChild(LastRet) + 1]); end; end; function TJclPreOrderTreeIterator.GetNextSibling: TJclTreeNode; var LastRet: TJclTreeNode; begin Result := FCursor; if Result = nil then Exit; LastRet := Result; Result := Result.Parent; while (Result <> nil) and (Result.IndexOfChild(LastRet) = (Result.ChildrenCount - 1)) do begin LastRet := Result; Result := Result.Parent; end; if Result <> nil then // not root = return successor Result := TJclTreeNode(Result.Children[Result.IndexOfChild(LastRet) + 1]); end; function TJclPreOrderTreeIterator.GetPreviousCursor: TJclTreeNode; var LastRet: TJclTreeNode; begin Result := FCursor; if Result = nil then Exit; LastRet := Result; Result := Result.Parent; if (Result <> nil) and (Result.IndexOfChild(LastRet) > 0) then // come from Right begin Result := TJclTreeNode(Result.Children[Result.IndexOfChild(LastRet) - 1]); while (Result.ChildrenCount > 0) do // descend down the tree Result := TJclTreeNode(Result.Children[Result.ChildrenCount - 1]); end; end; //=== { TJclPostOrderTreeIterator } ================================================== function TJclPostOrderTreeIterator.CreateEmptyIterator: TJclAbstractIterator; begin Result := TJclPostOrderTreeIterator.Create(FOwnTree, FCursor, Valid, FStart); end; function TJclPostOrderTreeIterator.GetNextCursor: TJclTreeNode; var LastRet: TJclTreeNode; begin Result := FCursor; if Result = nil then Exit; LastRet := Result; Result := Result.Parent; if (Result <> nil) and (Result.IndexOfChild(LastRet) <> (Result.ChildrenCount - 1)) then begin Result := TJclTreeNode(Result.Children[Result.IndexOfChild(LastRet) + 1]); while Result.ChildrenCount > 0 do Result := TJclTreeNode(Result.Children[0]); end; end; function TJclPostOrderTreeIterator.GetNextSibling: TJclTreeNode; var LastRet: TJclTreeNode; begin Result := FCursor; if Result = nil then Exit; LastRet := Result; Result := Result.Parent; if (Result <> nil) and (Result.IndexOfChild(LastRet) <> (Result.ChildrenCount - 1)) then begin Result := TJclTreeNode(Result.Children[Result.IndexOfChild(LastRet) + 1]); while Result.ChildrenCount > 0 do Result := TJclTreeNode(Result.Children[0]); end; end; function TJclPostOrderTreeIterator.GetPreviousCursor: TJclTreeNode; var LastRet: TJclTreeNode; begin Result := FCursor; if Result = nil then Exit; if Result.ChildrenCount > 0 then Result := TJclTreeNode(Result.Children[Result.ChildrenCount - 1]) else begin LastRet := Result; Result := Result.Parent; while (Result <> nil) and (Result.IndexOfChild(LastRet) = 0) do begin LastRet := Result; Result := Result.Parent; end; if Result <> nil then // not root Result := TJclTreeNode(Result.Children[Result.IndexOfChild(LastRet) - 1]); end; end; //=== { TJclTreeE } ======================================================= constructor TJclTreeE.Create(const AEqualityComparer: IJclEqualityComparer; AOwnsItems: Boolean); begin inherited Create(AOwnsItems); FEqualityComparer := AEqualityComparer; end; procedure TJclTreeE.AssignPropertiesTo(Dest: TJclAbstractContainerBase); begin inherited AssignPropertiesTo(Dest); if Dest is TJclTreeE then TJclTreeE(Dest).FEqualityComparer := FEqualityComparer; end; function TJclTreeE.CreateEmptyContainer: TJclAbstractContainerBase; begin Result := TJclTreeE.Create(EqualityComparer, False); AssignPropertiesTo(Result); end; function TJclTreeE.ItemsEqual(const A, B: T): Boolean; begin if EqualityComparer <> nil then Result := EqualityComparer.ItemsEqual(A, B) else Result := inherited ItemsEqual(A, B); end; //=== { TJclTreeF } ======================================================= constructor TJclTreeF.Create(ACompare: TCompare; AOwnsItems: Boolean); begin inherited Create(AOwnsItems); SetCompare(ACompare); end; function TJclTreeF.CreateEmptyContainer: TJclAbstractContainerBase; begin Result := TJclTreeF.Create(Compare, False); AssignPropertiesTo(Result); end; //=== { TJclTreeI } ======================================================= function TJclTreeI.CreateEmptyContainer: TJclAbstractContainerBase; begin Result := TJclTreeI.Create(False); AssignPropertiesTo(Result); end; function TJclTreeI.ItemsEqual(const A, B: T): Boolean; begin if Assigned(FEqualityCompare) then Result := FEqualityCompare(A, B) else Result := A.Equals(B); end; {$ENDIF SUPPORTS_GENERICS} {$IFDEF UNITVERSIONING} initialization RegisterUnitVersion(HInstance, UnitVersioning); finalization UnregisterUnitVersion(HInstance); {$ENDIF UNITVERSIONING} end.