/donations/dcl/JclStack.pas

https://github.com/the-Arioch/jcl · Pascal · 329 lines · 227 code · 34 blank · 68 comment · 18 complexity · 395faba7943404431f4f2701366f0ce0 MD5 · raw file

  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. // Last modified: $Date$
  25. // For history see end of file
  26. unit JclStack;
  27. {$I jcl.inc}
  28. interface
  29. uses
  30. JclBase, JclAbstractContainer, JclDCL_intf, JclDCLUtil;
  31. type
  32. TJclIntfStack = class(TJclAbstractContainer, IIntfStack)
  33. private
  34. FElements: TDynIInterfaceArray;
  35. FCount: Integer;
  36. FCapacity: Integer;
  37. protected
  38. procedure Grow; virtual;
  39. { IIntfStack }
  40. function Contains(AInterface: IInterface): Boolean;
  41. function Empty: Boolean;
  42. function Pop: IInterface;
  43. procedure Push(AInterface: IInterface);
  44. function Size: Integer;
  45. public
  46. constructor Create(Capacity: Integer = DCLDefaultCapacity);
  47. end;
  48. TJclStrStack = class(TJclAbstractContainer, IStrStack)
  49. private
  50. FElements: TDynStringArray;
  51. FCount: Integer;
  52. FCapacity: Integer;
  53. protected
  54. procedure Grow; virtual;
  55. { IStrStack }
  56. function Contains(const AString: string): Boolean;
  57. function Empty: Boolean;
  58. function Pop: string;
  59. procedure Push(const AString: string);
  60. function Size: Integer;
  61. public
  62. constructor Create(Capacity: Integer = DCLDefaultCapacity);
  63. end;
  64. TJclStack = class(TJclAbstractContainer, IStack)
  65. private
  66. FElements: TDynObjectArray;
  67. FCount: Integer;
  68. FCapacity: Integer;
  69. protected
  70. procedure Grow; virtual;
  71. { IStack }
  72. function Contains(AObject: TObject): Boolean;
  73. function Empty: Boolean;
  74. function Pop: TObject;
  75. procedure Push(AObject: TObject);
  76. function Size: Integer;
  77. public
  78. constructor Create(Capacity: Integer = DCLDefaultCapacity);
  79. end;
  80. implementation
  81. //=== { TJclIntfStack } ======================================================
  82. constructor TJclIntfStack.Create(Capacity: Integer = DCLDefaultCapacity);
  83. begin
  84. inherited Create;
  85. FCount := 0;
  86. FCapacity := Capacity;
  87. SetLength(FElements, FCapacity);
  88. end;
  89. function TJclIntfStack.Contains(AInterface: IInterface): Boolean;
  90. var
  91. I: Integer;
  92. {$IFDEF THREADSAFE}
  93. CS: IInterface;
  94. {$ENDIF THREADSAFE}
  95. begin
  96. {$IFDEF THREADSAFE}
  97. CS := EnterCriticalSection;
  98. {$ENDIF THREADSAFE}
  99. Result := False;
  100. if AInterface = nil then
  101. Exit;
  102. for I := 0 to FCount - 1 do
  103. if FElements[I] = AInterface then
  104. begin
  105. Result := True;
  106. Break;
  107. end;
  108. end;
  109. function TJclIntfStack.Empty: Boolean;
  110. begin
  111. Result := FCount = 0;
  112. end;
  113. procedure TJclIntfStack.Grow;
  114. begin
  115. FCapacity := FCapacity + FCapacity div 4;
  116. SetLength(FElements, FCapacity);
  117. end;
  118. function TJclIntfStack.Pop: IInterface;
  119. {$IFDEF THREADSAFE}
  120. var
  121. CS: IInterface;
  122. {$ENDIF THREADSAFE}
  123. begin
  124. {$IFDEF THREADSAFE}
  125. CS := EnterCriticalSection;
  126. {$ENDIF THREADSAFE}
  127. if FCount = 0 then
  128. Exit;
  129. Dec(FCount);
  130. Result := FElements[FCount];
  131. end;
  132. procedure TJclIntfStack.Push(AInterface: IInterface);
  133. {$IFDEF THREADSAFE}
  134. var
  135. CS: IInterface;
  136. {$ENDIF THREADSAFE}
  137. begin
  138. {$IFDEF THREADSAFE}
  139. CS := EnterCriticalSection;
  140. {$ENDIF THREADSAFE}
  141. if AInterface = nil then
  142. Exit;
  143. if FCount = FCapacity then
  144. Grow;
  145. FElements[FCount] := AInterface;
  146. Inc(FCount);
  147. end;
  148. function TJclIntfStack.Size: Integer;
  149. begin
  150. Result := FCount;
  151. end;
  152. //=== { TJclStrStack } =======================================================
  153. constructor TJclStrStack.Create(Capacity: Integer = DCLDefaultCapacity);
  154. begin
  155. inherited Create;
  156. FCount := 0;
  157. FCapacity := Capacity;
  158. SetLength(FElements, FCapacity);
  159. end;
  160. function TJclStrStack.Contains(const AString: string): Boolean;
  161. var
  162. I: Integer;
  163. {$IFDEF THREADSAFE}
  164. CS: IInterface;
  165. {$ENDIF THREADSAFE}
  166. begin
  167. {$IFDEF THREADSAFE}
  168. CS := EnterCriticalSection;
  169. {$ENDIF THREADSAFE}
  170. Result := False;
  171. if AString = '' then
  172. Exit;
  173. for I := 0 to FCount - 1 do
  174. if FElements[I] = AString then
  175. begin
  176. Result := True;
  177. Exit;
  178. end;
  179. end;
  180. function TJclStrStack.Empty: Boolean;
  181. begin
  182. Result := FCount = 0;
  183. end;
  184. procedure TJclStrStack.Grow;
  185. begin
  186. FCapacity := FCapacity + FCapacity div 4;
  187. SetLength(FElements, FCapacity);
  188. end;
  189. function TJclStrStack.Pop: string;
  190. {$IFDEF THREADSAFE}
  191. var
  192. CS: IInterface;
  193. {$ENDIF THREADSAFE}
  194. begin
  195. {$IFDEF THREADSAFE}
  196. CS := EnterCriticalSection;
  197. {$ENDIF THREADSAFE}
  198. if FCount = 0 then
  199. Exit;
  200. Dec(FCount);
  201. Result := FElements[FCount];
  202. end;
  203. procedure TJclStrStack.Push(const AString: string);
  204. {$IFDEF THREADSAFE}
  205. var
  206. CS: IInterface;
  207. {$ENDIF THREADSAFE}
  208. begin
  209. {$IFDEF THREADSAFE}
  210. CS := EnterCriticalSection;
  211. {$ENDIF THREADSAFE}
  212. if AString = '' then
  213. Exit;
  214. if FCount = FCapacity then
  215. Grow;
  216. FElements[FCount] := AString;
  217. Inc(FCount);
  218. end;
  219. function TJclStrStack.Size: Integer;
  220. begin
  221. Result := FCount;
  222. end;
  223. //=== { TJclStack } ==========================================================
  224. constructor TJclStack.Create(Capacity: Integer = DCLDefaultCapacity);
  225. begin
  226. inherited Create;
  227. FCount := 0;
  228. FCapacity := Capacity;
  229. SetLength(FElements, FCapacity);
  230. end;
  231. function TJclStack.Contains(AObject: TObject): Boolean;
  232. var
  233. I: Integer;
  234. {$IFDEF THREADSAFE}
  235. CS: IInterface;
  236. {$ENDIF THREADSAFE}
  237. begin
  238. {$IFDEF THREADSAFE}
  239. CS := EnterCriticalSection;
  240. {$ENDIF THREADSAFE}
  241. Result := False;
  242. if AObject = nil then
  243. Exit;
  244. for I := 0 to FCount - 1 do
  245. if FElements[I] = AObject then
  246. begin
  247. Result := True;
  248. Break;
  249. end;
  250. end;
  251. function TJclStack.Empty: Boolean;
  252. begin
  253. Result := FCount = 0;
  254. end;
  255. procedure TJclStack.Grow;
  256. begin
  257. FCapacity := FCapacity + FCapacity div 4;
  258. SetLength(FElements, FCapacity);
  259. end;
  260. function TJclStack.Pop: TObject;
  261. {$IFDEF THREADSAFE}
  262. var
  263. CS: IInterface;
  264. {$ENDIF THREADSAFE}
  265. begin
  266. {$IFDEF THREADSAFE}
  267. CS := EnterCriticalSection;
  268. {$ENDIF THREADSAFE}
  269. Result := nil;
  270. if FCount = 0 then
  271. Exit;
  272. Dec(FCount);
  273. Result := FElements[FCount];
  274. end;
  275. procedure TJclStack.Push(AObject: TObject);
  276. {$IFDEF THREADSAFE}
  277. var
  278. CS: IInterface;
  279. {$ENDIF THREADSAFE}
  280. begin
  281. {$IFDEF THREADSAFE}
  282. CS := EnterCriticalSection;
  283. {$ENDIF THREADSAFE}
  284. if AObject = nil then
  285. Exit;
  286. if FCount = FCapacity then
  287. Grow;
  288. FElements[FCount] := AObject;
  289. Inc(FCount);
  290. end;
  291. function TJclStack.Size: Integer;
  292. begin
  293. Result := FCount;
  294. end;
  295. end.