{**************************************************************************************************} { } { 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 Vector.pas. } { } { The Initial Developer of the Original Code is Jean-Philippe BEMPEL aka RDM. Portions created by } { Jean-Philippe BEMPEL are Copyright (C) Jean-Philippe BEMPEL (rdm_30 att yahoo dott com) } { All rights reserved. } { } { Contributors: } { Daniele Teti (dade2004) } { Robert Marquardt (marquardt) } { Robert Rossmair (rrossmair) } { } {**************************************************************************************************} { } { The Delphi Container Library } { } {**************************************************************************************************} // Last modified: $Date: 2005/05/05 20:08:46 $ // For history see end of file unit JclVectors; {$I jcl.inc} interface uses Classes, JclBase, JclAbstractContainers, JclContainerIntf; type TJclIntfVector = class(TJclAbstractContainer, IJclIntfCollection, IJclIntfList, IJclIntfArray, IJclIntfCloneable) private FCount: Integer; FCapacity: Integer; FItems: TDynIInterfaceArray; protected procedure Grow; virtual; { IJclCloneable } function Clone: IInterface; public { IJclIntfCollection } function Add(AInterface: IInterface): Boolean; overload; function AddAll(ACollection: IJclIntfCollection): Boolean; overload; procedure Clear; function Contains(AInterface: IInterface): Boolean; function ContainsAll(ACollection: IJclIntfCollection): Boolean; function Equals(ACollection: IJclIntfCollection): Boolean; function First: IJclIntfIterator; function IsEmpty: Boolean; function Last: IJclIntfIterator; function Remove(AInterface: IInterface): Boolean; overload; function RemoveAll(ACollection: IJclIntfCollection): Boolean; function RetainAll(ACollection: IJclIntfCollection): Boolean; function Size: Integer; { IJclIntfList } procedure Insert(Index: Integer; AInterface: IInterface); overload; function InsertAll(Index: Integer; ACollection: IJclIntfCollection): Boolean; overload; function GetObject(Index: Integer): IInterface; function IndexOf(AInterface: IInterface): Integer; function LastIndexOf(AInterface: IInterface): Integer; function Remove(Index: Integer): IInterface; overload; procedure SetObject(Index: Integer; AInterface: IInterface); function SubList(First, Count: Integer): IJclIntfList; constructor Create(ACapacity: Integer = DefaultContainerCapacity); destructor Destroy; override; {$IFNDEF CLR} procedure AfterConstruction; override; // Do not decrement RefCount because iterator inc/dec it. procedure BeforeDestruction; override; {$ENDIF ~CLR} property Items: TDynIInterfaceArray read FItems; end; //Daniele Teti 02/03/2005 TJclStrVector = class(TJclStrCollection, IJclStrList, IJclStrArray, IJclCloneable) private FCount: Integer; FCapacity: Integer; FItems: TDynStringArray; protected procedure Grow; virtual; { IJclCloneable } function Clone: TObject; public { IJclStrCollection } function Add(const AString: string): Boolean; overload; override; function AddAll(ACollection: IJclStrCollection): Boolean; overload; override; procedure Clear; override; function Contains(const AString: string): Boolean; override; function ContainsAll(ACollection: IJclStrCollection): Boolean; override; function Equals(ACollection: IJclStrCollection): Boolean; override; function First: IJclStrIterator; override; function IsEmpty: Boolean; override; function Last: IJclStrIterator; override; function Remove(const AString: string): Boolean; overload; override; function RemoveAll(ACollection: IJclStrCollection): Boolean; override; function RetainAll(ACollection: IJclStrCollection): Boolean; override; function Size: Integer; override; { IJclStrList } procedure Insert(Index: Integer; const AString: string); overload; function InsertAll(Index: Integer; ACollection: IJclStrCollection): Boolean; overload; function GetString(Index: Integer): string; function IndexOf(const AString: string): Integer; function LastIndexOf(const AString: string): Integer; function Remove(Index: Integer): string; overload; procedure SetString(Index: Integer; const AString: string); function SubList(First, Count: Integer): IJclStrList; constructor Create(ACapacity: Integer = DefaultContainerCapacity); destructor Destroy; override; {$IFNDEF CLR} procedure AfterConstruction; override; // Do not decrement RefCount because iterator inc/dec it. procedure BeforeDestruction; override; {$ENDIF ~CLR} property Items: TDynStringArray read FItems; end; TJclVector = class(TJclAbstractContainer, IJclCollection, IJclList, IJclArray, IJclCloneable) private FCount: Integer; FCapacity: Integer; FOwnsObjects: Boolean; FItems: TDynObjectArray; protected procedure Grow; virtual; procedure FreeObject(var AObject: TObject); public { IJclCollection } function Add(AObject: TObject): Boolean; overload; function AddAll(ACollection: IJclCollection): Boolean; overload; procedure Clear; function Contains(AObject: TObject): Boolean; function ContainsAll(ACollection: IJclCollection): Boolean; function Equals(ACollection: IJclCollection): Boolean; function First: IJclIterator; function IsEmpty: Boolean; function Last: IJclIterator; function Remove(AObject: TObject): Boolean; overload; function RemoveAll(ACollection: IJclCollection): Boolean; function RetainAll(ACollection: IJclCollection): Boolean; function Size: Integer; { IJclList } procedure Insert(Index: Integer; AObject: TObject); overload; function InsertAll(Index: Integer; ACollection: IJclCollection): Boolean; overload; function GetObject(Index: Integer): TObject; function IndexOf(AObject: TObject): Integer; function LastIndexOf(AObject: TObject): Integer; function Remove(Index: Integer): TObject; overload; procedure SetObject(Index: Integer; AObject: TObject); function SubList(First, Count: Integer): IJclList; { IJclCloneable } function Clone: TObject; constructor Create(ACapacity: Integer = DefaultContainerCapacity; AOwnsObjects: Boolean = True); destructor Destroy; override; {$IFNDEF CLR} procedure AfterConstruction; override; // Do not decrement RefCount because iterator inc/dec it. procedure BeforeDestruction; override; {$ENDIF ~CLR} property Items: TDynObjectArray read FItems; property OwnsObjects: Boolean read FOwnsObjects; end; implementation uses JclResources; //=== { TIntfItr } =========================================================== type TIntfItr = class(TJclAbstractContainer, IJclIntfIterator) private FCursor: Integer; FOwnList: TJclIntfVector; FLastRet: Integer; FSize: Integer; protected { IJclIntfIterator} procedure Add(AInterface: IInterface); function GetObject: IInterface; function HasNext: Boolean; function HasPrevious: Boolean; function Next: IInterface; function NextIndex: Integer; function Previous: IInterface; function PreviousIndex: Integer; procedure Remove; procedure SetObject(AInterface: IInterface); public constructor Create(OwnList: TJclIntfVector); {$IFNDEF CLR} destructor Destroy; override; {$ENDIF ~CLR} end; constructor TIntfItr.Create(OwnList: TJclIntfVector); begin inherited Create; FCursor := 0; FOwnList := OwnList; {$IFNDEF CLR} FOwnList._AddRef; // Add a ref because FOwnList is not an interface ! {$ENDIF ~CLR} FLastRet := -1; FSize := FOwnList.Size; end; {$IFNDEF CLR} destructor TIntfItr.Destroy; begin FOwnList._Release; inherited Destroy; end; {$ENDIF ~CLR} procedure TIntfItr.Add(AInterface: IInterface); begin FOwnList.Insert(FCursor, AInterface); Inc(FSize); Inc(FCursor); FLastRet := -1; end; function TIntfItr.GetObject: IInterface; begin Result := FOwnList.Items[FCursor]; end; function TIntfItr.HasNext: Boolean; begin Result := FCursor <> FSize; end; function TIntfItr.HasPrevious: Boolean; begin Result := FCursor > 0; end; function TIntfItr.Next: IInterface; begin Result := FOwnList.Items[FCursor]; FLastRet := FCursor; Inc(FCursor); end; function TIntfItr.NextIndex: Integer; begin Result := FCursor; end; function TIntfItr.Previous: IInterface; begin Dec(FCursor); FLastRet := FCursor; Result := FOwnList.Items[FCursor]; end; function TIntfItr.PreviousIndex: Integer; begin Result := FCursor - 1; end; procedure TIntfItr.Remove; begin with FOwnList do begin FItems[FCursor] := nil; // Force Release MoveArray(FItems, FCursor + 1, FCursor, FSize - FCursor); end; Dec(FOwnList.FCount); Dec(FSize); end; procedure TIntfItr.SetObject(AInterface: IInterface); begin FOwnList.Items[FCursor] := AInterface; end; //=== { TStrItr } ============================================================ type TStrItr = class(TJclAbstractContainer, IJclStrIterator) private FCursor: Integer; FOwnList: TJclStrVector; FLastRet: Integer; FSize: Integer; protected { IJclStrIterator} procedure Add(const AString: string); function GetString: string; function HasNext: Boolean; function HasPrevious: Boolean; function Next: string; function NextIndex: Integer; function Previous: string; function PreviousIndex: Integer; procedure Remove; procedure SetString(const AString: string); public constructor Create(OwnList: TJclStrVector); {$IFNDEF CLR} destructor Destroy; override; {$ENDIF ~CLR} end; constructor TStrItr.Create(OwnList: TJclStrVector); begin inherited Create; FCursor := 0; FOwnList := OwnList; {$IFNDEF CLR} FOwnList._AddRef; // Add a ref because FOwnList is not an interface ! {$ENDIF ~CLR} FLastRet := -1; FSize := FOwnList.Size; end; {$IFNDEF CLR} destructor TStrItr.Destroy; begin FOwnList._Release; inherited Destroy; end; {$ENDIF ~CLR} procedure TStrItr.Add(const AString: string); begin FOwnList.Insert(FCursor, AString); Inc(FSize); Inc(FCursor); FLastRet := -1; end; function TStrItr.GetString: string; begin Result := FOwnList.Items[FCursor]; end; function TStrItr.HasNext: Boolean; begin Result := FCursor < FSize; end; function TStrItr.HasPrevious: Boolean; begin Result := FCursor > 0; end; function TStrItr.Next: string; begin Result := FOwnList.Items[FCursor]; FLastRet := FCursor; Inc(FCursor); end; function TStrItr.NextIndex: Integer; begin Result := FCursor; end; function TStrItr.Previous: string; begin Dec(FCursor); FLastRet := FCursor; Result := FOwnList.Items[FCursor]; end; function TStrItr.PreviousIndex: Integer; begin Result := FCursor - 1; end; procedure TStrItr.Remove; begin with FOwnList do begin FItems[FCursor] := ''; // Force Release MoveArray(FItems, FCursor + 1, FCursor, FSize - FCursor); end; Dec(FOwnList.FCount); Dec(FSize); end; procedure TStrItr.SetString(const AString: string); begin { if FLastRet = -1 then raise EJclIllegalState.Create(SIllegalState); } FOwnList.Items[FCursor] := AString; end; //=== { TItr } =============================================================== type TItr = class(TJclAbstractContainer, IJclIterator) private FCursor: Integer; FOwnList: TJclVector; FLastRet: Integer; FSize: Integer; protected { IJclIterator} procedure Add(AObject: TObject); function GetObject: TObject; function HasNext: Boolean; function HasPrevious: Boolean; function Next: TObject; function NextIndex: Integer; function Previous: TObject; function PreviousIndex: Integer; procedure Remove; procedure SetObject(AObject: TObject); public constructor Create(OwnList: TJclVector); {$IFNDEF CLR} destructor Destroy; override; {$ENDIF ~CLR} end; constructor TItr.Create(OwnList: TJclVector); begin inherited Create; FCursor := 0; FOwnList := OwnList; {$IFNDEF CLR} FOwnList._AddRef; // Add a ref because FOwnList is not an interface ! {$ENDIF ~CLR} FLastRet := -1; FSize := FOwnList.Size; end; {$IFNDEF CLR} destructor TItr.Destroy; begin FOwnList._Release; inherited Destroy; end; {$ENDIF ~CLR} procedure TItr.Add(AObject: TObject); begin FOwnList.Insert(FCursor, AObject); Inc(FSize); Inc(FCursor); FLastRet := -1; end; function TItr.GetObject: TObject; begin Result := FOwnList.Items[FCursor]; end; function TItr.HasNext: Boolean; begin Result := FCursor <> FSize; end; function TItr.HasPrevious: Boolean; begin Result := FCursor > 0; end; function TItr.Next: TObject; begin Result := FOwnList.Items[FCursor]; FLastRet := FCursor; Inc(FCursor); end; function TItr.NextIndex: Integer; begin Result := FCursor; end; function TItr.Previous: TObject; begin Dec(FCursor); FLastRet := FCursor; Result := FOwnList.Items[FCursor]; end; function TItr.PreviousIndex: Integer; begin Result := FCursor - 1; end; procedure TItr.Remove; begin with FOwnList do begin FreeObject(FItems[FCursor]); MoveArray(FItems, FCursor + 1, FCursor, FSize - FCursor); end; Dec(FOwnList.FCount); Dec(FSize); end; procedure TItr.SetObject(AObject: TObject); begin { if FLastRet = -1 then raise EJclIllegalState.Create(SIllegalState); } FOwnList.Items[FCursor] := AObject; end; //=== { TJclIntfVector } ===================================================== constructor TJclIntfVector.Create(ACapacity: Integer = DefaultContainerCapacity); begin inherited Create; FCount := 0; if ACapacity < 0 then FCapacity := 0 else FCapacity := ACapacity; SetLength(FItems, FCapacity); end; destructor TJclIntfVector.Destroy; begin Clear; inherited Destroy; end; procedure TJclIntfVector.Insert(Index: Integer; AInterface: IInterface); begin if (Index < 0) or (Index > FCount) then {$IFDEF CLR} raise EJclOutOfBoundsError.Create(RsEOutOfBounds); {$ELSE} raise EJclOutOfBoundsError.CreateRes(@RsEOutOfBounds); {$ENDIF CLR} if FCount = FCapacity then Grow; MoveArray(FItems, Index, Index + 1, FCount - Index); FItems[Index] := AInterface; Inc(FCount); end; function TJclIntfVector.Add(AInterface: IInterface): Boolean; begin if FCount = FCapacity then Grow; FItems[FCount] := AInterface; Inc(FCount); Result := True; end; function TJclIntfVector.InsertAll(Index: Integer; ACollection: IJclIntfCollection): Boolean; var It: IJclIntfIterator; Size: Integer; begin Result := False; if (Index < 0) or (Index >= FCount) then {$IFDEF CLR} raise EJclOutOfBoundsError.Create(RsEOutOfBounds); {$ELSE} raise EJclOutOfBoundsError.CreateRes(@RsEOutOfBounds); {$ENDIF CLR} if ACollection = nil then Exit; Size := ACollection.Size; if Size <> 0 then begin Inc(FCapacity, Size); SetLength(FItems, FCapacity); Inc(FCount, Size); MoveArray(FItems, Index, Index + Size, Size); It := ACollection.First; while It.HasNext do begin FItems[Index] := It.Next; Inc(Index); end; end; Result := True; end; function TJclIntfVector.AddAll(ACollection: IJclIntfCollection): Boolean; var It: IJclIntfIterator; begin Result := False; if ACollection = nil then Exit; It := ACollection.First; while It.HasNext do Add(It.Next); Result := True; end; procedure TJclIntfVector.Clear; var I: Integer; begin for I := 0 to FCount - 1 do FItems[I] := nil; FCount := 0; end; function TJclIntfVector.Clone: IInterface; var NewList: IJclIntfList; begin NewList := TJclIntfVector.Create(FCapacity); NewList.AddAll(Self); Result := NewList; end; function TJclIntfVector.Contains(AInterface: IInterface): Boolean; var I: Integer; begin Result := False; if AInterface = nil then Exit; for I := 0 to FCount - 1 do if Items[I] = AInterface then begin Result := True; Break; end; end; function TJclIntfVector.ContainsAll(ACollection: IJclIntfCollection): Boolean; var It: IJclIntfIterator; begin Result := True; if ACollection = nil then Exit; It := ACollection.First; while Result and It.HasNext do Result := Contains(It.Next); end; function TJclIntfVector.Equals(ACollection: IJclIntfCollection): Boolean; var I: Integer; It: IJclIntfIterator; begin Result := False; if ACollection = nil then Exit; if FCount <> ACollection.Size then Exit; It := ACollection.First; for I := 0 to FCount - 1 do if Items[I] <> It.Next then Exit; Result := True; end; function TJclIntfVector.GetObject(Index: Integer): IInterface; begin if (Index < 0) or (Index >= FCount) then begin Result := nil; Exit; end; Result := Items[Index]; end; procedure TJclIntfVector.Grow; begin if FCapacity > 64 then FCapacity := FCapacity + FCapacity div 4 else if FCapacity = 0 then FCapacity := 64 else FCapacity := FCapacity * 4; SetLength(FItems, FCapacity); end; function TJclIntfVector.IndexOf(AInterface: IInterface): Integer; var I: Integer; begin Result := -1; if AInterface = nil then Exit; for I := 0 to FCount - 1 do if Items[I] = AInterface then begin Result := I; Break; end; end; function TJclIntfVector.First: IJclIntfIterator; begin Result := TIntfItr.Create(Self); end; function TJclIntfVector.IsEmpty: Boolean; begin Result := FCount = 0; end; function TJclIntfVector.Last: IJclIntfIterator; var NewIterator: TIntfItr; begin NewIterator := TIntfItr.Create(Self); NewIterator.FCursor := NewIterator.FOwnList.FCount; NewIterator.FSize := NewIterator.FOwnList.FCount; Result := NewIterator; end; function TJclIntfVector.LastIndexOf(AInterface: IInterface): Integer; var I: Integer; begin Result := -1; if AInterface = nil then Exit; for I := FCount - 1 downto 0 do if Items[I] = AInterface then begin Result := I; Break; end; end; function TJclIntfVector.Remove(Index: Integer): IInterface; begin if (Index < 0) or (Index >= FCount) then {$IFDEF CLR} raise EJclOutOfBoundsError.Create(RsEOutOfBounds); {$ELSE} raise EJclOutOfBoundsError.CreateRes(@RsEOutOfBounds); {$ENDIF CLR} Result := FItems[Index]; FItems[Index] := nil; MoveArray(FItems, Index + 1, Index, FCount - Index); Dec(FCount); end; function TJclIntfVector.Remove(AInterface: IInterface): Boolean; var I: Integer; begin Result := False; if AInterface = nil then Exit; for I := FCount - 1 downto 0 do if FItems[I] = AInterface then // Removes all AInterface begin FItems[I] := nil; // Force Release MoveArray(FItems, I + 1, I, FCount - I); Dec(FCount); Result := True; end; end; function TJclIntfVector.RemoveAll(ACollection: IJclIntfCollection): Boolean; var It: IJclIntfIterator; begin Result := False; if ACollection = nil then Exit; It := ACollection.First; while It.HasNext do Remove(It.Next); end; function TJclIntfVector.RetainAll(ACollection: IJclIntfCollection): Boolean; var I: Integer; begin Result := False; if ACollection = nil then Exit; for I := FCount - 1 downto 0 do if not ACollection.Contains(Items[I]) then Remove(I); end; procedure TJclIntfVector.SetObject(Index: Integer; AInterface: IInterface); begin if (Index < 0) or (Index >= FCount) then {$IFDEF CLR} raise EJclOutOfBoundsError.Create(RsEOutOfBounds); {$ELSE} raise EJclOutOfBoundsError.CreateRes(@RsEOutOfBounds); {$ENDIF CLR} FItems[Index] := AInterface; end; function TJclIntfVector.Size: Integer; begin Result := FCount; end; function TJclIntfVector.SubList(First, Count: Integer): IJclIntfList; var I: Integer; Last: Integer; begin Last := First + Count - 1; if Last >= FCount then Last := FCount - 1; Result := TJclIntfVector.Create(Count); for I := First to Last do Result.Add(Items[I]); end; {$IFNDEF CLR} procedure TJclIntfVector.AfterConstruction; begin end; procedure TJclIntfVector.BeforeDestruction; begin end; {$ENDIF ~CLR} //=== { TJclStrVector } ====================================================== constructor TJclStrVector.Create(ACapacity: Integer = DefaultContainerCapacity); begin inherited Create; FCount := 0; if ACapacity < 0 then FCapacity := 0 else FCapacity := ACapacity; SetLength(FItems, FCapacity); end; destructor TJclStrVector.Destroy; begin Clear; inherited Destroy; end; procedure TJclStrVector.Insert(Index: Integer; const AString: string); begin if (Index < 0) or (Index > FCount) then {$IFDEF CLR} raise EJclOutOfBoundsError.Create(RsEOutOfBounds); {$ELSE} raise EJclOutOfBoundsError.CreateRes(@RsEOutOfBounds); {$ENDIF CLR} if FCount = FCapacity then Grow; MoveArray(FItems, Index, Index + 1, FCount - Index); FItems[Index] := AString; Inc(FCount); end; function TJclStrVector.Add(const AString: string): Boolean; begin if FCount = FCapacity then Grow; FItems[FCount] := AString; Inc(FCount); Result := True; end; function TJclStrVector.AddAll(ACollection: IJclStrCollection): Boolean; var It: IJclStrIterator; begin Result := False; if ACollection = nil then Exit; It := ACollection.First; while It.HasNext do Add(It.Next); Result := True; end; function TJclStrVector.InsertAll(Index: Integer; ACollection: IJclStrCollection): Boolean; var It: IJclStrIterator; Size: Integer; begin Result := False; if (Index < 0) or (Index >= FCount) then {$IFDEF CLR} raise EJclOutOfBoundsError.Create(RsEOutOfBounds); {$ELSE} raise EJclOutOfBoundsError.CreateRes(@RsEOutOfBounds); {$ENDIF CLR} if ACollection = nil then Exit; Size := ACollection.Size; if Size <> 0 then begin Inc(FCapacity, Size); SetLength(FItems, FCapacity); Inc(FCount, Size); MoveArray(FItems, Index, Index + Size, Size); It := ACollection.First; while It.HasNext do begin FItems[Index] := It.Next; Inc(Index); end; end; Result := True; end; {$IFNDEF CLR} procedure TJclStrVector.AfterConstruction; begin end; procedure TJclStrVector.BeforeDestruction; begin end; {$ENDIF ~CLR} procedure TJclStrVector.Clear; var I: Integer; begin for I := 0 to FCount - 1 do FItems[I] := ''; FCount := 0; end; function TJclStrVector.Clone: TObject; var NewList: TJclStrVector; begin NewList := TJclStrVector.Create(FCapacity); NewList.AddAll(Self); Result := NewList; end; function TJclStrVector.Contains(const AString: string): Boolean; var I: Integer; begin Result := False; if AString = '' then Exit; for I := 0 to FCount - 1 do if Items[I] = AString then begin Result := True; Break; end; end; function TJclStrVector.ContainsAll(ACollection: IJclStrCollection): Boolean; var It: IJclStrIterator; begin Result := True; if ACollection = nil then Exit; It := ACollection.First; while Result and It.HasNext do Result := Contains(It.Next); end; function TJclStrVector.Equals(ACollection: IJclStrCollection): Boolean; var I: Integer; It: IJclStrIterator; begin Result := False; if ACollection = nil then Exit; if FCount <> ACollection.Size then Exit; It := ACollection.First; for I := 0 to FCount - 1 do if Items[I] <> It.Next then Exit; Result := True; end; function TJclStrVector.First: IJclStrIterator; begin Result := TStrItr.Create(Self); end; function TJclStrVector.GetString(Index: Integer): string; begin if (Index < 0) or (Index >= FCount) then begin Result := ''; Exit; end; Result := FItems[Index]; end; procedure TJclStrVector.Grow; begin if FCapacity > 64 then FCapacity := FCapacity + FCapacity div 4 else if FCapacity = 0 then FCapacity := 64 else FCapacity := FCapacity * 4; SetLength(FItems, FCapacity); end; function TJclStrVector.IndexOf(const AString: string): Integer; var I: Integer; begin Result := -1; if AString = '' then Exit; for I := 0 to FCount - 1 do if Items[I] = AString then begin Result := I; Exit; end; end; function TJclStrVector.IsEmpty: Boolean; begin Result := FCount = 0; end; function TJclStrVector.Last: IJclStrIterator; var NewIterator: TStrItr; begin NewIterator := TStrItr.Create(Self); NewIterator.FCursor := NewIterator.FOwnList.FCount; NewIterator.FSize := NewIterator.FOwnList.FCount; Result := NewIterator; end; function TJclStrVector.LastIndexOf(const AString: string): Integer; var I: Integer; begin Result := -1; if AString = '' then Exit; for I := FCount - 1 downto 0 do if Items[I] = AString then begin Result := I; Break; end; end; function TJclStrVector.Remove(const AString: string): Boolean; var I: Integer; begin Result := False; if AString = '' then Exit; for I := FCount - 1 downto 0 do if FItems[I] = AString then // Removes all AString begin FItems[I] := ''; // Force Release MoveArray(FItems, I + 1, I, FCount - I); Dec(FCount); Result := True; end; end; function TJclStrVector.Remove(Index: Integer): string; begin if (Index < 0) or (Index >= FCount) then {$IFDEF CLR} raise EJclOutOfBoundsError.Create(RsEOutOfBounds); {$ELSE} raise EJclOutOfBoundsError.CreateRes(@RsEOutOfBounds); {$ENDIF CLR} Result := FItems[Index]; FItems[Index] := ''; MoveArray(FItems, Index + 1, Index, FCount - Index); Dec(FCount); end; function TJclStrVector.RemoveAll(ACollection: IJclStrCollection): Boolean; var It: IJclStrIterator; begin Result := False; if ACollection = nil then Exit; It := ACollection.First; while It.HasNext do Remove(It.Next); end; function TJclStrVector.RetainAll(ACollection: IJclStrCollection): Boolean; var I: Integer; begin Result := False; if ACollection = nil then Exit; for I := FCount - 1 downto 0 do if not ACollection.Contains(Items[I]) then Remove(I); end; procedure TJclStrVector.SetString(Index: Integer; const AString: string); begin if (Index < 0) or (Index >= FCount) then {$IFDEF CLR} raise EJclOutOfBoundsError.Create(RsEOutOfBounds); {$ELSE} raise EJclOutOfBoundsError.CreateRes(@RsEOutOfBounds); {$ENDIF CLR} FItems[Index] := AString; end; function TJclStrVector.Size: Integer; begin Result := FCount; end; function TJclStrVector.SubList(First, Count: Integer): IJclStrList; var I: Integer; Last: Integer; begin Last := First + Count - 1; if Last >= FCount then Last := FCount - 1; Result := TJclStrVector.Create(Count); for I := First to Last do Result.Add(Items[I]); end; //=== { TJclVector } ========================================================= constructor TJclVector.Create(ACapacity: Integer = DefaultContainerCapacity; AOwnsObjects: Boolean = True); begin inherited Create; FCount := 0; FOwnsObjects := AOwnsObjects; if ACapacity < 0 then FCapacity := 0 else FCapacity := ACapacity; SetLength(FItems, FCapacity); end; destructor TJclVector.Destroy; begin Clear; inherited Destroy; end; procedure TJclVector.Insert(Index: Integer; AObject: TObject); begin if (Index < 0) or (Index > FCount) then {$IFDEF CLR} raise EJclOutOfBoundsError.Create(RsEOutOfBounds); {$ELSE} raise EJclOutOfBoundsError.CreateRes(@RsEOutOfBounds); {$ENDIF CLR} if FCount = FCapacity then Grow; MoveArray(FItems, Index, Index + 1, FCount - Index); FItems[Index] := AObject; Inc(FCount); end; function TJclVector.Add(AObject: TObject): Boolean; begin if FCount = FCapacity then Grow; FItems[FCount] := AObject; Inc(FCount); Result := True; end; function TJclVector.InsertAll(Index: Integer; ACollection: IJclCollection): Boolean; var It: IJclIterator; Size: Integer; begin Result := False; if (Index < 0) or (Index >= FCount) then {$IFDEF CLR} raise EJclOutOfBoundsError.Create(RsEOutOfBounds); {$ELSE} raise EJclOutOfBoundsError.CreateRes(@RsEOutOfBounds); {$ENDIF CLR} if ACollection = nil then Exit; Size := ACollection.Size; if Size <> 0 then begin Inc(FCapacity, Size); SetLength(FItems, FCapacity); Inc(FCount, Size); MoveArray(FItems, Index, Index + Size, Size); It := ACollection.First; while It.HasNext do begin FItems[Index] := It.Next; Inc(Index); end; end; Result := True; end; function TJclVector.AddAll(ACollection: IJclCollection): Boolean; var It: IJclIterator; begin Result := False; if ACollection = nil then Exit; It := ACollection.First; while It.HasNext do Add(It.Next); Result := True; end; procedure TJclVector.Clear; var I: Integer; begin for I := 0 to FCount - 1 do FreeObject(FItems[I]); FCount := 0; end; function TJclVector.Clone: TObject; var NewList: TJclVector; begin NewList := TJclVector.Create(FCapacity, False); // Only one can have FOwnsObject = True NewList.AddAll(Self); Result := NewList; end; function TJclVector.Contains(AObject: TObject): Boolean; var I: Integer; begin Result := False; if AObject = nil then Exit; for I := 0 to FCount - 1 do if Items[I] = AObject then begin Result := True; Break; end; end; function TJclVector.ContainsAll(ACollection: IJclCollection): Boolean; var It: IJclIterator; begin Result := True; if ACollection = nil then Exit; It := ACollection.First; while Result and It.HasNext do Result := Contains(It.Next); end; function TJclVector.Equals(ACollection: IJclCollection): Boolean; var I: Integer; It: IJclIterator; begin Result := False; if ACollection = nil then Exit; if FCount <> ACollection.Size then Exit; It := ACollection.First; for I := 0 to FCount - 1 do if Items[I] <> It.Next then Exit; Result := True; end; procedure TJclVector.FreeObject(var AObject: TObject); begin if FOwnsObjects then begin AObject.Free; AObject := nil; end; end; function TJclVector.GetObject(Index: Integer): TObject; begin if (Index < 0) or (Index >= FCount) then begin Result := nil; Exit; end; Result := Items[Index]; end; procedure TJclVector.Grow; begin if FCapacity > 64 then FCapacity := FCapacity + FCapacity div 4 else if FCapacity = 0 then FCapacity := 64 else FCapacity := FCapacity * 4; SetLength(FItems, FCapacity); end; function TJclVector.IndexOf(AObject: TObject): Integer; var I: Integer; begin Result := -1; if AObject = nil then Exit; for I := 0 to FCount - 1 do if Items[I] = AObject then begin Result := I; Break; end; end; function TJclVector.First: IJclIterator; begin Result := TItr.Create(Self); end; function TJclVector.IsEmpty: Boolean; begin Result := FCount = 0; end; function TJclVector.Last: IJclIterator; var NewIterator: TItr; begin NewIterator := TItr.Create(Self); NewIterator.FCursor := NewIterator.FOwnList.FCount; NewIterator.FSize := NewIterator.FOwnList.FCount; Result := NewIterator; end; function TJclVector.LastIndexOf(AObject: TObject): Integer; var I: Integer; begin Result := -1; if AObject = nil then Exit; for I := FCount - 1 downto 0 do if Items[I] = AObject then begin Result := I; Break; end; end; function TJclVector.Remove(AObject: TObject): Boolean; var I: Integer; begin Result := False; if AObject = nil then Exit; for I := FCount - 1 downto 0 do if FItems[I] = AObject then // Removes all AObject begin FreeObject(FItems[I]); MoveArray(FItems, I + 1, I, FCount - I); Dec(FCount); Result := True; end; end; function TJclVector.Remove(Index: Integer): TObject; begin if (Index < 0) or (Index >= FCount) then {$IFDEF CLR} raise EJclOutOfBoundsError.Create(RsEOutOfBounds); {$ELSE} raise EJclOutOfBoundsError.CreateRes(@RsEOutOfBounds); {$ENDIF CLR} Result := FItems[Index]; FreeObject(FItems[Index]); MoveArray(FItems, Index + 1, Index, FCount - Index); Dec(FCount); end; function TJclVector.RemoveAll(ACollection: IJclCollection): Boolean; var It: IJclIterator; begin Result := False; if ACollection = nil then Exit; It := ACollection.First; while It.HasNext do Remove(It.Next); end; function TJclVector.RetainAll(ACollection: IJclCollection): Boolean; var I: Integer; begin Result := False; if ACollection = nil then Exit; for I := FCount - 1 to 0 do if not ACollection.Contains(Items[I]) then Remove(I); end; procedure TJclVector.SetObject(Index: Integer; AObject: TObject); begin if (Index < 0) or (Index >= FCount) then {$IFDEF CLR} raise EJclOutOfBoundsError.Create(RsEOutOfBounds); {$ELSE} raise EJclOutOfBoundsError.CreateRes(@RsEOutOfBounds); {$ENDIF CLR} FItems[Index] := AObject; end; function TJclVector.Size: Integer; begin Result := FCount; end; function TJclVector.SubList(First, Count: Integer): IJclList; var I: Integer; Last: Integer; begin Last := First + Count - 1; if Last >= FCount then Last := FCount - 1; Result := TJclVector.Create(Count, FOwnsObjects); for I := First to Last do Result.Add(Items[I]); end; {$IFNDEF CLR} procedure TJclVector.AfterConstruction; begin end; procedure TJclVector.BeforeDestruction; begin end; {$ENDIF ~CLR} // History: // $Log: JclVectors.pas,v $ // Revision 1.12 2005/05/05 20:08:46 ahuser // JCL.NET support // // Revision 1.11 2005/03/14 08:46:53 rrossmair // - check-in in preparation for release 1.95 // // Revision 1.10 2005/03/12 06:01:06 rrossmair // - fixed collection insert, iterator add methods // // Revision 1.9 2005/03/12 05:22:07 rrossmair // - InsertAll methods fixed // // Revision 1.8 2005/03/08 08:33:18 marquardt // overhaul of exceptions and resourcestrings, minor style cleaning // // Revision 1.7 2005/03/03 08:02:57 marquardt // various style cleanings, bugfixes and improvements // // Revision 1.6 2005/03/02 17:51:24 rrossmair // - removed DCLAppendDelimited from JclAlgorithms, changed uses clauses accordingly // // Revision 1.5 2005/03/02 09:59:30 dade2004 // Added // -TJclStrCollection in JclContainerIntf // Every common methods for IJclStrCollection are implemented here // // -Every class that implement IJclStrCollection now derive from TJclStrCollection instead of TJclAbstractContainer // -Every abstract method in TJclStrCollection has been marked as "override" in descendent classes // // DCLAppendDelimited has been removed from JclAlgorothms, his body has been fixed for a bug and put into // relative method in TJclStrCollection // // Revision 1.4 2005/02/27 11:36:20 marquardt // fixed and secured Capacity/Grow mechanism, raise exceptions with efficient CreateResRec // // Revision 1.3 2005/02/27 07:27:47 marquardt // changed interface names from I to IJcl, moved resourcestrings to JclResource.pas // // Revision 1.2 2005/02/24 07:36:24 marquardt // resolved the compiler warnings, style cleanup, removed code from JclContainerIntf.pas // // Revision 1.1 2005/02/24 03:57:10 rrossmair // - donated DCL code, initial check-in // end.