/donations/dcl/JclStack.pas

  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.