/donations/dcl/JclStack.pas
Pascal | 329 lines | 227 code | 34 blank | 68 comment | 18 complexity | 395faba7943404431f4f2701366f0ce0 MD5 | raw file
Possible License(s): BSD-3-Clause
1{**************************************************************************************************} 2{ } 3{ Project JEDI Code Library (JCL) } 4{ } 5{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } 6{ you may not use this file except in compliance with the License. You may obtain a copy of the } 7{ License at http://www.mozilla.org/MPL/ } 8{ } 9{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } 10{ ANY KIND, either express or implied. See the License for the specific language governing rights } 11{ and limitations under the License. } 12{ } 13{ The Original Code is Stack.pas. } 14{ } 15{ The Initial Developer of the Original Code is Jean-Philippe BEMPEL aka RDM. Portions created by } 16{ Jean-Philippe BEMPEL are Copyright (C) Jean-Philippe BEMPEL (rdm_30 att yahoo dott com) } 17{ All rights reserved. } 18{ } 19{**************************************************************************************************} 20{ } 21{ The Delphi Container Library } 22{ } 23{**************************************************************************************************} 24 25// Last modified: $Date$ 26// For history see end of file 27 28unit JclStack; 29 30{$I jcl.inc} 31 32interface 33 34uses 35 JclBase, JclAbstractContainer, JclDCL_intf, JclDCLUtil; 36 37type 38 TJclIntfStack = class(TJclAbstractContainer, IIntfStack) 39 private 40 FElements: TDynIInterfaceArray; 41 FCount: Integer; 42 FCapacity: Integer; 43 protected 44 procedure Grow; virtual; 45 { IIntfStack } 46 function Contains(AInterface: IInterface): Boolean; 47 function Empty: Boolean; 48 function Pop: IInterface; 49 procedure Push(AInterface: IInterface); 50 function Size: Integer; 51 public 52 constructor Create(Capacity: Integer = DCLDefaultCapacity); 53 end; 54 55 TJclStrStack = class(TJclAbstractContainer, IStrStack) 56 private 57 FElements: TDynStringArray; 58 FCount: Integer; 59 FCapacity: Integer; 60 protected 61 procedure Grow; virtual; 62 { IStrStack } 63 function Contains(const AString: string): Boolean; 64 function Empty: Boolean; 65 function Pop: string; 66 procedure Push(const AString: string); 67 function Size: Integer; 68 public 69 constructor Create(Capacity: Integer = DCLDefaultCapacity); 70 end; 71 72 TJclStack = class(TJclAbstractContainer, IStack) 73 private 74 FElements: TDynObjectArray; 75 FCount: Integer; 76 FCapacity: Integer; 77 protected 78 procedure Grow; virtual; 79 { IStack } 80 function Contains(AObject: TObject): Boolean; 81 function Empty: Boolean; 82 function Pop: TObject; 83 procedure Push(AObject: TObject); 84 function Size: Integer; 85 public 86 constructor Create(Capacity: Integer = DCLDefaultCapacity); 87 end; 88 89implementation 90 91//=== { TJclIntfStack } ====================================================== 92 93constructor TJclIntfStack.Create(Capacity: Integer = DCLDefaultCapacity); 94begin 95 inherited Create; 96 FCount := 0; 97 FCapacity := Capacity; 98 SetLength(FElements, FCapacity); 99end; 100 101function TJclIntfStack.Contains(AInterface: IInterface): Boolean; 102var 103 I: Integer; 104 {$IFDEF THREADSAFE} 105 CS: IInterface; 106 {$ENDIF THREADSAFE} 107begin 108 {$IFDEF THREADSAFE} 109 CS := EnterCriticalSection; 110 {$ENDIF THREADSAFE} 111 Result := False; 112 if AInterface = nil then 113 Exit; 114 for I := 0 to FCount - 1 do 115 if FElements[I] = AInterface then 116 begin 117 Result := True; 118 Break; 119 end; 120end; 121 122function TJclIntfStack.Empty: Boolean; 123begin 124 Result := FCount = 0; 125end; 126 127procedure TJclIntfStack.Grow; 128begin 129 FCapacity := FCapacity + FCapacity div 4; 130 SetLength(FElements, FCapacity); 131end; 132 133function TJclIntfStack.Pop: IInterface; 134{$IFDEF THREADSAFE} 135var 136 CS: IInterface; 137{$ENDIF THREADSAFE} 138begin 139 {$IFDEF THREADSAFE} 140 CS := EnterCriticalSection; 141 {$ENDIF THREADSAFE} 142 if FCount = 0 then 143 Exit; 144 Dec(FCount); 145 Result := FElements[FCount]; 146end; 147 148procedure TJclIntfStack.Push(AInterface: IInterface); 149{$IFDEF THREADSAFE} 150var 151 CS: IInterface; 152{$ENDIF THREADSAFE} 153begin 154 {$IFDEF THREADSAFE} 155 CS := EnterCriticalSection; 156 {$ENDIF THREADSAFE} 157 if AInterface = nil then 158 Exit; 159 if FCount = FCapacity then 160 Grow; 161 FElements[FCount] := AInterface; 162 Inc(FCount); 163end; 164 165function TJclIntfStack.Size: Integer; 166begin 167 Result := FCount; 168end; 169 170//=== { TJclStrStack } ======================================================= 171 172constructor TJclStrStack.Create(Capacity: Integer = DCLDefaultCapacity); 173begin 174 inherited Create; 175 FCount := 0; 176 FCapacity := Capacity; 177 SetLength(FElements, FCapacity); 178end; 179 180function TJclStrStack.Contains(const AString: string): Boolean; 181var 182 I: Integer; 183{$IFDEF THREADSAFE} 184 CS: IInterface; 185{$ENDIF THREADSAFE} 186begin 187 {$IFDEF THREADSAFE} 188 CS := EnterCriticalSection; 189 {$ENDIF THREADSAFE} 190 Result := False; 191 if AString = '' then 192 Exit; 193 for I := 0 to FCount - 1 do 194 if FElements[I] = AString then 195 begin 196 Result := True; 197 Exit; 198 end; 199end; 200 201function TJclStrStack.Empty: Boolean; 202begin 203 Result := FCount = 0; 204end; 205 206procedure TJclStrStack.Grow; 207begin 208 FCapacity := FCapacity + FCapacity div 4; 209 SetLength(FElements, FCapacity); 210end; 211 212function TJclStrStack.Pop: string; 213{$IFDEF THREADSAFE} 214var 215 CS: IInterface; 216{$ENDIF THREADSAFE} 217begin 218 {$IFDEF THREADSAFE} 219 CS := EnterCriticalSection; 220 {$ENDIF THREADSAFE} 221 if FCount = 0 then 222 Exit; 223 Dec(FCount); 224 Result := FElements[FCount]; 225end; 226 227procedure TJclStrStack.Push(const AString: string); 228{$IFDEF THREADSAFE} 229var 230 CS: IInterface; 231{$ENDIF THREADSAFE} 232begin 233 {$IFDEF THREADSAFE} 234 CS := EnterCriticalSection; 235 {$ENDIF THREADSAFE} 236 if AString = '' then 237 Exit; 238 if FCount = FCapacity then 239 Grow; 240 FElements[FCount] := AString; 241 Inc(FCount); 242end; 243 244function TJclStrStack.Size: Integer; 245begin 246 Result := FCount; 247end; 248 249//=== { TJclStack } ========================================================== 250 251constructor TJclStack.Create(Capacity: Integer = DCLDefaultCapacity); 252begin 253 inherited Create; 254 FCount := 0; 255 FCapacity := Capacity; 256 SetLength(FElements, FCapacity); 257end; 258 259function TJclStack.Contains(AObject: TObject): Boolean; 260var 261 I: Integer; 262 {$IFDEF THREADSAFE} 263 CS: IInterface; 264 {$ENDIF THREADSAFE} 265begin 266 {$IFDEF THREADSAFE} 267 CS := EnterCriticalSection; 268 {$ENDIF THREADSAFE} 269 Result := False; 270 if AObject = nil then 271 Exit; 272 for I := 0 to FCount - 1 do 273 if FElements[I] = AObject then 274 begin 275 Result := True; 276 Break; 277 end; 278end; 279 280function TJclStack.Empty: Boolean; 281begin 282 Result := FCount = 0; 283end; 284 285procedure TJclStack.Grow; 286begin 287 FCapacity := FCapacity + FCapacity div 4; 288 SetLength(FElements, FCapacity); 289end; 290 291function TJclStack.Pop: TObject; 292{$IFDEF THREADSAFE} 293var 294 CS: IInterface; 295{$ENDIF THREADSAFE} 296begin 297 {$IFDEF THREADSAFE} 298 CS := EnterCriticalSection; 299 {$ENDIF THREADSAFE} 300 Result := nil; 301 if FCount = 0 then 302 Exit; 303 Dec(FCount); 304 Result := FElements[FCount]; 305end; 306 307procedure TJclStack.Push(AObject: TObject); 308{$IFDEF THREADSAFE} 309var 310 CS: IInterface; 311{$ENDIF THREADSAFE} 312begin 313 {$IFDEF THREADSAFE} 314 CS := EnterCriticalSection; 315 {$ENDIF THREADSAFE} 316 if AObject = nil then 317 Exit; 318 if FCount = FCapacity then 319 Grow; 320 FElements[FCount] := AObject; 321 Inc(FCount); 322end; 323 324function TJclStack.Size: Integer; 325begin 326 Result := FCount; 327end; 328 329end.