PageRenderTime 129ms CodeModel.GetById 30ms RepoModel.GetById 0ms app.codeStats 3ms

/jcl/source/common/JclSortedMaps.pas

https://github.com/the-Arioch/jcl
Pascal | 18190 lines | 14869 code | 1028 blank | 2293 comment | 2268 complexity | c01d72d92882d8c6d6cabf3f99cd94f1 MD5 | raw file
Possible License(s): BSD-3-Clause
  1. {**************************************************************************************************}
  2. { WARNING: JEDI preprocessor generated unit. Do not edit. }
  3. {**************************************************************************************************}
  4. {**************************************************************************************************}
  5. { }
  6. { Project JEDI Code Library (JCL) }
  7. { }
  8. { The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); }
  9. { you may not use this file except in compliance with the License. You may obtain a copy of the }
  10. { License at http://www.mozilla.org/MPL/ }
  11. { }
  12. { Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF }
  13. { ANY KIND, either express or implied. See the License for the specific language governing rights }
  14. { and limitations under the License. }
  15. { }
  16. { The Original Code is JclSortedMaps.pas. }
  17. { }
  18. { The Initial Developer of the Original Code is Florent Ouchet. Portions created by }
  19. { Florent Ouchet are Copyright (C) Florent Ouchet <outchy att users dott sourceforge dott net }
  20. { All rights reserved. }
  21. { }
  22. { Contributors: }
  23. { }
  24. {**************************************************************************************************}
  25. { }
  26. { The Delphi Container Library }
  27. { }
  28. {**************************************************************************************************}
  29. { }
  30. { Last modified: $Date:: $ }
  31. { Revision: $Rev:: $ }
  32. { Author: $Author:: $ }
  33. { }
  34. {**************************************************************************************************}
  35. unit JclSortedMaps;
  36. interface
  37. {$I jcl.inc}
  38. uses
  39. {$IFDEF UNITVERSIONING}
  40. JclUnitVersioning,
  41. {$ENDIF UNITVERSIONING}
  42. {$IFDEF HAS_UNITSCOPE}
  43. System.Classes,
  44. {$ELSE ~HAS_UNITSCOPE}
  45. Classes,
  46. {$ENDIF ~HAS_UNITSCOPE}
  47. JclAlgorithms,
  48. JclBase, JclSynch,
  49. JclAbstractContainers, JclContainerIntf, JclArrayLists, JclArraySets;
  50. type
  51. TJclIntfIntfSortedMapEntry = record
  52. Key: IInterface;
  53. Value: IInterface;
  54. end;
  55. TJclIntfIntfSortedMapEntryArray = array of TJclIntfIntfSortedMapEntry;
  56. TJclIntfIntfSortedMap = class(TJclIntfAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE}
  57. IJclIntfCloneable, IJclCloneable, IJclGrowable, IJclPackable, IJclBaseContainer, IJclIntfContainer,
  58. IJclIntfIntfMap, IJclIntfIntfSortedMap)
  59. protected
  60. function CreateEmptyContainer: TJclAbstractContainerBase; override;
  61. function FreeKey(var Key: IInterface): IInterface;
  62. function FreeValue(var Value: IInterface): IInterface;
  63. function KeysCompare(const A, B: IInterface): Integer;
  64. function ValuesCompare(const A, B: IInterface): Integer;
  65. private
  66. FEntries: TJclIntfIntfSortedMapEntryArray;
  67. function BinarySearch(const Key: IInterface): Integer;
  68. protected
  69. procedure AssignDataTo(Dest: TJclAbstractContainerBase); override;
  70. procedure FinalizeArrayBeforeMove(var List: TJclIntfIntfSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  71. {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
  72. procedure InitializeArray(var List: TJclIntfIntfSortedMapEntryArray; FromIndex, Count: SizeInt);
  73. {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
  74. procedure InitializeArrayAfterMove(var List: TJclIntfIntfSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  75. {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
  76. procedure MoveArray(var List: TJclIntfIntfSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  77. public
  78. constructor Create(ACapacity: Integer);
  79. destructor Destroy; override;
  80. { IJclPackable }
  81. procedure SetCapacity(Value: Integer); override;
  82. { IJclIntfIntfMap }
  83. procedure Clear;
  84. function ContainsKey(const Key: IInterface): Boolean;
  85. function ContainsValue(const Value: IInterface): Boolean;
  86. function Extract(const Key: IInterface): IInterface;
  87. function GetValue(const Key: IInterface): IInterface;
  88. function IsEmpty: Boolean;
  89. function KeyOfValue(const Value: IInterface): IInterface;
  90. function KeySet: IJclIntfSet;
  91. function MapEquals(const AMap: IJclIntfIntfMap): Boolean;
  92. procedure PutAll(const AMap: IJclIntfIntfMap);
  93. procedure PutValue(const Key: IInterface; const Value: IInterface);
  94. function Remove(const Key: IInterface): IInterface;
  95. function Size: Integer;
  96. function Values: IJclIntfCollection;
  97. { IJclIntfIntfSortedMap }
  98. function FirstKey: IInterface;
  99. function HeadMap(const ToKey: IInterface): IJclIntfIntfSortedMap;
  100. function LastKey: IInterface;
  101. function SubMap(const FromKey, ToKey: IInterface): IJclIntfIntfSortedMap;
  102. function TailMap(const FromKey: IInterface): IJclIntfIntfSortedMap;
  103. end;
  104. TJclAnsiStrIntfSortedMapEntry = record
  105. Key: AnsiString;
  106. Value: IInterface;
  107. end;
  108. TJclAnsiStrIntfSortedMapEntryArray = array of TJclAnsiStrIntfSortedMapEntry;
  109. TJclAnsiStrIntfSortedMap = class(TJclAnsiStrAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE}
  110. IJclIntfCloneable, IJclCloneable, IJclGrowable, IJclPackable, IJclBaseContainer, IJclStrBaseContainer, IJclAnsiStrContainer, IJclIntfContainer,
  111. IJclAnsiStrIntfMap, IJclAnsiStrIntfSortedMap)
  112. protected
  113. function CreateEmptyContainer: TJclAbstractContainerBase; override;
  114. function FreeKey(var Key: AnsiString): AnsiString;
  115. function FreeValue(var Value: IInterface): IInterface;
  116. function KeysCompare(const A, B: AnsiString): Integer;
  117. function ValuesCompare(const A, B: IInterface): Integer;
  118. private
  119. FEntries: TJclAnsiStrIntfSortedMapEntryArray;
  120. function BinarySearch(const Key: AnsiString): Integer;
  121. protected
  122. procedure AssignDataTo(Dest: TJclAbstractContainerBase); override;
  123. procedure FinalizeArrayBeforeMove(var List: TJclAnsiStrIntfSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  124. {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
  125. procedure InitializeArray(var List: TJclAnsiStrIntfSortedMapEntryArray; FromIndex, Count: SizeInt);
  126. {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
  127. procedure InitializeArrayAfterMove(var List: TJclAnsiStrIntfSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  128. {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
  129. procedure MoveArray(var List: TJclAnsiStrIntfSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  130. public
  131. constructor Create(ACapacity: Integer);
  132. destructor Destroy; override;
  133. { IJclPackable }
  134. procedure SetCapacity(Value: Integer); override;
  135. { IJclAnsiStrIntfMap }
  136. procedure Clear;
  137. function ContainsKey(const Key: AnsiString): Boolean;
  138. function ContainsValue(const Value: IInterface): Boolean;
  139. function Extract(const Key: AnsiString): IInterface;
  140. function GetValue(const Key: AnsiString): IInterface;
  141. function IsEmpty: Boolean;
  142. function KeyOfValue(const Value: IInterface): AnsiString;
  143. function KeySet: IJclAnsiStrSet;
  144. function MapEquals(const AMap: IJclAnsiStrIntfMap): Boolean;
  145. procedure PutAll(const AMap: IJclAnsiStrIntfMap);
  146. procedure PutValue(const Key: AnsiString; const Value: IInterface);
  147. function Remove(const Key: AnsiString): IInterface;
  148. function Size: Integer;
  149. function Values: IJclIntfCollection;
  150. { IJclAnsiStrIntfSortedMap }
  151. function FirstKey: AnsiString;
  152. function HeadMap(const ToKey: AnsiString): IJclAnsiStrIntfSortedMap;
  153. function LastKey: AnsiString;
  154. function SubMap(const FromKey, ToKey: AnsiString): IJclAnsiStrIntfSortedMap;
  155. function TailMap(const FromKey: AnsiString): IJclAnsiStrIntfSortedMap;
  156. end;
  157. TJclIntfAnsiStrSortedMapEntry = record
  158. Key: IInterface;
  159. Value: AnsiString;
  160. end;
  161. TJclIntfAnsiStrSortedMapEntryArray = array of TJclIntfAnsiStrSortedMapEntry;
  162. TJclIntfAnsiStrSortedMap = class(TJclAnsiStrAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE}
  163. IJclIntfCloneable, IJclCloneable, IJclGrowable, IJclPackable, IJclBaseContainer, IJclStrBaseContainer, IJclIntfContainer, IJclAnsiStrContainer,
  164. IJclIntfAnsiStrMap, IJclIntfAnsiStrSortedMap)
  165. protected
  166. function CreateEmptyContainer: TJclAbstractContainerBase; override;
  167. function FreeKey(var Key: IInterface): IInterface;
  168. function FreeValue(var Value: AnsiString): AnsiString;
  169. function KeysCompare(const A, B: IInterface): Integer;
  170. function ValuesCompare(const A, B: AnsiString): Integer;
  171. private
  172. FEntries: TJclIntfAnsiStrSortedMapEntryArray;
  173. function BinarySearch(const Key: IInterface): Integer;
  174. protected
  175. procedure AssignDataTo(Dest: TJclAbstractContainerBase); override;
  176. procedure FinalizeArrayBeforeMove(var List: TJclIntfAnsiStrSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  177. {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
  178. procedure InitializeArray(var List: TJclIntfAnsiStrSortedMapEntryArray; FromIndex, Count: SizeInt);
  179. {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
  180. procedure InitializeArrayAfterMove(var List: TJclIntfAnsiStrSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  181. {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
  182. procedure MoveArray(var List: TJclIntfAnsiStrSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  183. public
  184. constructor Create(ACapacity: Integer);
  185. destructor Destroy; override;
  186. { IJclPackable }
  187. procedure SetCapacity(Value: Integer); override;
  188. { IJclIntfAnsiStrMap }
  189. procedure Clear;
  190. function ContainsKey(const Key: IInterface): Boolean;
  191. function ContainsValue(const Value: AnsiString): Boolean;
  192. function Extract(const Key: IInterface): AnsiString;
  193. function GetValue(const Key: IInterface): AnsiString;
  194. function IsEmpty: Boolean;
  195. function KeyOfValue(const Value: AnsiString): IInterface;
  196. function KeySet: IJclIntfSet;
  197. function MapEquals(const AMap: IJclIntfAnsiStrMap): Boolean;
  198. procedure PutAll(const AMap: IJclIntfAnsiStrMap);
  199. procedure PutValue(const Key: IInterface; const Value: AnsiString);
  200. function Remove(const Key: IInterface): AnsiString;
  201. function Size: Integer;
  202. function Values: IJclAnsiStrCollection;
  203. { IJclIntfAnsiStrSortedMap }
  204. function FirstKey: IInterface;
  205. function HeadMap(const ToKey: IInterface): IJclIntfAnsiStrSortedMap;
  206. function LastKey: IInterface;
  207. function SubMap(const FromKey, ToKey: IInterface): IJclIntfAnsiStrSortedMap;
  208. function TailMap(const FromKey: IInterface): IJclIntfAnsiStrSortedMap;
  209. end;
  210. TJclAnsiStrAnsiStrSortedMapEntry = record
  211. Key: AnsiString;
  212. Value: AnsiString;
  213. end;
  214. TJclAnsiStrAnsiStrSortedMapEntryArray = array of TJclAnsiStrAnsiStrSortedMapEntry;
  215. TJclAnsiStrAnsiStrSortedMap = class(TJclAnsiStrAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE}
  216. IJclIntfCloneable, IJclCloneable, IJclGrowable, IJclPackable, IJclBaseContainer, IJclStrBaseContainer, IJclAnsiStrContainer,
  217. IJclAnsiStrAnsiStrMap, IJclAnsiStrAnsiStrSortedMap)
  218. protected
  219. function CreateEmptyContainer: TJclAbstractContainerBase; override;
  220. function FreeKey(var Key: AnsiString): AnsiString;
  221. function FreeValue(var Value: AnsiString): AnsiString;
  222. function KeysCompare(const A, B: AnsiString): Integer;
  223. function ValuesCompare(const A, B: AnsiString): Integer;
  224. private
  225. FEntries: TJclAnsiStrAnsiStrSortedMapEntryArray;
  226. function BinarySearch(const Key: AnsiString): Integer;
  227. protected
  228. procedure AssignDataTo(Dest: TJclAbstractContainerBase); override;
  229. procedure FinalizeArrayBeforeMove(var List: TJclAnsiStrAnsiStrSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  230. {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
  231. procedure InitializeArray(var List: TJclAnsiStrAnsiStrSortedMapEntryArray; FromIndex, Count: SizeInt);
  232. {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
  233. procedure InitializeArrayAfterMove(var List: TJclAnsiStrAnsiStrSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  234. {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
  235. procedure MoveArray(var List: TJclAnsiStrAnsiStrSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  236. public
  237. constructor Create(ACapacity: Integer);
  238. destructor Destroy; override;
  239. { IJclPackable }
  240. procedure SetCapacity(Value: Integer); override;
  241. { IJclAnsiStrAnsiStrMap }
  242. procedure Clear;
  243. function ContainsKey(const Key: AnsiString): Boolean;
  244. function ContainsValue(const Value: AnsiString): Boolean;
  245. function Extract(const Key: AnsiString): AnsiString;
  246. function GetValue(const Key: AnsiString): AnsiString;
  247. function IsEmpty: Boolean;
  248. function KeyOfValue(const Value: AnsiString): AnsiString;
  249. function KeySet: IJclAnsiStrSet;
  250. function MapEquals(const AMap: IJclAnsiStrAnsiStrMap): Boolean;
  251. procedure PutAll(const AMap: IJclAnsiStrAnsiStrMap);
  252. procedure PutValue(const Key: AnsiString; const Value: AnsiString);
  253. function Remove(const Key: AnsiString): AnsiString;
  254. function Size: Integer;
  255. function Values: IJclAnsiStrCollection;
  256. { IJclAnsiStrAnsiStrSortedMap }
  257. function FirstKey: AnsiString;
  258. function HeadMap(const ToKey: AnsiString): IJclAnsiStrAnsiStrSortedMap;
  259. function LastKey: AnsiString;
  260. function SubMap(const FromKey, ToKey: AnsiString): IJclAnsiStrAnsiStrSortedMap;
  261. function TailMap(const FromKey: AnsiString): IJclAnsiStrAnsiStrSortedMap;
  262. end;
  263. TJclWideStrIntfSortedMapEntry = record
  264. Key: WideString;
  265. Value: IInterface;
  266. end;
  267. TJclWideStrIntfSortedMapEntryArray = array of TJclWideStrIntfSortedMapEntry;
  268. TJclWideStrIntfSortedMap = class(TJclWideStrAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE}
  269. IJclIntfCloneable, IJclCloneable, IJclGrowable, IJclPackable, IJclBaseContainer, IJclStrBaseContainer, IJclWideStrContainer, IJclIntfContainer,
  270. IJclWideStrIntfMap, IJclWideStrIntfSortedMap)
  271. protected
  272. function CreateEmptyContainer: TJclAbstractContainerBase; override;
  273. function FreeKey(var Key: WideString): WideString;
  274. function FreeValue(var Value: IInterface): IInterface;
  275. function KeysCompare(const A, B: WideString): Integer;
  276. function ValuesCompare(const A, B: IInterface): Integer;
  277. private
  278. FEntries: TJclWideStrIntfSortedMapEntryArray;
  279. function BinarySearch(const Key: WideString): Integer;
  280. protected
  281. procedure AssignDataTo(Dest: TJclAbstractContainerBase); override;
  282. procedure FinalizeArrayBeforeMove(var List: TJclWideStrIntfSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  283. {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
  284. procedure InitializeArray(var List: TJclWideStrIntfSortedMapEntryArray; FromIndex, Count: SizeInt);
  285. {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
  286. procedure InitializeArrayAfterMove(var List: TJclWideStrIntfSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  287. {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
  288. procedure MoveArray(var List: TJclWideStrIntfSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  289. public
  290. constructor Create(ACapacity: Integer);
  291. destructor Destroy; override;
  292. { IJclPackable }
  293. procedure SetCapacity(Value: Integer); override;
  294. { IJclWideStrIntfMap }
  295. procedure Clear;
  296. function ContainsKey(const Key: WideString): Boolean;
  297. function ContainsValue(const Value: IInterface): Boolean;
  298. function Extract(const Key: WideString): IInterface;
  299. function GetValue(const Key: WideString): IInterface;
  300. function IsEmpty: Boolean;
  301. function KeyOfValue(const Value: IInterface): WideString;
  302. function KeySet: IJclWideStrSet;
  303. function MapEquals(const AMap: IJclWideStrIntfMap): Boolean;
  304. procedure PutAll(const AMap: IJclWideStrIntfMap);
  305. procedure PutValue(const Key: WideString; const Value: IInterface);
  306. function Remove(const Key: WideString): IInterface;
  307. function Size: Integer;
  308. function Values: IJclIntfCollection;
  309. { IJclWideStrIntfSortedMap }
  310. function FirstKey: WideString;
  311. function HeadMap(const ToKey: WideString): IJclWideStrIntfSortedMap;
  312. function LastKey: WideString;
  313. function SubMap(const FromKey, ToKey: WideString): IJclWideStrIntfSortedMap;
  314. function TailMap(const FromKey: WideString): IJclWideStrIntfSortedMap;
  315. end;
  316. TJclIntfWideStrSortedMapEntry = record
  317. Key: IInterface;
  318. Value: WideString;
  319. end;
  320. TJclIntfWideStrSortedMapEntryArray = array of TJclIntfWideStrSortedMapEntry;
  321. TJclIntfWideStrSortedMap = class(TJclWideStrAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE}
  322. IJclIntfCloneable, IJclCloneable, IJclGrowable, IJclPackable, IJclBaseContainer, IJclStrBaseContainer, IJclIntfContainer, IJclWideStrContainer,
  323. IJclIntfWideStrMap, IJclIntfWideStrSortedMap)
  324. protected
  325. function CreateEmptyContainer: TJclAbstractContainerBase; override;
  326. function FreeKey(var Key: IInterface): IInterface;
  327. function FreeValue(var Value: WideString): WideString;
  328. function KeysCompare(const A, B: IInterface): Integer;
  329. function ValuesCompare(const A, B: WideString): Integer;
  330. private
  331. FEntries: TJclIntfWideStrSortedMapEntryArray;
  332. function BinarySearch(const Key: IInterface): Integer;
  333. protected
  334. procedure AssignDataTo(Dest: TJclAbstractContainerBase); override;
  335. procedure FinalizeArrayBeforeMove(var List: TJclIntfWideStrSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  336. {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
  337. procedure InitializeArray(var List: TJclIntfWideStrSortedMapEntryArray; FromIndex, Count: SizeInt);
  338. {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
  339. procedure InitializeArrayAfterMove(var List: TJclIntfWideStrSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  340. {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
  341. procedure MoveArray(var List: TJclIntfWideStrSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  342. public
  343. constructor Create(ACapacity: Integer);
  344. destructor Destroy; override;
  345. { IJclPackable }
  346. procedure SetCapacity(Value: Integer); override;
  347. { IJclIntfWideStrMap }
  348. procedure Clear;
  349. function ContainsKey(const Key: IInterface): Boolean;
  350. function ContainsValue(const Value: WideString): Boolean;
  351. function Extract(const Key: IInterface): WideString;
  352. function GetValue(const Key: IInterface): WideString;
  353. function IsEmpty: Boolean;
  354. function KeyOfValue(const Value: WideString): IInterface;
  355. function KeySet: IJclIntfSet;
  356. function MapEquals(const AMap: IJclIntfWideStrMap): Boolean;
  357. procedure PutAll(const AMap: IJclIntfWideStrMap);
  358. procedure PutValue(const Key: IInterface; const Value: WideString);
  359. function Remove(const Key: IInterface): WideString;
  360. function Size: Integer;
  361. function Values: IJclWideStrCollection;
  362. { IJclIntfWideStrSortedMap }
  363. function FirstKey: IInterface;
  364. function HeadMap(const ToKey: IInterface): IJclIntfWideStrSortedMap;
  365. function LastKey: IInterface;
  366. function SubMap(const FromKey, ToKey: IInterface): IJclIntfWideStrSortedMap;
  367. function TailMap(const FromKey: IInterface): IJclIntfWideStrSortedMap;
  368. end;
  369. TJclWideStrWideStrSortedMapEntry = record
  370. Key: WideString;
  371. Value: WideString;
  372. end;
  373. TJclWideStrWideStrSortedMapEntryArray = array of TJclWideStrWideStrSortedMapEntry;
  374. TJclWideStrWideStrSortedMap = class(TJclWideStrAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE}
  375. IJclIntfCloneable, IJclCloneable, IJclGrowable, IJclPackable, IJclBaseContainer, IJclStrBaseContainer, IJclWideStrContainer,
  376. IJclWideStrWideStrMap, IJclWideStrWideStrSortedMap)
  377. protected
  378. function CreateEmptyContainer: TJclAbstractContainerBase; override;
  379. function FreeKey(var Key: WideString): WideString;
  380. function FreeValue(var Value: WideString): WideString;
  381. function KeysCompare(const A, B: WideString): Integer;
  382. function ValuesCompare(const A, B: WideString): Integer;
  383. private
  384. FEntries: TJclWideStrWideStrSortedMapEntryArray;
  385. function BinarySearch(const Key: WideString): Integer;
  386. protected
  387. procedure AssignDataTo(Dest: TJclAbstractContainerBase); override;
  388. procedure FinalizeArrayBeforeMove(var List: TJclWideStrWideStrSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  389. {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
  390. procedure InitializeArray(var List: TJclWideStrWideStrSortedMapEntryArray; FromIndex, Count: SizeInt);
  391. {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
  392. procedure InitializeArrayAfterMove(var List: TJclWideStrWideStrSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  393. {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
  394. procedure MoveArray(var List: TJclWideStrWideStrSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  395. public
  396. constructor Create(ACapacity: Integer);
  397. destructor Destroy; override;
  398. { IJclPackable }
  399. procedure SetCapacity(Value: Integer); override;
  400. { IJclWideStrWideStrMap }
  401. procedure Clear;
  402. function ContainsKey(const Key: WideString): Boolean;
  403. function ContainsValue(const Value: WideString): Boolean;
  404. function Extract(const Key: WideString): WideString;
  405. function GetValue(const Key: WideString): WideString;
  406. function IsEmpty: Boolean;
  407. function KeyOfValue(const Value: WideString): WideString;
  408. function KeySet: IJclWideStrSet;
  409. function MapEquals(const AMap: IJclWideStrWideStrMap): Boolean;
  410. procedure PutAll(const AMap: IJclWideStrWideStrMap);
  411. procedure PutValue(const Key: WideString; const Value: WideString);
  412. function Remove(const Key: WideString): WideString;
  413. function Size: Integer;
  414. function Values: IJclWideStrCollection;
  415. { IJclWideStrWideStrSortedMap }
  416. function FirstKey: WideString;
  417. function HeadMap(const ToKey: WideString): IJclWideStrWideStrSortedMap;
  418. function LastKey: WideString;
  419. function SubMap(const FromKey, ToKey: WideString): IJclWideStrWideStrSortedMap;
  420. function TailMap(const FromKey: WideString): IJclWideStrWideStrSortedMap;
  421. end;
  422. {$IFDEF SUPPORTS_UNICODE_STRING}
  423. TJclUnicodeStrIntfSortedMapEntry = record
  424. Key: UnicodeString;
  425. Value: IInterface;
  426. end;
  427. TJclUnicodeStrIntfSortedMapEntryArray = array of TJclUnicodeStrIntfSortedMapEntry;
  428. {$ENDIF SUPPORTS_UNICODE_STRING}
  429. {$IFDEF SUPPORTS_UNICODE_STRING}
  430. TJclUnicodeStrIntfSortedMap = class(TJclUnicodeStrAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE}
  431. IJclIntfCloneable, IJclCloneable, IJclGrowable, IJclPackable, IJclBaseContainer, IJclStrBaseContainer, IJclUnicodeStrContainer, IJclIntfContainer,
  432. IJclUnicodeStrIntfMap, IJclUnicodeStrIntfSortedMap)
  433. protected
  434. function CreateEmptyContainer: TJclAbstractContainerBase; override;
  435. function FreeKey(var Key: UnicodeString): UnicodeString;
  436. function FreeValue(var Value: IInterface): IInterface;
  437. function KeysCompare(const A, B: UnicodeString): Integer;
  438. function ValuesCompare(const A, B: IInterface): Integer;
  439. private
  440. FEntries: TJclUnicodeStrIntfSortedMapEntryArray;
  441. function BinarySearch(const Key: UnicodeString): Integer;
  442. protected
  443. procedure AssignDataTo(Dest: TJclAbstractContainerBase); override;
  444. procedure FinalizeArrayBeforeMove(var List: TJclUnicodeStrIntfSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  445. {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
  446. procedure InitializeArray(var List: TJclUnicodeStrIntfSortedMapEntryArray; FromIndex, Count: SizeInt);
  447. {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
  448. procedure InitializeArrayAfterMove(var List: TJclUnicodeStrIntfSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  449. {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
  450. procedure MoveArray(var List: TJclUnicodeStrIntfSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  451. public
  452. constructor Create(ACapacity: Integer);
  453. destructor Destroy; override;
  454. { IJclPackable }
  455. procedure SetCapacity(Value: Integer); override;
  456. { IJclUnicodeStrIntfMap }
  457. procedure Clear;
  458. function ContainsKey(const Key: UnicodeString): Boolean;
  459. function ContainsValue(const Value: IInterface): Boolean;
  460. function Extract(const Key: UnicodeString): IInterface;
  461. function GetValue(const Key: UnicodeString): IInterface;
  462. function IsEmpty: Boolean;
  463. function KeyOfValue(const Value: IInterface): UnicodeString;
  464. function KeySet: IJclUnicodeStrSet;
  465. function MapEquals(const AMap: IJclUnicodeStrIntfMap): Boolean;
  466. procedure PutAll(const AMap: IJclUnicodeStrIntfMap);
  467. procedure PutValue(const Key: UnicodeString; const Value: IInterface);
  468. function Remove(const Key: UnicodeString): IInterface;
  469. function Size: Integer;
  470. function Values: IJclIntfCollection;
  471. { IJclUnicodeStrIntfSortedMap }
  472. function FirstKey: UnicodeString;
  473. function HeadMap(const ToKey: UnicodeString): IJclUnicodeStrIntfSortedMap;
  474. function LastKey: UnicodeString;
  475. function SubMap(const FromKey, ToKey: UnicodeString): IJclUnicodeStrIntfSortedMap;
  476. function TailMap(const FromKey: UnicodeString): IJclUnicodeStrIntfSortedMap;
  477. end;
  478. {$ENDIF SUPPORTS_UNICODE_STRING}
  479. {$IFDEF SUPPORTS_UNICODE_STRING}
  480. TJclIntfUnicodeStrSortedMapEntry = record
  481. Key: IInterface;
  482. Value: UnicodeString;
  483. end;
  484. TJclIntfUnicodeStrSortedMapEntryArray = array of TJclIntfUnicodeStrSortedMapEntry;
  485. {$ENDIF SUPPORTS_UNICODE_STRING}
  486. {$IFDEF SUPPORTS_UNICODE_STRING}
  487. TJclIntfUnicodeStrSortedMap = class(TJclUnicodeStrAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE}
  488. IJclIntfCloneable, IJclCloneable, IJclGrowable, IJclPackable, IJclBaseContainer, IJclStrBaseContainer, IJclIntfContainer, IJclUnicodeStrContainer,
  489. IJclIntfUnicodeStrMap, IJclIntfUnicodeStrSortedMap)
  490. protected
  491. function CreateEmptyContainer: TJclAbstractContainerBase; override;
  492. function FreeKey(var Key: IInterface): IInterface;
  493. function FreeValue(var Value: UnicodeString): UnicodeString;
  494. function KeysCompare(const A, B: IInterface): Integer;
  495. function ValuesCompare(const A, B: UnicodeString): Integer;
  496. private
  497. FEntries: TJclIntfUnicodeStrSortedMapEntryArray;
  498. function BinarySearch(const Key: IInterface): Integer;
  499. protected
  500. procedure AssignDataTo(Dest: TJclAbstractContainerBase); override;
  501. procedure FinalizeArrayBeforeMove(var List: TJclIntfUnicodeStrSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  502. {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
  503. procedure InitializeArray(var List: TJclIntfUnicodeStrSortedMapEntryArray; FromIndex, Count: SizeInt);
  504. {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
  505. procedure InitializeArrayAfterMove(var List: TJclIntfUnicodeStrSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  506. {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
  507. procedure MoveArray(var List: TJclIntfUnicodeStrSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  508. public
  509. constructor Create(ACapacity: Integer);
  510. destructor Destroy; override;
  511. { IJclPackable }
  512. procedure SetCapacity(Value: Integer); override;
  513. { IJclIntfUnicodeStrMap }
  514. procedure Clear;
  515. function ContainsKey(const Key: IInterface): Boolean;
  516. function ContainsValue(const Value: UnicodeString): Boolean;
  517. function Extract(const Key: IInterface): UnicodeString;
  518. function GetValue(const Key: IInterface): UnicodeString;
  519. function IsEmpty: Boolean;
  520. function KeyOfValue(const Value: UnicodeString): IInterface;
  521. function KeySet: IJclIntfSet;
  522. function MapEquals(const AMap: IJclIntfUnicodeStrMap): Boolean;
  523. procedure PutAll(const AMap: IJclIntfUnicodeStrMap);
  524. procedure PutValue(const Key: IInterface; const Value: UnicodeString);
  525. function Remove(const Key: IInterface): UnicodeString;
  526. function Size: Integer;
  527. function Values: IJclUnicodeStrCollection;
  528. { IJclIntfUnicodeStrSortedMap }
  529. function FirstKey: IInterface;
  530. function HeadMap(const ToKey: IInterface): IJclIntfUnicodeStrSortedMap;
  531. function LastKey: IInterface;
  532. function SubMap(const FromKey, ToKey: IInterface): IJclIntfUnicodeStrSortedMap;
  533. function TailMap(const FromKey: IInterface): IJclIntfUnicodeStrSortedMap;
  534. end;
  535. {$ENDIF SUPPORTS_UNICODE_STRING}
  536. {$IFDEF SUPPORTS_UNICODE_STRING}
  537. TJclUnicodeStrUnicodeStrSortedMapEntry = record
  538. Key: UnicodeString;
  539. Value: UnicodeString;
  540. end;
  541. TJclUnicodeStrUnicodeStrSortedMapEntryArray = array of TJclUnicodeStrUnicodeStrSortedMapEntry;
  542. {$ENDIF SUPPORTS_UNICODE_STRING}
  543. {$IFDEF SUPPORTS_UNICODE_STRING}
  544. TJclUnicodeStrUnicodeStrSortedMap = class(TJclUnicodeStrAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE}
  545. IJclIntfCloneable, IJclCloneable, IJclGrowable, IJclPackable, IJclBaseContainer, IJclStrBaseContainer, IJclUnicodeStrContainer,
  546. IJclUnicodeStrUnicodeStrMap, IJclUnicodeStrUnicodeStrSortedMap)
  547. protected
  548. function CreateEmptyContainer: TJclAbstractContainerBase; override;
  549. function FreeKey(var Key: UnicodeString): UnicodeString;
  550. function FreeValue(var Value: UnicodeString): UnicodeString;
  551. function KeysCompare(const A, B: UnicodeString): Integer;
  552. function ValuesCompare(const A, B: UnicodeString): Integer;
  553. private
  554. FEntries: TJclUnicodeStrUnicodeStrSortedMapEntryArray;
  555. function BinarySearch(const Key: UnicodeString): Integer;
  556. protected
  557. procedure AssignDataTo(Dest: TJclAbstractContainerBase); override;
  558. procedure FinalizeArrayBeforeMove(var List: TJclUnicodeStrUnicodeStrSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  559. {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
  560. procedure InitializeArray(var List: TJclUnicodeStrUnicodeStrSortedMapEntryArray; FromIndex, Count: SizeInt);
  561. {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
  562. procedure InitializeArrayAfterMove(var List: TJclUnicodeStrUnicodeStrSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  563. {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
  564. procedure MoveArray(var List: TJclUnicodeStrUnicodeStrSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  565. public
  566. constructor Create(ACapacity: Integer);
  567. destructor Destroy; override;
  568. { IJclPackable }
  569. procedure SetCapacity(Value: Integer); override;
  570. { IJclUnicodeStrUnicodeStrMap }
  571. procedure Clear;
  572. function ContainsKey(const Key: UnicodeString): Boolean;
  573. function ContainsValue(const Value: UnicodeString): Boolean;
  574. function Extract(const Key: UnicodeString): UnicodeString;
  575. function GetValue(const Key: UnicodeString): UnicodeString;
  576. function IsEmpty: Boolean;
  577. function KeyOfValue(const Value: UnicodeString): UnicodeString;
  578. function KeySet: IJclUnicodeStrSet;
  579. function MapEquals(const AMap: IJclUnicodeStrUnicodeStrMap): Boolean;
  580. procedure PutAll(const AMap: IJclUnicodeStrUnicodeStrMap);
  581. procedure PutValue(const Key: UnicodeString; const Value: UnicodeString);
  582. function Remove(const Key: UnicodeString): UnicodeString;
  583. function Size: Integer;
  584. function Values: IJclUnicodeStrCollection;
  585. { IJclUnicodeStrUnicodeStrSortedMap }
  586. function FirstKey: UnicodeString;
  587. function HeadMap(const ToKey: UnicodeString): IJclUnicodeStrUnicodeStrSortedMap;
  588. function LastKey: UnicodeString;
  589. function SubMap(const FromKey, ToKey: UnicodeString): IJclUnicodeStrUnicodeStrSortedMap;
  590. function TailMap(const FromKey: UnicodeString): IJclUnicodeStrUnicodeStrSortedMap;
  591. end;
  592. {$ENDIF SUPPORTS_UNICODE_STRING}
  593. {$IFDEF CONTAINER_ANSISTR}
  594. TJclStrIntfSortedMapEntry = TJclAnsiStrIntfSortedMapEntry;
  595. {$ENDIF CONTAINER_ANSISTR}
  596. {$IFDEF CONTAINER_WIDESTR}
  597. TJclStrIntfSortedMapEntry = TJclWideStrIntfSortedMapEntry;
  598. {$ENDIF CONTAINER_WIDESTR}
  599. {$IFDEF CONTAINER_UNICODESTR}
  600. TJclStrIntfSortedMapEntry = TJclUnicodeStrIntfSortedMapEntry;
  601. {$ENDIF CONTAINER_UNICODESTR}
  602. {$IFDEF CONTAINER_ANSISTR}
  603. TJclStrIntfSortedMap = TJclAnsiStrIntfSortedMap;
  604. {$ENDIF CONTAINER_ANSISTR}
  605. {$IFDEF CONTAINER_WIDESTR}
  606. TJclStrIntfSortedMap = TJclWideStrIntfSortedMap;
  607. {$ENDIF CONTAINER_WIDESTR}
  608. {$IFDEF CONTAINER_UNICODESTR}
  609. TJclStrIntfSortedMap = TJclUnicodeStrIntfSortedMap;
  610. {$ENDIF CONTAINER_UNICODESTR}
  611. {$IFDEF CONTAINER_ANSISTR}
  612. TJclIntfStrSortedMapEntry = TJclIntfAnsiStrSortedMapEntry;
  613. {$ENDIF CONTAINER_ANSISTR}
  614. {$IFDEF CONTAINER_WIDESTR}
  615. TJclIntfStrSortedMapEntry = TJclIntfWideStrSortedMapEntry;
  616. {$ENDIF CONTAINER_WIDESTR}
  617. {$IFDEF CONTAINER_UNICODESTR}
  618. TJclIntfStrSortedMapEntry = TJclIntfUnicodeStrSortedMapEntry;
  619. {$ENDIF CONTAINER_UNICODESTR}
  620. {$IFDEF CONTAINER_ANSISTR}
  621. TJclIntfStrSortedMap = TJclIntfAnsiStrSortedMap;
  622. {$ENDIF CONTAINER_ANSISTR}
  623. {$IFDEF CONTAINER_WIDESTR}
  624. TJclIntfStrSortedMap = TJclIntfWideStrSortedMap;
  625. {$ENDIF CONTAINER_WIDESTR}
  626. {$IFDEF CONTAINER_UNICODESTR}
  627. TJclIntfStrSortedMap = TJclIntfUnicodeStrSortedMap;
  628. {$ENDIF CONTAINER_UNICODESTR}
  629. {$IFDEF CONTAINER_ANSISTR}
  630. TJclStrStrSortedMapEntry = TJclAnsiStrAnsiStrSortedMapEntry;
  631. {$ENDIF CONTAINER_ANSISTR}
  632. {$IFDEF CONTAINER_WIDESTR}
  633. TJclStrStrSortedMapEntry = TJclWideStrWideStrSortedMapEntry;
  634. {$ENDIF CONTAINER_WIDESTR}
  635. {$IFDEF CONTAINER_UNICODESTR}
  636. TJclStrStrSortedMapEntry = TJclUnicodeStrUnicodeStrSortedMapEntry;
  637. {$ENDIF CONTAINER_UNICODESTR}
  638. {$IFDEF CONTAINER_ANSISTR}
  639. TJclStrStrSortedMap = TJclAnsiStrAnsiStrSortedMap;
  640. {$ENDIF CONTAINER_ANSISTR}
  641. {$IFDEF CONTAINER_WIDESTR}
  642. TJclStrStrSortedMap = TJclWideStrWideStrSortedMap;
  643. {$ENDIF CONTAINER_WIDESTR}
  644. {$IFDEF CONTAINER_UNICODESTR}
  645. TJclStrStrSortedMap = TJclUnicodeStrUnicodeStrSortedMap;
  646. {$ENDIF CONTAINER_UNICODESTR}
  647. TJclSingleIntfSortedMapEntry = record
  648. Key: Single;
  649. Value: IInterface;
  650. end;
  651. TJclSingleIntfSortedMapEntryArray = array of TJclSingleIntfSortedMapEntry;
  652. TJclSingleIntfSortedMap = class(TJclSingleAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE}
  653. IJclIntfCloneable, IJclCloneable, IJclGrowable, IJclPackable, IJclBaseContainer, IJclSingleContainer, IJclIntfContainer,
  654. IJclSingleIntfMap, IJclSingleIntfSortedMap)
  655. protected
  656. function CreateEmptyContainer: TJclAbstractContainerBase; override;
  657. function FreeKey(var Key: Single): Single;
  658. function FreeValue(var Value: IInterface): IInterface;
  659. function KeysCompare(const A, B: Single): Integer;
  660. function ValuesCompare(const A, B: IInterface): Integer;
  661. private
  662. FEntries: TJclSingleIntfSortedMapEntryArray;
  663. function BinarySearch(const Key: Single): Integer;
  664. protected
  665. procedure AssignDataTo(Dest: TJclAbstractContainerBase); override;
  666. procedure FinalizeArrayBeforeMove(var List: TJclSingleIntfSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  667. {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
  668. procedure InitializeArray(var List: TJclSingleIntfSortedMapEntryArray; FromIndex, Count: SizeInt);
  669. {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
  670. procedure InitializeArrayAfterMove(var List: TJclSingleIntfSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  671. {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
  672. procedure MoveArray(var List: TJclSingleIntfSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  673. public
  674. constructor Create(ACapacity: Integer);
  675. destructor Destroy; override;
  676. { IJclPackable }
  677. procedure SetCapacity(Value: Integer); override;
  678. { IJclSingleIntfMap }
  679. procedure Clear;
  680. function ContainsKey(const Key: Single): Boolean;
  681. function ContainsValue(const Value: IInterface): Boolean;
  682. function Extract(const Key: Single): IInterface;
  683. function GetValue(const Key: Single): IInterface;
  684. function IsEmpty: Boolean;
  685. function KeyOfValue(const Value: IInterface): Single;
  686. function KeySet: IJclSingleSet;
  687. function MapEquals(const AMap: IJclSingleIntfMap): Boolean;
  688. procedure PutAll(const AMap: IJclSingleIntfMap);
  689. procedure PutValue(const Key: Single; const Value: IInterface);
  690. function Remove(const Key: Single): IInterface;
  691. function Size: Integer;
  692. function Values: IJclIntfCollection;
  693. { IJclSingleIntfSortedMap }
  694. function FirstKey: Single;
  695. function HeadMap(const ToKey: Single): IJclSingleIntfSortedMap;
  696. function LastKey: Single;
  697. function SubMap(const FromKey, ToKey: Single): IJclSingleIntfSortedMap;
  698. function TailMap(const FromKey: Single): IJclSingleIntfSortedMap;
  699. end;
  700. TJclIntfSingleSortedMapEntry = record
  701. Key: IInterface;
  702. Value: Single;
  703. end;
  704. TJclIntfSingleSortedMapEntryArray = array of TJclIntfSingleSortedMapEntry;
  705. TJclIntfSingleSortedMap = class(TJclSingleAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE}
  706. IJclIntfCloneable, IJclCloneable, IJclGrowable, IJclPackable, IJclBaseContainer, IJclIntfContainer, IJclSingleContainer,
  707. IJclIntfSingleMap, IJclIntfSingleSortedMap)
  708. protected
  709. function CreateEmptyContainer: TJclAbstractContainerBase; override;
  710. function FreeKey(var Key: IInterface): IInterface;
  711. function FreeValue(var Value: Single): Single;
  712. function KeysCompare(const A, B: IInterface): Integer;
  713. function ValuesCompare(const A, B: Single): Integer;
  714. private
  715. FEntries: TJclIntfSingleSortedMapEntryArray;
  716. function BinarySearch(const Key: IInterface): Integer;
  717. protected
  718. procedure AssignDataTo(Dest: TJclAbstractContainerBase); override;
  719. procedure FinalizeArrayBeforeMove(var List: TJclIntfSingleSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  720. {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
  721. procedure InitializeArray(var List: TJclIntfSingleSortedMapEntryArray; FromIndex, Count: SizeInt);
  722. {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
  723. procedure InitializeArrayAfterMove(var List: TJclIntfSingleSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  724. {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
  725. procedure MoveArray(var List: TJclIntfSingleSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  726. public
  727. constructor Create(ACapacity: Integer);
  728. destructor Destroy; override;
  729. { IJclPackable }
  730. procedure SetCapacity(Value: Integer); override;
  731. { IJclIntfSingleMap }
  732. procedure Clear;
  733. function ContainsKey(const Key: IInterface): Boolean;
  734. function ContainsValue(const Value: Single): Boolean;
  735. function Extract(const Key: IInterface): Single;
  736. function GetValue(const Key: IInterface): Single;
  737. function IsEmpty: Boolean;
  738. function KeyOfValue(const Value: Single): IInterface;
  739. function KeySet: IJclIntfSet;
  740. function MapEquals(const AMap: IJclIntfSingleMap): Boolean;
  741. procedure PutAll(const AMap: IJclIntfSingleMap);
  742. procedure PutValue(const Key: IInterface; const Value: Single);
  743. function Remove(const Key: IInterface): Single;
  744. function Size: Integer;
  745. function Values: IJclSingleCollection;
  746. { IJclIntfSingleSortedMap }
  747. function FirstKey: IInterface;
  748. function HeadMap(const ToKey: IInterface): IJclIntfSingleSortedMap;
  749. function LastKey: IInterface;
  750. function SubMap(const FromKey, ToKey: IInterface): IJclIntfSingleSortedMap;
  751. function TailMap(const FromKey: IInterface): IJclIntfSingleSortedMap;
  752. end;
  753. TJclSingleSingleSortedMapEntry = record
  754. Key: Single;
  755. Value: Single;
  756. end;
  757. TJclSingleSingleSortedMapEntryArray = array of TJclSingleSingleSortedMapEntry;
  758. TJclSingleSingleSortedMap = class(TJclSingleAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE}
  759. IJclIntfCloneable, IJclCloneable, IJclGrowable, IJclPackable, IJclBaseContainer, IJclSingleContainer,
  760. IJclSingleSingleMap, IJclSingleSingleSortedMap)
  761. protected
  762. function CreateEmptyContainer: TJclAbstractContainerBase; override;
  763. function FreeKey(var Key: Single): Single;
  764. function FreeValue(var Value: Single): Single;
  765. function KeysCompare(const A, B: Single): Integer;
  766. function ValuesCompare(const A, B: Single): Integer;
  767. private
  768. FEntries: TJclSingleSingleSortedMapEntryArray;
  769. function BinarySearch(const Key: Single): Integer;
  770. protected
  771. procedure AssignDataTo(Dest: TJclAbstractContainerBase); override;
  772. procedure InitializeArrayAfterMove(var List: TJclSingleSingleSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  773. {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
  774. procedure MoveArray(var List: TJclSingleSingleSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  775. public
  776. constructor Create(ACapacity: Integer);
  777. destructor Destroy; override;
  778. { IJclPackable }
  779. procedure SetCapacity(Value: Integer); override;
  780. { IJclSingleSingleMap }
  781. procedure Clear;
  782. function ContainsKey(const Key: Single): Boolean;
  783. function ContainsValue(const Value: Single): Boolean;
  784. function Extract(const Key: Single): Single;
  785. function GetValue(const Key: Single): Single;
  786. function IsEmpty: Boolean;
  787. function KeyOfValue(const Value: Single): Single;
  788. function KeySet: IJclSingleSet;
  789. function MapEquals(const AMap: IJclSingleSingleMap): Boolean;
  790. procedure PutAll(const AMap: IJclSingleSingleMap);
  791. procedure PutValue(const Key: Single; const Value: Single);
  792. function Remove(const Key: Single): Single;
  793. function Size: Integer;
  794. function Values: IJclSingleCollection;
  795. { IJclSingleSingleSortedMap }
  796. function FirstKey: Single;
  797. function HeadMap(const ToKey: Single): IJclSingleSingleSortedMap;
  798. function LastKey: Single;
  799. function SubMap(const FromKey, ToKey: Single): IJclSingleSingleSortedMap;
  800. function TailMap(const FromKey: Single): IJclSingleSingleSortedMap;
  801. end;
  802. TJclDoubleIntfSortedMapEntry = record
  803. Key: Double;
  804. Value: IInterface;
  805. end;
  806. TJclDoubleIntfSortedMapEntryArray = array of TJclDoubleIntfSortedMapEntry;
  807. TJclDoubleIntfSortedMap = class(TJclDoubleAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE}
  808. IJclIntfCloneable, IJclCloneable, IJclGrowable, IJclPackable, IJclBaseContainer, IJclDoubleContainer, IJclIntfContainer,
  809. IJclDoubleIntfMap, IJclDoubleIntfSortedMap)
  810. protected
  811. function CreateEmptyContainer: TJclAbstractContainerBase; override;
  812. function FreeKey(var Key: Double): Double;
  813. function FreeValue(var Value: IInterface): IInterface;
  814. function KeysCompare(const A, B: Double): Integer;
  815. function ValuesCompare(const A, B: IInterface): Integer;
  816. private
  817. FEntries: TJclDoubleIntfSortedMapEntryArray;
  818. function BinarySearch(const Key: Double): Integer;
  819. protected
  820. procedure AssignDataTo(Dest: TJclAbstractContainerBase); override;
  821. procedure FinalizeArrayBeforeMove(var List: TJclDoubleIntfSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  822. {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
  823. procedure InitializeArray(var List: TJclDoubleIntfSortedMapEntryArray; FromIndex, Count: SizeInt);
  824. {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
  825. procedure InitializeArrayAfterMove(var List: TJclDoubleIntfSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  826. {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
  827. procedure MoveArray(var List: TJclDoubleIntfSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  828. public
  829. constructor Create(ACapacity: Integer);
  830. destructor Destroy; override;
  831. { IJclPackable }
  832. procedure SetCapacity(Value: Integer); override;
  833. { IJclDoubleIntfMap }
  834. procedure Clear;
  835. function ContainsKey(const Key: Double): Boolean;
  836. function ContainsValue(const Value: IInterface): Boolean;
  837. function Extract(const Key: Double): IInterface;
  838. function GetValue(const Key: Double): IInterface;
  839. function IsEmpty: Boolean;
  840. function KeyOfValue(const Value: IInterface): Double;
  841. function KeySet: IJclDoubleSet;
  842. function MapEquals(const AMap: IJclDoubleIntfMap): Boolean;
  843. procedure PutAll(const AMap: IJclDoubleIntfMap);
  844. procedure PutValue(const Key: Double; const Value: IInterface);
  845. function Remove(const Key: Double): IInterface;
  846. function Size: Integer;
  847. function Values: IJclIntfCollection;
  848. { IJclDoubleIntfSortedMap }
  849. function FirstKey: Double;
  850. function HeadMap(const ToKey: Double): IJclDoubleIntfSortedMap;
  851. function LastKey: Double;
  852. function SubMap(const FromKey, ToKey: Double): IJclDoubleIntfSortedMap;
  853. function TailMap(const FromKey: Double): IJclDoubleIntfSortedMap;
  854. end;
  855. TJclIntfDoubleSortedMapEntry = record
  856. Key: IInterface;
  857. Value: Double;
  858. end;
  859. TJclIntfDoubleSortedMapEntryArray = array of TJclIntfDoubleSortedMapEntry;
  860. TJclIntfDoubleSortedMap = class(TJclDoubleAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE}
  861. IJclIntfCloneable, IJclCloneable, IJclGrowable, IJclPackable, IJclBaseContainer, IJclIntfContainer, IJclDoubleContainer,
  862. IJclIntfDoubleMap, IJclIntfDoubleSortedMap)
  863. protected
  864. function CreateEmptyContainer: TJclAbstractContainerBase; override;
  865. function FreeKey(var Key: IInterface): IInterface;
  866. function FreeValue(var Value: Double): Double;
  867. function KeysCompare(const A, B: IInterface): Integer;
  868. function ValuesCompare(const A, B: Double): Integer;
  869. private
  870. FEntries: TJclIntfDoubleSortedMapEntryArray;
  871. function BinarySearch(const Key: IInterface): Integer;
  872. protected
  873. procedure AssignDataTo(Dest: TJclAbstractContainerBase); override;
  874. procedure FinalizeArrayBeforeMove(var List: TJclIntfDoubleSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  875. {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
  876. procedure InitializeArray(var List: TJclIntfDoubleSortedMapEntryArray; FromIndex, Count: SizeInt);
  877. {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
  878. procedure InitializeArrayAfterMove(var List: TJclIntfDoubleSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  879. {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
  880. procedure MoveArray(var List: TJclIntfDoubleSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  881. public
  882. constructor Create(ACapacity: Integer);
  883. destructor Destroy; override;
  884. { IJclPackable }
  885. procedure SetCapacity(Value: Integer); override;
  886. { IJclIntfDoubleMap }
  887. procedure Clear;
  888. function ContainsKey(const Key: IInterface): Boolean;
  889. function ContainsValue(const Value: Double): Boolean;
  890. function Extract(const Key: IInterface): Double;
  891. function GetValue(const Key: IInterface): Double;
  892. function IsEmpty: Boolean;
  893. function KeyOfValue(const Value: Double): IInterface;
  894. function KeySet: IJclIntfSet;
  895. function MapEquals(const AMap: IJclIntfDoubleMap): Boolean;
  896. procedure PutAll(const AMap: IJclIntfDoubleMap);
  897. procedure PutValue(const Key: IInterface; const Value: Double);
  898. function Remove(const Key: IInterface): Double;
  899. function Size: Integer;
  900. function Values: IJclDoubleCollection;
  901. { IJclIntfDoubleSortedMap }
  902. function FirstKey: IInterface;
  903. function HeadMap(const ToKey: IInterface): IJclIntfDoubleSortedMap;
  904. function LastKey: IInterface;
  905. function SubMap(const FromKey, ToKey: IInterface): IJclIntfDoubleSortedMap;
  906. function TailMap(const FromKey: IInterface): IJclIntfDoubleSortedMap;
  907. end;
  908. TJclDoubleDoubleSortedMapEntry = record
  909. Key: Double;
  910. Value: Double;
  911. end;
  912. TJclDoubleDoubleSortedMapEntryArray = array of TJclDoubleDoubleSortedMapEntry;
  913. TJclDoubleDoubleSortedMap = class(TJclDoubleAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE}
  914. IJclIntfCloneable, IJclCloneable, IJclGrowable, IJclPackable, IJclBaseContainer, IJclDoubleContainer,
  915. IJclDoubleDoubleMap, IJclDoubleDoubleSortedMap)
  916. protected
  917. function CreateEmptyContainer: TJclAbstractContainerBase; override;
  918. function FreeKey(var Key: Double): Double;
  919. function FreeValue(var Value: Double): Double;
  920. function KeysCompare(const A, B: Double): Integer;
  921. function ValuesCompare(const A, B: Double): Integer;
  922. private
  923. FEntries: TJclDoubleDoubleSortedMapEntryArray;
  924. function BinarySearch(const Key: Double): Integer;
  925. protected
  926. procedure AssignDataTo(Dest: TJclAbstractContainerBase); override;
  927. procedure InitializeArrayAfterMove(var List: TJclDoubleDoubleSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  928. {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
  929. procedure MoveArray(var List: TJclDoubleDoubleSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  930. public
  931. constructor Create(ACapacity: Integer);
  932. destructor Destroy; override;
  933. { IJclPackable }
  934. procedure SetCapacity(Value: Integer); override;
  935. { IJclDoubleDoubleMap }
  936. procedure Clear;
  937. function ContainsKey(const Key: Double): Boolean;
  938. function ContainsValue(const Value: Double): Boolean;
  939. function Extract(const Key: Double): Double;
  940. function GetValue(const Key: Double): Double;
  941. function IsEmpty: Boolean;
  942. function KeyOfValue(const Value: Double): Double;
  943. function KeySet: IJclDoubleSet;
  944. function MapEquals(const AMap: IJclDoubleDoubleMap): Boolean;
  945. procedure PutAll(const AMap: IJclDoubleDoubleMap);
  946. procedure PutValue(const Key: Double; const Value: Double);
  947. function Remove(const Key: Double): Double;
  948. function Size: Integer;
  949. function Values: IJclDoubleCollection;
  950. { IJclDoubleDoubleSortedMap }
  951. function FirstKey: Double;
  952. function HeadMap(const ToKey: Double): IJclDoubleDoubleSortedMap;
  953. function LastKey: Double;
  954. function SubMap(const FromKey, ToKey: Double): IJclDoubleDoubleSortedMap;
  955. function TailMap(const FromKey: Double): IJclDoubleDoubleSortedMap;
  956. end;
  957. TJclExtendedIntfSortedMapEntry = record
  958. Key: Extended;
  959. Value: IInterface;
  960. end;
  961. TJclExtendedIntfSortedMapEntryArray = array of TJclExtendedIntfSortedMapEntry;
  962. TJclExtendedIntfSortedMap = class(TJclExtendedAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE}
  963. IJclIntfCloneable, IJclCloneable, IJclGrowable, IJclPackable, IJclBaseContainer, IJclExtendedContainer, IJclIntfContainer,
  964. IJclExtendedIntfMap, IJclExtendedIntfSortedMap)
  965. protected
  966. function CreateEmptyContainer: TJclAbstractContainerBase; override;
  967. function FreeKey(var Key: Extended): Extended;
  968. function FreeValue(var Value: IInterface): IInterface;
  969. function KeysCompare(const A, B: Extended): Integer;
  970. function ValuesCompare(const A, B: IInterface): Integer;
  971. private
  972. FEntries: TJclExtendedIntfSortedMapEntryArray;
  973. function BinarySearch(const Key: Extended): Integer;
  974. protected
  975. procedure AssignDataTo(Dest: TJclAbstractContainerBase); override;
  976. procedure FinalizeArrayBeforeMove(var List: TJclExtendedIntfSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  977. {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
  978. procedure InitializeArray(var List: TJclExtendedIntfSortedMapEntryArray; FromIndex, Count: SizeInt);
  979. {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
  980. procedure InitializeArrayAfterMove(var List: TJclExtendedIntfSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  981. {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
  982. procedure MoveArray(var List: TJclExtendedIntfSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  983. public
  984. constructor Create(ACapacity: Integer);
  985. destructor Destroy; override;
  986. { IJclPackable }
  987. procedure SetCapacity(Value: Integer); override;
  988. { IJclExtendedIntfMap }
  989. procedure Clear;
  990. function ContainsKey(const Key: Extended): Boolean;
  991. function ContainsValue(const Value: IInterface): Boolean;
  992. function Extract(const Key: Extended): IInterface;
  993. function GetValue(const Key: Extended): IInterface;
  994. function IsEmpty: Boolean;
  995. function KeyOfValue(const Value: IInterface): Extended;
  996. function KeySet: IJclExtendedSet;
  997. function MapEquals(const AMap: IJclExtendedIntfMap): Boolean;
  998. procedure PutAll(const AMap: IJclExtendedIntfMap);
  999. procedure PutValue(const Key: Extended; const Value: IInterface);
  1000. function Remove(const Key: Extended): IInterface;
  1001. function Size: Integer;
  1002. function Values: IJclIntfCollection;
  1003. { IJclExtendedIntfSortedMap }
  1004. function FirstKey: Extended;
  1005. function HeadMap(const ToKey: Extended): IJclExtendedIntfSortedMap;
  1006. function LastKey: Extended;
  1007. function SubMap(const FromKey, ToKey: Extended): IJclExtendedIntfSortedMap;
  1008. function TailMap(const FromKey: Extended): IJclExtendedIntfSortedMap;
  1009. end;
  1010. TJclIntfExtendedSortedMapEntry = record
  1011. Key: IInterface;
  1012. Value: Extended;
  1013. end;
  1014. TJclIntfExtendedSortedMapEntryArray = array of TJclIntfExtendedSortedMapEntry;
  1015. TJclIntfExtendedSortedMap = class(TJclExtendedAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE}
  1016. IJclIntfCloneable, IJclCloneable, IJclGrowable, IJclPackable, IJclBaseContainer, IJclIntfContainer, IJclExtendedContainer,
  1017. IJclIntfExtendedMap, IJclIntfExtendedSortedMap)
  1018. protected
  1019. function CreateEmptyContainer: TJclAbstractContainerBase; override;
  1020. function FreeKey(var Key: IInterface): IInterface;
  1021. function FreeValue(var Value: Extended): Extended;
  1022. function KeysCompare(const A, B: IInterface): Integer;
  1023. function ValuesCompare(const A, B: Extended): Integer;
  1024. private
  1025. FEntries: TJclIntfExtendedSortedMapEntryArray;
  1026. function BinarySearch(const Key: IInterface): Integer;
  1027. protected
  1028. procedure AssignDataTo(Dest: TJclAbstractContainerBase); override;
  1029. procedure FinalizeArrayBeforeMove(var List: TJclIntfExtendedSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  1030. {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
  1031. procedure InitializeArray(var List: TJclIntfExtendedSortedMapEntryArray; FromIndex, Count: SizeInt);
  1032. {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
  1033. procedure InitializeArrayAfterMove(var List: TJclIntfExtendedSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  1034. {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
  1035. procedure MoveArray(var List: TJclIntfExtendedSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  1036. public
  1037. constructor Create(ACapacity: Integer);
  1038. destructor Destroy; override;
  1039. { IJclPackable }
  1040. procedure SetCapacity(Value: Integer); override;
  1041. { IJclIntfExtendedMap }
  1042. procedure Clear;
  1043. function ContainsKey(const Key: IInterface): Boolean;
  1044. function ContainsValue(const Value: Extended): Boolean;
  1045. function Extract(const Key: IInterface): Extended;
  1046. function GetValue(const Key: IInterface): Extended;
  1047. function IsEmpty: Boolean;
  1048. function KeyOfValue(const Value: Extended): IInterface;
  1049. function KeySet: IJclIntfSet;
  1050. function MapEquals(const AMap: IJclIntfExtendedMap): Boolean;
  1051. procedure PutAll(const AMap: IJclIntfExtendedMap);
  1052. procedure PutValue(const Key: IInterface; const Value: Extended);
  1053. function Remove(const Key: IInterface): Extended;
  1054. function Size: Integer;
  1055. function Values: IJclExtendedCollection;
  1056. { IJclIntfExtendedSortedMap }
  1057. function FirstKey: IInterface;
  1058. function HeadMap(const ToKey: IInterface): IJclIntfExtendedSortedMap;
  1059. function LastKey: IInterface;
  1060. function SubMap(const FromKey, ToKey: IInterface): IJclIntfExtendedSortedMap;
  1061. function TailMap(const FromKey: IInterface): IJclIntfExtendedSortedMap;
  1062. end;
  1063. TJclExtendedExtendedSortedMapEntry = record
  1064. Key: Extended;
  1065. Value: Extended;
  1066. end;
  1067. TJclExtendedExtendedSortedMapEntryArray = array of TJclExtendedExtendedSortedMapEntry;
  1068. TJclExtendedExtendedSortedMap = class(TJclExtendedAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE}
  1069. IJclIntfCloneable, IJclCloneable, IJclGrowable, IJclPackable, IJclBaseContainer, IJclExtendedContainer,
  1070. IJclExtendedExtendedMap, IJclExtendedExtendedSortedMap)
  1071. protected
  1072. function CreateEmptyContainer: TJclAbstractContainerBase; override;
  1073. function FreeKey(var Key: Extended): Extended;
  1074. function FreeValue(var Value: Extended): Extended;
  1075. function KeysCompare(const A, B: Extended): Integer;
  1076. function ValuesCompare(const A, B: Extended): Integer;
  1077. private
  1078. FEntries: TJclExtendedExtendedSortedMapEntryArray;
  1079. function BinarySearch(const Key: Extended): Integer;
  1080. protected
  1081. procedure AssignDataTo(Dest: TJclAbstractContainerBase); override;
  1082. procedure InitializeArrayAfterMove(var List: TJclExtendedExtendedSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  1083. {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
  1084. procedure MoveArray(var List: TJclExtendedExtendedSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  1085. public
  1086. constructor Create(ACapacity: Integer);
  1087. destructor Destroy; override;
  1088. { IJclPackable }
  1089. procedure SetCapacity(Value: Integer); override;
  1090. { IJclExtendedExtendedMap }
  1091. procedure Clear;
  1092. function ContainsKey(const Key: Extended): Boolean;
  1093. function ContainsValue(const Value: Extended): Boolean;
  1094. function Extract(const Key: Extended): Extended;
  1095. function GetValue(const Key: Extended): Extended;
  1096. function IsEmpty: Boolean;
  1097. function KeyOfValue(const Value: Extended): Extended;
  1098. function KeySet: IJclExtendedSet;
  1099. function MapEquals(const AMap: IJclExtendedExtendedMap): Boolean;
  1100. procedure PutAll(const AMap: IJclExtendedExtendedMap);
  1101. procedure PutValue(const Key: Extended; const Value: Extended);
  1102. function Remove(const Key: Extended): Extended;
  1103. function Size: Integer;
  1104. function Values: IJclExtendedCollection;
  1105. { IJclExtendedExtendedSortedMap }
  1106. function FirstKey: Extended;
  1107. function HeadMap(const ToKey: Extended): IJclExtendedExtendedSortedMap;
  1108. function LastKey: Extended;
  1109. function SubMap(const FromKey, ToKey: Extended): IJclExtendedExtendedSortedMap;
  1110. function TailMap(const FromKey: Extended): IJclExtendedExtendedSortedMap;
  1111. end;
  1112. {$IFDEF MATH_SINGLE_PRECISION}
  1113. TJclFloatIntfSortedMapEntry = TJclSingleIntfSortedMapEntry;
  1114. {$ENDIF MATH_SINGLE_PRECISION}
  1115. {$IFDEF MATH_DOUBLE_PRECISION}
  1116. TJclFloatIntfSortedMapEntry = TJclDoubleIntfSortedMapEntry;
  1117. {$ENDIF MATH_DOUBLE_PRECISION}
  1118. {$IFDEF MATH_EXTENDED_PRECISION}
  1119. TJclFloatIntfSortedMapEntry = TJclExtendedIntfSortedMapEntry;
  1120. {$ENDIF MATH_EXTENDED_PRECISION}
  1121. {$IFDEF MATH_SINGLE_PRECISION}
  1122. TJclFloatIntfSortedMap = TJclSingleIntfSortedMap;
  1123. {$ENDIF MATH_SINGLE_PRECISION}
  1124. {$IFDEF MATH_DOUBLE_PRECISION}
  1125. TJclFloatIntfSortedMap = TJclDoubleIntfSortedMap;
  1126. {$ENDIF MATH_DOUBLE_PRECISION}
  1127. {$IFDEF MATH_EXTENDED_PRECISION}
  1128. TJclFloatIntfSortedMap = TJclExtendedIntfSortedMap;
  1129. {$ENDIF MATH_EXTENDED_PRECISION}
  1130. {$IFDEF MATH_SINGLE_PRECISION}
  1131. TJclIntfFloatSortedMapEntry = TJclIntfSingleSortedMapEntry;
  1132. {$ENDIF MATH_SINGLE_PRECISION}
  1133. {$IFDEF MATH_DOUBLE_PRECISION}
  1134. TJclIntfFloatSortedMapEntry = TJclIntfDoubleSortedMapEntry;
  1135. {$ENDIF MATH_DOUBLE_PRECISION}
  1136. {$IFDEF MATH_EXTENDED_PRECISION}
  1137. TJclIntfFloatSortedMapEntry = TJclIntfExtendedSortedMapEntry;
  1138. {$ENDIF MATH_EXTENDED_PRECISION}
  1139. {$IFDEF MATH_SINGLE_PRECISION}
  1140. TJclIntfFloatSortedMap = TJclIntfSingleSortedMap;
  1141. {$ENDIF MATH_SINGLE_PRECISION}
  1142. {$IFDEF MATH_DOUBLE_PRECISION}
  1143. TJclIntfFloatSortedMap = TJclIntfDoubleSortedMap;
  1144. {$ENDIF MATH_DOUBLE_PRECISION}
  1145. {$IFDEF MATH_EXTENDED_PRECISION}
  1146. TJclIntfFloatSortedMap = TJclIntfExtendedSortedMap;
  1147. {$ENDIF MATH_EXTENDED_PRECISION}
  1148. {$IFDEF MATH_SINGLE_PRECISION}
  1149. TJclFloatFloatSortedMapEntry = TJclSingleSingleSortedMapEntry;
  1150. {$ENDIF MATH_SINGLE_PRECISION}
  1151. {$IFDEF MATH_DOUBLE_PRECISION}
  1152. TJclFloatFloatSortedMapEntry = TJclDoubleDoubleSortedMapEntry;
  1153. {$ENDIF MATH_DOUBLE_PRECISION}
  1154. {$IFDEF MATH_EXTENDED_PRECISION}
  1155. TJclFloatFloatSortedMapEntry = TJclExtendedExtendedSortedMapEntry;
  1156. {$ENDIF MATH_EXTENDED_PRECISION}
  1157. {$IFDEF MATH_SINGLE_PRECISION}
  1158. TJclFloatFloatSortedMap = TJclSingleSingleSortedMap;
  1159. {$ENDIF MATH_SINGLE_PRECISION}
  1160. {$IFDEF MATH_DOUBLE_PRECISION}
  1161. TJclFloatFloatSortedMap = TJclDoubleDoubleSortedMap;
  1162. {$ENDIF MATH_DOUBLE_PRECISION}
  1163. {$IFDEF MATH_EXTENDED_PRECISION}
  1164. TJclFloatFloatSortedMap = TJclExtendedExtendedSortedMap;
  1165. {$ENDIF MATH_EXTENDED_PRECISION}
  1166. TJclIntegerIntfSortedMapEntry = record
  1167. Key: Integer;
  1168. Value: IInterface;
  1169. end;
  1170. TJclIntegerIntfSortedMapEntryArray = array of TJclIntegerIntfSortedMapEntry;
  1171. TJclIntegerIntfSortedMap = class(TJclIntegerAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE}
  1172. IJclIntfCloneable, IJclCloneable, IJclGrowable, IJclPackable, IJclBaseContainer, IJclIntegerContainer, IJclIntfContainer,
  1173. IJclIntegerIntfMap, IJclIntegerIntfSortedMap)
  1174. protected
  1175. function CreateEmptyContainer: TJclAbstractContainerBase; override;
  1176. function FreeKey(var Key: Integer): Integer;
  1177. function FreeValue(var Value: IInterface): IInterface;
  1178. function KeysCompare(A, B: Integer): Integer;
  1179. function ValuesCompare(const A, B: IInterface): Integer;
  1180. private
  1181. FEntries: TJclIntegerIntfSortedMapEntryArray;
  1182. function BinarySearch(Key: Integer): Integer;
  1183. protected
  1184. procedure AssignDataTo(Dest: TJclAbstractContainerBase); override;
  1185. procedure FinalizeArrayBeforeMove(var List: TJclIntegerIntfSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  1186. {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
  1187. procedure InitializeArray(var List: TJclIntegerIntfSortedMapEntryArray; FromIndex, Count: SizeInt);
  1188. {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
  1189. procedure InitializeArrayAfterMove(var List: TJclIntegerIntfSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  1190. {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
  1191. procedure MoveArray(var List: TJclIntegerIntfSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  1192. public
  1193. constructor Create(ACapacity: Integer);
  1194. destructor Destroy; override;
  1195. { IJclPackable }
  1196. procedure SetCapacity(Value: Integer); override;
  1197. { IJclIntegerIntfMap }
  1198. procedure Clear;
  1199. function ContainsKey(Key: Integer): Boolean;
  1200. function ContainsValue(const Value: IInterface): Boolean;
  1201. function Extract(Key: Integer): IInterface;
  1202. function GetValue(Key: Integer): IInterface;
  1203. function IsEmpty: Boolean;
  1204. function KeyOfValue(const Value: IInterface): Integer;
  1205. function KeySet: IJclIntegerSet;
  1206. function MapEquals(const AMap: IJclIntegerIntfMap): Boolean;
  1207. procedure PutAll(const AMap: IJclIntegerIntfMap);
  1208. procedure PutValue(Key: Integer; const Value: IInterface);
  1209. function Remove(Key: Integer): IInterface;
  1210. function Size: Integer;
  1211. function Values: IJclIntfCollection;
  1212. { IJclIntegerIntfSortedMap }
  1213. function FirstKey: Integer;
  1214. function HeadMap(ToKey: Integer): IJclIntegerIntfSortedMap;
  1215. function LastKey: Integer;
  1216. function SubMap(FromKey, ToKey: Integer): IJclIntegerIntfSortedMap;
  1217. function TailMap(FromKey: Integer): IJclIntegerIntfSortedMap;
  1218. end;
  1219. TJclIntfIntegerSortedMapEntry = record
  1220. Key: IInterface;
  1221. Value: Integer;
  1222. end;
  1223. TJclIntfIntegerSortedMapEntryArray = array of TJclIntfIntegerSortedMapEntry;
  1224. TJclIntfIntegerSortedMap = class(TJclIntegerAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE}
  1225. IJclIntfCloneable, IJclCloneable, IJclGrowable, IJclPackable, IJclBaseContainer, IJclIntfContainer, IJclIntegerContainer,
  1226. IJclIntfIntegerMap, IJclIntfIntegerSortedMap)
  1227. protected
  1228. function CreateEmptyContainer: TJclAbstractContainerBase; override;
  1229. function FreeKey(var Key: IInterface): IInterface;
  1230. function FreeValue(var Value: Integer): Integer;
  1231. function KeysCompare(const A, B: IInterface): Integer;
  1232. function ValuesCompare(A, B: Integer): Integer;
  1233. private
  1234. FEntries: TJclIntfIntegerSortedMapEntryArray;
  1235. function BinarySearch(const Key: IInterface): Integer;
  1236. protected
  1237. procedure AssignDataTo(Dest: TJclAbstractContainerBase); override;
  1238. procedure FinalizeArrayBeforeMove(var List: TJclIntfIntegerSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  1239. {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
  1240. procedure InitializeArray(var List: TJclIntfIntegerSortedMapEntryArray; FromIndex, Count: SizeInt);
  1241. {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
  1242. procedure InitializeArrayAfterMove(var List: TJclIntfIntegerSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  1243. {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
  1244. procedure MoveArray(var List: TJclIntfIntegerSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  1245. public
  1246. constructor Create(ACapacity: Integer);
  1247. destructor Destroy; override;
  1248. { IJclPackable }
  1249. procedure SetCapacity(Value: Integer); override;
  1250. { IJclIntfIntegerMap }
  1251. procedure Clear;
  1252. function ContainsKey(const Key: IInterface): Boolean;
  1253. function ContainsValue(Value: Integer): Boolean;
  1254. function Extract(const Key: IInterface): Integer;
  1255. function GetValue(const Key: IInterface): Integer;
  1256. function IsEmpty: Boolean;
  1257. function KeyOfValue(Value: Integer): IInterface;
  1258. function KeySet: IJclIntfSet;
  1259. function MapEquals(const AMap: IJclIntfIntegerMap): Boolean;
  1260. procedure PutAll(const AMap: IJclIntfIntegerMap);
  1261. procedure PutValue(const Key: IInterface; Value: Integer);
  1262. function Remove(const Key: IInterface): Integer;
  1263. function Size: Integer;
  1264. function Values: IJclIntegerCollection;
  1265. { IJclIntfIntegerSortedMap }
  1266. function FirstKey: IInterface;
  1267. function HeadMap(const ToKey: IInterface): IJclIntfIntegerSortedMap;
  1268. function LastKey: IInterface;
  1269. function SubMap(const FromKey, ToKey: IInterface): IJclIntfIntegerSortedMap;
  1270. function TailMap(const FromKey: IInterface): IJclIntfIntegerSortedMap;
  1271. end;
  1272. TJclIntegerIntegerSortedMapEntry = record
  1273. Key: Integer;
  1274. Value: Integer;
  1275. end;
  1276. TJclIntegerIntegerSortedMapEntryArray = array of TJclIntegerIntegerSortedMapEntry;
  1277. TJclIntegerIntegerSortedMap = class(TJclIntegerAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE}
  1278. IJclIntfCloneable, IJclCloneable, IJclGrowable, IJclPackable, IJclBaseContainer, IJclIntegerContainer,
  1279. IJclIntegerIntegerMap, IJclIntegerIntegerSortedMap)
  1280. protected
  1281. function CreateEmptyContainer: TJclAbstractContainerBase; override;
  1282. function FreeKey(var Key: Integer): Integer;
  1283. function FreeValue(var Value: Integer): Integer;
  1284. function KeysCompare(A, B: Integer): Integer;
  1285. function ValuesCompare(A, B: Integer): Integer;
  1286. private
  1287. FEntries: TJclIntegerIntegerSortedMapEntryArray;
  1288. function BinarySearch(Key: Integer): Integer;
  1289. protected
  1290. procedure AssignDataTo(Dest: TJclAbstractContainerBase); override;
  1291. procedure InitializeArrayAfterMove(var List: TJclIntegerIntegerSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  1292. {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
  1293. procedure MoveArray(var List: TJclIntegerIntegerSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  1294. public
  1295. constructor Create(ACapacity: Integer);
  1296. destructor Destroy; override;
  1297. { IJclPackable }
  1298. procedure SetCapacity(Value: Integer); override;
  1299. { IJclIntegerIntegerMap }
  1300. procedure Clear;
  1301. function ContainsKey(Key: Integer): Boolean;
  1302. function ContainsValue(Value: Integer): Boolean;
  1303. function Extract(Key: Integer): Integer;
  1304. function GetValue(Key: Integer): Integer;
  1305. function IsEmpty: Boolean;
  1306. function KeyOfValue(Value: Integer): Integer;
  1307. function KeySet: IJclIntegerSet;
  1308. function MapEquals(const AMap: IJclIntegerIntegerMap): Boolean;
  1309. procedure PutAll(const AMap: IJclIntegerIntegerMap);
  1310. procedure PutValue(Key: Integer; Value: Integer);
  1311. function Remove(Key: Integer): Integer;
  1312. function Size: Integer;
  1313. function Values: IJclIntegerCollection;
  1314. { IJclIntegerIntegerSortedMap }
  1315. function FirstKey: Integer;
  1316. function HeadMap(ToKey: Integer): IJclIntegerIntegerSortedMap;
  1317. function LastKey: Integer;
  1318. function SubMap(FromKey, ToKey: Integer): IJclIntegerIntegerSortedMap;
  1319. function TailMap(FromKey: Integer): IJclIntegerIntegerSortedMap;
  1320. end;
  1321. TJclCardinalIntfSortedMapEntry = record
  1322. Key: Cardinal;
  1323. Value: IInterface;
  1324. end;
  1325. TJclCardinalIntfSortedMapEntryArray = array of TJclCardinalIntfSortedMapEntry;
  1326. TJclCardinalIntfSortedMap = class(TJclCardinalAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE}
  1327. IJclIntfCloneable, IJclCloneable, IJclGrowable, IJclPackable, IJclBaseContainer, IJclCardinalContainer, IJclIntfContainer,
  1328. IJclCardinalIntfMap, IJclCardinalIntfSortedMap)
  1329. protected
  1330. function CreateEmptyContainer: TJclAbstractContainerBase; override;
  1331. function FreeKey(var Key: Cardinal): Cardinal;
  1332. function FreeValue(var Value: IInterface): IInterface;
  1333. function KeysCompare(A, B: Cardinal): Integer;
  1334. function ValuesCompare(const A, B: IInterface): Integer;
  1335. private
  1336. FEntries: TJclCardinalIntfSortedMapEntryArray;
  1337. function BinarySearch(Key: Cardinal): Integer;
  1338. protected
  1339. procedure AssignDataTo(Dest: TJclAbstractContainerBase); override;
  1340. procedure FinalizeArrayBeforeMove(var List: TJclCardinalIntfSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  1341. {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
  1342. procedure InitializeArray(var List: TJclCardinalIntfSortedMapEntryArray; FromIndex, Count: SizeInt);
  1343. {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
  1344. procedure InitializeArrayAfterMove(var List: TJclCardinalIntfSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  1345. {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
  1346. procedure MoveArray(var List: TJclCardinalIntfSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  1347. public
  1348. constructor Create(ACapacity: Integer);
  1349. destructor Destroy; override;
  1350. { IJclPackable }
  1351. procedure SetCapacity(Value: Integer); override;
  1352. { IJclCardinalIntfMap }
  1353. procedure Clear;
  1354. function ContainsKey(Key: Cardinal): Boolean;
  1355. function ContainsValue(const Value: IInterface): Boolean;
  1356. function Extract(Key: Cardinal): IInterface;
  1357. function GetValue(Key: Cardinal): IInterface;
  1358. function IsEmpty: Boolean;
  1359. function KeyOfValue(const Value: IInterface): Cardinal;
  1360. function KeySet: IJclCardinalSet;
  1361. function MapEquals(const AMap: IJclCardinalIntfMap): Boolean;
  1362. procedure PutAll(const AMap: IJclCardinalIntfMap);
  1363. procedure PutValue(Key: Cardinal; const Value: IInterface);
  1364. function Remove(Key: Cardinal): IInterface;
  1365. function Size: Integer;
  1366. function Values: IJclIntfCollection;
  1367. { IJclCardinalIntfSortedMap }
  1368. function FirstKey: Cardinal;
  1369. function HeadMap(ToKey: Cardinal): IJclCardinalIntfSortedMap;
  1370. function LastKey: Cardinal;
  1371. function SubMap(FromKey, ToKey: Cardinal): IJclCardinalIntfSortedMap;
  1372. function TailMap(FromKey: Cardinal): IJclCardinalIntfSortedMap;
  1373. end;
  1374. TJclIntfCardinalSortedMapEntry = record
  1375. Key: IInterface;
  1376. Value: Cardinal;
  1377. end;
  1378. TJclIntfCardinalSortedMapEntryArray = array of TJclIntfCardinalSortedMapEntry;
  1379. TJclIntfCardinalSortedMap = class(TJclCardinalAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE}
  1380. IJclIntfCloneable, IJclCloneable, IJclGrowable, IJclPackable, IJclBaseContainer, IJclIntfContainer, IJclCardinalContainer,
  1381. IJclIntfCardinalMap, IJclIntfCardinalSortedMap)
  1382. protected
  1383. function CreateEmptyContainer: TJclAbstractContainerBase; override;
  1384. function FreeKey(var Key: IInterface): IInterface;
  1385. function FreeValue(var Value: Cardinal): Cardinal;
  1386. function KeysCompare(const A, B: IInterface): Integer;
  1387. function ValuesCompare(A, B: Cardinal): Integer;
  1388. private
  1389. FEntries: TJclIntfCardinalSortedMapEntryArray;
  1390. function BinarySearch(const Key: IInterface): Integer;
  1391. protected
  1392. procedure AssignDataTo(Dest: TJclAbstractContainerBase); override;
  1393. procedure FinalizeArrayBeforeMove(var List: TJclIntfCardinalSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  1394. {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
  1395. procedure InitializeArray(var List: TJclIntfCardinalSortedMapEntryArray; FromIndex, Count: SizeInt);
  1396. {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
  1397. procedure InitializeArrayAfterMove(var List: TJclIntfCardinalSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  1398. {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
  1399. procedure MoveArray(var List: TJclIntfCardinalSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  1400. public
  1401. constructor Create(ACapacity: Integer);
  1402. destructor Destroy; override;
  1403. { IJclPackable }
  1404. procedure SetCapacity(Value: Integer); override;
  1405. { IJclIntfCardinalMap }
  1406. procedure Clear;
  1407. function ContainsKey(const Key: IInterface): Boolean;
  1408. function ContainsValue(Value: Cardinal): Boolean;
  1409. function Extract(const Key: IInterface): Cardinal;
  1410. function GetValue(const Key: IInterface): Cardinal;
  1411. function IsEmpty: Boolean;
  1412. function KeyOfValue(Value: Cardinal): IInterface;
  1413. function KeySet: IJclIntfSet;
  1414. function MapEquals(const AMap: IJclIntfCardinalMap): Boolean;
  1415. procedure PutAll(const AMap: IJclIntfCardinalMap);
  1416. procedure PutValue(const Key: IInterface; Value: Cardinal);
  1417. function Remove(const Key: IInterface): Cardinal;
  1418. function Size: Integer;
  1419. function Values: IJclCardinalCollection;
  1420. { IJclIntfCardinalSortedMap }
  1421. function FirstKey: IInterface;
  1422. function HeadMap(const ToKey: IInterface): IJclIntfCardinalSortedMap;
  1423. function LastKey: IInterface;
  1424. function SubMap(const FromKey, ToKey: IInterface): IJclIntfCardinalSortedMap;
  1425. function TailMap(const FromKey: IInterface): IJclIntfCardinalSortedMap;
  1426. end;
  1427. TJclCardinalCardinalSortedMapEntry = record
  1428. Key: Cardinal;
  1429. Value: Cardinal;
  1430. end;
  1431. TJclCardinalCardinalSortedMapEntryArray = array of TJclCardinalCardinalSortedMapEntry;
  1432. TJclCardinalCardinalSortedMap = class(TJclCardinalAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE}
  1433. IJclIntfCloneable, IJclCloneable, IJclGrowable, IJclPackable, IJclBaseContainer, IJclCardinalContainer,
  1434. IJclCardinalCardinalMap, IJclCardinalCardinalSortedMap)
  1435. protected
  1436. function CreateEmptyContainer: TJclAbstractContainerBase; override;
  1437. function FreeKey(var Key: Cardinal): Cardinal;
  1438. function FreeValue(var Value: Cardinal): Cardinal;
  1439. function KeysCompare(A, B: Cardinal): Integer;
  1440. function ValuesCompare(A, B: Cardinal): Integer;
  1441. private
  1442. FEntries: TJclCardinalCardinalSortedMapEntryArray;
  1443. function BinarySearch(Key: Cardinal): Integer;
  1444. protected
  1445. procedure AssignDataTo(Dest: TJclAbstractContainerBase); override;
  1446. procedure InitializeArrayAfterMove(var List: TJclCardinalCardinalSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  1447. {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
  1448. procedure MoveArray(var List: TJclCardinalCardinalSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  1449. public
  1450. constructor Create(ACapacity: Integer);
  1451. destructor Destroy; override;
  1452. { IJclPackable }
  1453. procedure SetCapacity(Value: Integer); override;
  1454. { IJclCardinalCardinalMap }
  1455. procedure Clear;
  1456. function ContainsKey(Key: Cardinal): Boolean;
  1457. function ContainsValue(Value: Cardinal): Boolean;
  1458. function Extract(Key: Cardinal): Cardinal;
  1459. function GetValue(Key: Cardinal): Cardinal;
  1460. function IsEmpty: Boolean;
  1461. function KeyOfValue(Value: Cardinal): Cardinal;
  1462. function KeySet: IJclCardinalSet;
  1463. function MapEquals(const AMap: IJclCardinalCardinalMap): Boolean;
  1464. procedure PutAll(const AMap: IJclCardinalCardinalMap);
  1465. procedure PutValue(Key: Cardinal; Value: Cardinal);
  1466. function Remove(Key: Cardinal): Cardinal;
  1467. function Size: Integer;
  1468. function Values: IJclCardinalCollection;
  1469. { IJclCardinalCardinalSortedMap }
  1470. function FirstKey: Cardinal;
  1471. function HeadMap(ToKey: Cardinal): IJclCardinalCardinalSortedMap;
  1472. function LastKey: Cardinal;
  1473. function SubMap(FromKey, ToKey: Cardinal): IJclCardinalCardinalSortedMap;
  1474. function TailMap(FromKey: Cardinal): IJclCardinalCardinalSortedMap;
  1475. end;
  1476. TJclInt64IntfSortedMapEntry = record
  1477. Key: Int64;
  1478. Value: IInterface;
  1479. end;
  1480. TJclInt64IntfSortedMapEntryArray = array of TJclInt64IntfSortedMapEntry;
  1481. TJclInt64IntfSortedMap = class(TJclInt64AbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE}
  1482. IJclIntfCloneable, IJclCloneable, IJclGrowable, IJclPackable, IJclBaseContainer, IJclInt64Container, IJclIntfContainer,
  1483. IJclInt64IntfMap, IJclInt64IntfSortedMap)
  1484. protected
  1485. function CreateEmptyContainer: TJclAbstractContainerBase; override;
  1486. function FreeKey(var Key: Int64): Int64;
  1487. function FreeValue(var Value: IInterface): IInterface;
  1488. function KeysCompare(const A, B: Int64): Integer;
  1489. function ValuesCompare(const A, B: IInterface): Integer;
  1490. private
  1491. FEntries: TJclInt64IntfSortedMapEntryArray;
  1492. function BinarySearch(const Key: Int64): Integer;
  1493. protected
  1494. procedure AssignDataTo(Dest: TJclAbstractContainerBase); override;
  1495. procedure FinalizeArrayBeforeMove(var List: TJclInt64IntfSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  1496. {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
  1497. procedure InitializeArray(var List: TJclInt64IntfSortedMapEntryArray; FromIndex, Count: SizeInt);
  1498. {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
  1499. procedure InitializeArrayAfterMove(var List: TJclInt64IntfSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  1500. {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
  1501. procedure MoveArray(var List: TJclInt64IntfSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  1502. public
  1503. constructor Create(ACapacity: Integer);
  1504. destructor Destroy; override;
  1505. { IJclPackable }
  1506. procedure SetCapacity(Value: Integer); override;
  1507. { IJclInt64IntfMap }
  1508. procedure Clear;
  1509. function ContainsKey(const Key: Int64): Boolean;
  1510. function ContainsValue(const Value: IInterface): Boolean;
  1511. function Extract(const Key: Int64): IInterface;
  1512. function GetValue(const Key: Int64): IInterface;
  1513. function IsEmpty: Boolean;
  1514. function KeyOfValue(const Value: IInterface): Int64;
  1515. function KeySet: IJclInt64Set;
  1516. function MapEquals(const AMap: IJclInt64IntfMap): Boolean;
  1517. procedure PutAll(const AMap: IJclInt64IntfMap);
  1518. procedure PutValue(const Key: Int64; const Value: IInterface);
  1519. function Remove(const Key: Int64): IInterface;
  1520. function Size: Integer;
  1521. function Values: IJclIntfCollection;
  1522. { IJclInt64IntfSortedMap }
  1523. function FirstKey: Int64;
  1524. function HeadMap(const ToKey: Int64): IJclInt64IntfSortedMap;
  1525. function LastKey: Int64;
  1526. function SubMap(const FromKey, ToKey: Int64): IJclInt64IntfSortedMap;
  1527. function TailMap(const FromKey: Int64): IJclInt64IntfSortedMap;
  1528. end;
  1529. TJclIntfInt64SortedMapEntry = record
  1530. Key: IInterface;
  1531. Value: Int64;
  1532. end;
  1533. TJclIntfInt64SortedMapEntryArray = array of TJclIntfInt64SortedMapEntry;
  1534. TJclIntfInt64SortedMap = class(TJclInt64AbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE}
  1535. IJclIntfCloneable, IJclCloneable, IJclGrowable, IJclPackable, IJclBaseContainer, IJclIntfContainer, IJclInt64Container,
  1536. IJclIntfInt64Map, IJclIntfInt64SortedMap)
  1537. protected
  1538. function CreateEmptyContainer: TJclAbstractContainerBase; override;
  1539. function FreeKey(var Key: IInterface): IInterface;
  1540. function FreeValue(var Value: Int64): Int64;
  1541. function KeysCompare(const A, B: IInterface): Integer;
  1542. function ValuesCompare(const A, B: Int64): Integer;
  1543. private
  1544. FEntries: TJclIntfInt64SortedMapEntryArray;
  1545. function BinarySearch(const Key: IInterface): Integer;
  1546. protected
  1547. procedure AssignDataTo(Dest: TJclAbstractContainerBase); override;
  1548. procedure FinalizeArrayBeforeMove(var List: TJclIntfInt64SortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  1549. {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
  1550. procedure InitializeArray(var List: TJclIntfInt64SortedMapEntryArray; FromIndex, Count: SizeInt);
  1551. {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
  1552. procedure InitializeArrayAfterMove(var List: TJclIntfInt64SortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  1553. {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
  1554. procedure MoveArray(var List: TJclIntfInt64SortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  1555. public
  1556. constructor Create(ACapacity: Integer);
  1557. destructor Destroy; override;
  1558. { IJclPackable }
  1559. procedure SetCapacity(Value: Integer); override;
  1560. { IJclIntfInt64Map }
  1561. procedure Clear;
  1562. function ContainsKey(const Key: IInterface): Boolean;
  1563. function ContainsValue(const Value: Int64): Boolean;
  1564. function Extract(const Key: IInterface): Int64;
  1565. function GetValue(const Key: IInterface): Int64;
  1566. function IsEmpty: Boolean;
  1567. function KeyOfValue(const Value: Int64): IInterface;
  1568. function KeySet: IJclIntfSet;
  1569. function MapEquals(const AMap: IJclIntfInt64Map): Boolean;
  1570. procedure PutAll(const AMap: IJclIntfInt64Map);
  1571. procedure PutValue(const Key: IInterface; const Value: Int64);
  1572. function Remove(const Key: IInterface): Int64;
  1573. function Size: Integer;
  1574. function Values: IJclInt64Collection;
  1575. { IJclIntfInt64SortedMap }
  1576. function FirstKey: IInterface;
  1577. function HeadMap(const ToKey: IInterface): IJclIntfInt64SortedMap;
  1578. function LastKey: IInterface;
  1579. function SubMap(const FromKey, ToKey: IInterface): IJclIntfInt64SortedMap;
  1580. function TailMap(const FromKey: IInterface): IJclIntfInt64SortedMap;
  1581. end;
  1582. TJclInt64Int64SortedMapEntry = record
  1583. Key: Int64;
  1584. Value: Int64;
  1585. end;
  1586. TJclInt64Int64SortedMapEntryArray = array of TJclInt64Int64SortedMapEntry;
  1587. TJclInt64Int64SortedMap = class(TJclInt64AbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE}
  1588. IJclIntfCloneable, IJclCloneable, IJclGrowable, IJclPackable, IJclBaseContainer, IJclInt64Container,
  1589. IJclInt64Int64Map, IJclInt64Int64SortedMap)
  1590. protected
  1591. function CreateEmptyContainer: TJclAbstractContainerBase; override;
  1592. function FreeKey(var Key: Int64): Int64;
  1593. function FreeValue(var Value: Int64): Int64;
  1594. function KeysCompare(const A, B: Int64): Integer;
  1595. function ValuesCompare(const A, B: Int64): Integer;
  1596. private
  1597. FEntries: TJclInt64Int64SortedMapEntryArray;
  1598. function BinarySearch(const Key: Int64): Integer;
  1599. protected
  1600. procedure AssignDataTo(Dest: TJclAbstractContainerBase); override;
  1601. procedure InitializeArrayAfterMove(var List: TJclInt64Int64SortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  1602. {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
  1603. procedure MoveArray(var List: TJclInt64Int64SortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  1604. public
  1605. constructor Create(ACapacity: Integer);
  1606. destructor Destroy; override;
  1607. { IJclPackable }
  1608. procedure SetCapacity(Value: Integer); override;
  1609. { IJclInt64Int64Map }
  1610. procedure Clear;
  1611. function ContainsKey(const Key: Int64): Boolean;
  1612. function ContainsValue(const Value: Int64): Boolean;
  1613. function Extract(const Key: Int64): Int64;
  1614. function GetValue(const Key: Int64): Int64;
  1615. function IsEmpty: Boolean;
  1616. function KeyOfValue(const Value: Int64): Int64;
  1617. function KeySet: IJclInt64Set;
  1618. function MapEquals(const AMap: IJclInt64Int64Map): Boolean;
  1619. procedure PutAll(const AMap: IJclInt64Int64Map);
  1620. procedure PutValue(const Key: Int64; const Value: Int64);
  1621. function Remove(const Key: Int64): Int64;
  1622. function Size: Integer;
  1623. function Values: IJclInt64Collection;
  1624. { IJclInt64Int64SortedMap }
  1625. function FirstKey: Int64;
  1626. function HeadMap(const ToKey: Int64): IJclInt64Int64SortedMap;
  1627. function LastKey: Int64;
  1628. function SubMap(const FromKey, ToKey: Int64): IJclInt64Int64SortedMap;
  1629. function TailMap(const FromKey: Int64): IJclInt64Int64SortedMap;
  1630. end;
  1631. TJclPtrIntfSortedMapEntry = record
  1632. Key: Pointer;
  1633. Value: IInterface;
  1634. end;
  1635. TJclPtrIntfSortedMapEntryArray = array of TJclPtrIntfSortedMapEntry;
  1636. TJclPtrIntfSortedMap = class(TJclPtrAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE}
  1637. IJclIntfCloneable, IJclCloneable, IJclGrowable, IJclPackable, IJclBaseContainer, IJclPtrContainer, IJclIntfContainer,
  1638. IJclPtrIntfMap, IJclPtrIntfSortedMap)
  1639. protected
  1640. function CreateEmptyContainer: TJclAbstractContainerBase; override;
  1641. function FreeKey(var Key: Pointer): Pointer;
  1642. function FreeValue(var Value: IInterface): IInterface;
  1643. function KeysCompare(A, B: Pointer): Integer;
  1644. function ValuesCompare(const A, B: IInterface): Integer;
  1645. private
  1646. FEntries: TJclPtrIntfSortedMapEntryArray;
  1647. function BinarySearch(Key: Pointer): Integer;
  1648. protected
  1649. procedure AssignDataTo(Dest: TJclAbstractContainerBase); override;
  1650. procedure FinalizeArrayBeforeMove(var List: TJclPtrIntfSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  1651. {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
  1652. procedure InitializeArray(var List: TJclPtrIntfSortedMapEntryArray; FromIndex, Count: SizeInt);
  1653. {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
  1654. procedure InitializeArrayAfterMove(var List: TJclPtrIntfSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  1655. {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
  1656. procedure MoveArray(var List: TJclPtrIntfSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  1657. public
  1658. constructor Create(ACapacity: Integer);
  1659. destructor Destroy; override;
  1660. { IJclPackable }
  1661. procedure SetCapacity(Value: Integer); override;
  1662. { IJclPtrIntfMap }
  1663. procedure Clear;
  1664. function ContainsKey(Key: Pointer): Boolean;
  1665. function ContainsValue(const Value: IInterface): Boolean;
  1666. function Extract(Key: Pointer): IInterface;
  1667. function GetValue(Key: Pointer): IInterface;
  1668. function IsEmpty: Boolean;
  1669. function KeyOfValue(const Value: IInterface): Pointer;
  1670. function KeySet: IJclPtrSet;
  1671. function MapEquals(const AMap: IJclPtrIntfMap): Boolean;
  1672. procedure PutAll(const AMap: IJclPtrIntfMap);
  1673. procedure PutValue(Key: Pointer; const Value: IInterface);
  1674. function Remove(Key: Pointer): IInterface;
  1675. function Size: Integer;
  1676. function Values: IJclIntfCollection;
  1677. { IJclPtrIntfSortedMap }
  1678. function FirstKey: Pointer;
  1679. function HeadMap(ToKey: Pointer): IJclPtrIntfSortedMap;
  1680. function LastKey: Pointer;
  1681. function SubMap(FromKey, ToKey: Pointer): IJclPtrIntfSortedMap;
  1682. function TailMap(FromKey: Pointer): IJclPtrIntfSortedMap;
  1683. end;
  1684. TJclIntfPtrSortedMapEntry = record
  1685. Key: IInterface;
  1686. Value: Pointer;
  1687. end;
  1688. TJclIntfPtrSortedMapEntryArray = array of TJclIntfPtrSortedMapEntry;
  1689. TJclIntfPtrSortedMap = class(TJclPtrAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE}
  1690. IJclIntfCloneable, IJclCloneable, IJclGrowable, IJclPackable, IJclBaseContainer, IJclIntfContainer, IJclPtrContainer,
  1691. IJclIntfPtrMap, IJclIntfPtrSortedMap)
  1692. protected
  1693. function CreateEmptyContainer: TJclAbstractContainerBase; override;
  1694. function FreeKey(var Key: IInterface): IInterface;
  1695. function FreeValue(var Value: Pointer): Pointer;
  1696. function KeysCompare(const A, B: IInterface): Integer;
  1697. function ValuesCompare(A, B: Pointer): Integer;
  1698. private
  1699. FEntries: TJclIntfPtrSortedMapEntryArray;
  1700. function BinarySearch(const Key: IInterface): Integer;
  1701. protected
  1702. procedure AssignDataTo(Dest: TJclAbstractContainerBase); override;
  1703. procedure FinalizeArrayBeforeMove(var List: TJclIntfPtrSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  1704. {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
  1705. procedure InitializeArray(var List: TJclIntfPtrSortedMapEntryArray; FromIndex, Count: SizeInt);
  1706. {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
  1707. procedure InitializeArrayAfterMove(var List: TJclIntfPtrSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  1708. {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
  1709. procedure MoveArray(var List: TJclIntfPtrSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  1710. public
  1711. constructor Create(ACapacity: Integer);
  1712. destructor Destroy; override;
  1713. { IJclPackable }
  1714. procedure SetCapacity(Value: Integer); override;
  1715. { IJclIntfPtrMap }
  1716. procedure Clear;
  1717. function ContainsKey(const Key: IInterface): Boolean;
  1718. function ContainsValue(Value: Pointer): Boolean;
  1719. function Extract(const Key: IInterface): Pointer;
  1720. function GetValue(const Key: IInterface): Pointer;
  1721. function IsEmpty: Boolean;
  1722. function KeyOfValue(Value: Pointer): IInterface;
  1723. function KeySet: IJclIntfSet;
  1724. function MapEquals(const AMap: IJclIntfPtrMap): Boolean;
  1725. procedure PutAll(const AMap: IJclIntfPtrMap);
  1726. procedure PutValue(const Key: IInterface; Value: Pointer);
  1727. function Remove(const Key: IInterface): Pointer;
  1728. function Size: Integer;
  1729. function Values: IJclPtrCollection;
  1730. { IJclIntfPtrSortedMap }
  1731. function FirstKey: IInterface;
  1732. function HeadMap(const ToKey: IInterface): IJclIntfPtrSortedMap;
  1733. function LastKey: IInterface;
  1734. function SubMap(const FromKey, ToKey: IInterface): IJclIntfPtrSortedMap;
  1735. function TailMap(const FromKey: IInterface): IJclIntfPtrSortedMap;
  1736. end;
  1737. TJclPtrPtrSortedMapEntry = record
  1738. Key: Pointer;
  1739. Value: Pointer;
  1740. end;
  1741. TJclPtrPtrSortedMapEntryArray = array of TJclPtrPtrSortedMapEntry;
  1742. TJclPtrPtrSortedMap = class(TJclPtrAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE}
  1743. IJclIntfCloneable, IJclCloneable, IJclGrowable, IJclPackable, IJclBaseContainer, IJclPtrContainer,
  1744. IJclPtrPtrMap, IJclPtrPtrSortedMap)
  1745. protected
  1746. function CreateEmptyContainer: TJclAbstractContainerBase; override;
  1747. function FreeKey(var Key: Pointer): Pointer;
  1748. function FreeValue(var Value: Pointer): Pointer;
  1749. function KeysCompare(A, B: Pointer): Integer;
  1750. function ValuesCompare(A, B: Pointer): Integer;
  1751. private
  1752. FEntries: TJclPtrPtrSortedMapEntryArray;
  1753. function BinarySearch(Key: Pointer): Integer;
  1754. protected
  1755. procedure AssignDataTo(Dest: TJclAbstractContainerBase); override;
  1756. procedure InitializeArrayAfterMove(var List: TJclPtrPtrSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  1757. {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
  1758. procedure MoveArray(var List: TJclPtrPtrSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  1759. public
  1760. constructor Create(ACapacity: Integer);
  1761. destructor Destroy; override;
  1762. { IJclPackable }
  1763. procedure SetCapacity(Value: Integer); override;
  1764. { IJclPtrPtrMap }
  1765. procedure Clear;
  1766. function ContainsKey(Key: Pointer): Boolean;
  1767. function ContainsValue(Value: Pointer): Boolean;
  1768. function Extract(Key: Pointer): Pointer;
  1769. function GetValue(Key: Pointer): Pointer;
  1770. function IsEmpty: Boolean;
  1771. function KeyOfValue(Value: Pointer): Pointer;
  1772. function KeySet: IJclPtrSet;
  1773. function MapEquals(const AMap: IJclPtrPtrMap): Boolean;
  1774. procedure PutAll(const AMap: IJclPtrPtrMap);
  1775. procedure PutValue(Key: Pointer; Value: Pointer);
  1776. function Remove(Key: Pointer): Pointer;
  1777. function Size: Integer;
  1778. function Values: IJclPtrCollection;
  1779. { IJclPtrPtrSortedMap }
  1780. function FirstKey: Pointer;
  1781. function HeadMap(ToKey: Pointer): IJclPtrPtrSortedMap;
  1782. function LastKey: Pointer;
  1783. function SubMap(FromKey, ToKey: Pointer): IJclPtrPtrSortedMap;
  1784. function TailMap(FromKey: Pointer): IJclPtrPtrSortedMap;
  1785. end;
  1786. TJclIntfSortedMapEntry = record
  1787. Key: IInterface;
  1788. Value: TObject;
  1789. end;
  1790. TJclIntfSortedMapEntryArray = array of TJclIntfSortedMapEntry;
  1791. TJclIntfSortedMap = class(TJclIntfAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE}
  1792. IJclIntfCloneable, IJclCloneable, IJclGrowable, IJclPackable, IJclBaseContainer, IJclIntfContainer, IJclContainer, IJclValueOwner,
  1793. IJclIntfMap, IJclIntfSortedMap)
  1794. private
  1795. FOwnsValues: Boolean;
  1796. protected
  1797. function CreateEmptyContainer: TJclAbstractContainerBase; override;
  1798. function FreeKey(var Key: IInterface): IInterface;
  1799. function KeysCompare(const A, B: IInterface): Integer;
  1800. function ValuesCompare(A, B: TObject): Integer;
  1801. public
  1802. { IJclValueOwner }
  1803. function FreeValue(var Value: TObject): TObject;
  1804. function GetOwnsValues: Boolean;
  1805. property OwnsValues: Boolean read FOwnsValues;
  1806. private
  1807. FEntries: TJclIntfSortedMapEntryArray;
  1808. function BinarySearch(const Key: IInterface): Integer;
  1809. protected
  1810. procedure AssignDataTo(Dest: TJclAbstractContainerBase); override;
  1811. procedure FinalizeArrayBeforeMove(var List: TJclIntfSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  1812. {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
  1813. procedure InitializeArray(var List: TJclIntfSortedMapEntryArray; FromIndex, Count: SizeInt);
  1814. {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
  1815. procedure InitializeArrayAfterMove(var List: TJclIntfSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  1816. {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
  1817. procedure MoveArray(var List: TJclIntfSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  1818. public
  1819. constructor Create(ACapacity: Integer; AOwnsValues: Boolean);
  1820. destructor Destroy; override;
  1821. { IJclPackable }
  1822. procedure SetCapacity(Value: Integer); override;
  1823. { IJclIntfMap }
  1824. procedure Clear;
  1825. function ContainsKey(const Key: IInterface): Boolean;
  1826. function ContainsValue(Value: TObject): Boolean;
  1827. function Extract(const Key: IInterface): TObject;
  1828. function GetValue(const Key: IInterface): TObject;
  1829. function IsEmpty: Boolean;
  1830. function KeyOfValue(Value: TObject): IInterface;
  1831. function KeySet: IJclIntfSet;
  1832. function MapEquals(const AMap: IJclIntfMap): Boolean;
  1833. procedure PutAll(const AMap: IJclIntfMap);
  1834. procedure PutValue(const Key: IInterface; Value: TObject);
  1835. function Remove(const Key: IInterface): TObject;
  1836. function Size: Integer;
  1837. function Values: IJclCollection;
  1838. { IJclIntfSortedMap }
  1839. function FirstKey: IInterface;
  1840. function HeadMap(const ToKey: IInterface): IJclIntfSortedMap;
  1841. function LastKey: IInterface;
  1842. function SubMap(const FromKey, ToKey: IInterface): IJclIntfSortedMap;
  1843. function TailMap(const FromKey: IInterface): IJclIntfSortedMap;
  1844. end;
  1845. TJclAnsiStrSortedMapEntry = record
  1846. Key: AnsiString;
  1847. Value: TObject;
  1848. end;
  1849. TJclAnsiStrSortedMapEntryArray = array of TJclAnsiStrSortedMapEntry;
  1850. TJclAnsiStrSortedMap = class(TJclAnsiStrAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE}
  1851. IJclIntfCloneable, IJclCloneable, IJclGrowable, IJclPackable, IJclBaseContainer, IJclStrBaseContainer, IJclAnsiStrContainer, IJclContainer, IJclValueOwner,
  1852. IJclAnsiStrMap, IJclAnsiStrSortedMap)
  1853. private
  1854. FOwnsValues: Boolean;
  1855. protected
  1856. function CreateEmptyContainer: TJclAbstractContainerBase; override;
  1857. function FreeKey(var Key: AnsiString): AnsiString;
  1858. function KeysCompare(const A, B: AnsiString): Integer;
  1859. function ValuesCompare(A, B: TObject): Integer;
  1860. public
  1861. { IJclValueOwner }
  1862. function FreeValue(var Value: TObject): TObject;
  1863. function GetOwnsValues: Boolean;
  1864. property OwnsValues: Boolean read FOwnsValues;
  1865. private
  1866. FEntries: TJclAnsiStrSortedMapEntryArray;
  1867. function BinarySearch(const Key: AnsiString): Integer;
  1868. protected
  1869. procedure AssignDataTo(Dest: TJclAbstractContainerBase); override;
  1870. procedure FinalizeArrayBeforeMove(var List: TJclAnsiStrSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  1871. {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
  1872. procedure InitializeArray(var List: TJclAnsiStrSortedMapEntryArray; FromIndex, Count: SizeInt);
  1873. {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
  1874. procedure InitializeArrayAfterMove(var List: TJclAnsiStrSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  1875. {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
  1876. procedure MoveArray(var List: TJclAnsiStrSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  1877. public
  1878. constructor Create(ACapacity: Integer; AOwnsValues: Boolean);
  1879. destructor Destroy; override;
  1880. { IJclPackable }
  1881. procedure SetCapacity(Value: Integer); override;
  1882. { IJclAnsiStrMap }
  1883. procedure Clear;
  1884. function ContainsKey(const Key: AnsiString): Boolean;
  1885. function ContainsValue(Value: TObject): Boolean;
  1886. function Extract(const Key: AnsiString): TObject;
  1887. function GetValue(const Key: AnsiString): TObject;
  1888. function IsEmpty: Boolean;
  1889. function KeyOfValue(Value: TObject): AnsiString;
  1890. function KeySet: IJclAnsiStrSet;
  1891. function MapEquals(const AMap: IJclAnsiStrMap): Boolean;
  1892. procedure PutAll(const AMap: IJclAnsiStrMap);
  1893. procedure PutValue(const Key: AnsiString; Value: TObject);
  1894. function Remove(const Key: AnsiString): TObject;
  1895. function Size: Integer;
  1896. function Values: IJclCollection;
  1897. { IJclAnsiStrSortedMap }
  1898. function FirstKey: AnsiString;
  1899. function HeadMap(const ToKey: AnsiString): IJclAnsiStrSortedMap;
  1900. function LastKey: AnsiString;
  1901. function SubMap(const FromKey, ToKey: AnsiString): IJclAnsiStrSortedMap;
  1902. function TailMap(const FromKey: AnsiString): IJclAnsiStrSortedMap;
  1903. end;
  1904. TJclWideStrSortedMapEntry = record
  1905. Key: WideString;
  1906. Value: TObject;
  1907. end;
  1908. TJclWideStrSortedMapEntryArray = array of TJclWideStrSortedMapEntry;
  1909. TJclWideStrSortedMap = class(TJclWideStrAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE}
  1910. IJclIntfCloneable, IJclCloneable, IJclGrowable, IJclPackable, IJclBaseContainer, IJclStrBaseContainer, IJclWideStrContainer, IJclContainer, IJclValueOwner,
  1911. IJclWideStrMap, IJclWideStrSortedMap)
  1912. private
  1913. FOwnsValues: Boolean;
  1914. protected
  1915. function CreateEmptyContainer: TJclAbstractContainerBase; override;
  1916. function FreeKey(var Key: WideString): WideString;
  1917. function KeysCompare(const A, B: WideString): Integer;
  1918. function ValuesCompare(A, B: TObject): Integer;
  1919. public
  1920. { IJclValueOwner }
  1921. function FreeValue(var Value: TObject): TObject;
  1922. function GetOwnsValues: Boolean;
  1923. property OwnsValues: Boolean read FOwnsValues;
  1924. private
  1925. FEntries: TJclWideStrSortedMapEntryArray;
  1926. function BinarySearch(const Key: WideString): Integer;
  1927. protected
  1928. procedure AssignDataTo(Dest: TJclAbstractContainerBase); override;
  1929. procedure FinalizeArrayBeforeMove(var List: TJclWideStrSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  1930. {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
  1931. procedure InitializeArray(var List: TJclWideStrSortedMapEntryArray; FromIndex, Count: SizeInt);
  1932. {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
  1933. procedure InitializeArrayAfterMove(var List: TJclWideStrSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  1934. {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
  1935. procedure MoveArray(var List: TJclWideStrSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  1936. public
  1937. constructor Create(ACapacity: Integer; AOwnsValues: Boolean);
  1938. destructor Destroy; override;
  1939. { IJclPackable }
  1940. procedure SetCapacity(Value: Integer); override;
  1941. { IJclWideStrMap }
  1942. procedure Clear;
  1943. function ContainsKey(const Key: WideString): Boolean;
  1944. function ContainsValue(Value: TObject): Boolean;
  1945. function Extract(const Key: WideString): TObject;
  1946. function GetValue(const Key: WideString): TObject;
  1947. function IsEmpty: Boolean;
  1948. function KeyOfValue(Value: TObject): WideString;
  1949. function KeySet: IJclWideStrSet;
  1950. function MapEquals(const AMap: IJclWideStrMap): Boolean;
  1951. procedure PutAll(const AMap: IJclWideStrMap);
  1952. procedure PutValue(const Key: WideString; Value: TObject);
  1953. function Remove(const Key: WideString): TObject;
  1954. function Size: Integer;
  1955. function Values: IJclCollection;
  1956. { IJclWideStrSortedMap }
  1957. function FirstKey: WideString;
  1958. function HeadMap(const ToKey: WideString): IJclWideStrSortedMap;
  1959. function LastKey: WideString;
  1960. function SubMap(const FromKey, ToKey: WideString): IJclWideStrSortedMap;
  1961. function TailMap(const FromKey: WideString): IJclWideStrSortedMap;
  1962. end;
  1963. {$IFDEF SUPPORTS_UNICODE_STRING}
  1964. TJclUnicodeStrSortedMapEntry = record
  1965. Key: UnicodeString;
  1966. Value: TObject;
  1967. end;
  1968. TJclUnicodeStrSortedMapEntryArray = array of TJclUnicodeStrSortedMapEntry;
  1969. {$ENDIF SUPPORTS_UNICODE_STRING}
  1970. {$IFDEF SUPPORTS_UNICODE_STRING}
  1971. TJclUnicodeStrSortedMap = class(TJclUnicodeStrAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE}
  1972. IJclIntfCloneable, IJclCloneable, IJclGrowable, IJclPackable, IJclBaseContainer, IJclStrBaseContainer, IJclUnicodeStrContainer, IJclContainer, IJclValueOwner,
  1973. IJclUnicodeStrMap, IJclUnicodeStrSortedMap)
  1974. private
  1975. FOwnsValues: Boolean;
  1976. protected
  1977. function CreateEmptyContainer: TJclAbstractContainerBase; override;
  1978. function FreeKey(var Key: UnicodeString): UnicodeString;
  1979. function KeysCompare(const A, B: UnicodeString): Integer;
  1980. function ValuesCompare(A, B: TObject): Integer;
  1981. public
  1982. { IJclValueOwner }
  1983. function FreeValue(var Value: TObject): TObject;
  1984. function GetOwnsValues: Boolean;
  1985. property OwnsValues: Boolean read FOwnsValues;
  1986. private
  1987. FEntries: TJclUnicodeStrSortedMapEntryArray;
  1988. function BinarySearch(const Key: UnicodeString): Integer;
  1989. protected
  1990. procedure AssignDataTo(Dest: TJclAbstractContainerBase); override;
  1991. procedure FinalizeArrayBeforeMove(var List: TJclUnicodeStrSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  1992. {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
  1993. procedure InitializeArray(var List: TJclUnicodeStrSortedMapEntryArray; FromIndex, Count: SizeInt);
  1994. {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
  1995. procedure InitializeArrayAfterMove(var List: TJclUnicodeStrSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  1996. {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
  1997. procedure MoveArray(var List: TJclUnicodeStrSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  1998. public
  1999. constructor Create(ACapacity: Integer; AOwnsValues: Boolean);
  2000. destructor Destroy; override;
  2001. { IJclPackable }
  2002. procedure SetCapacity(Value: Integer); override;
  2003. { IJclUnicodeStrMap }
  2004. procedure Clear;
  2005. function ContainsKey(const Key: UnicodeString): Boolean;
  2006. function ContainsValue(Value: TObject): Boolean;
  2007. function Extract(const Key: UnicodeString): TObject;
  2008. function GetValue(const Key: UnicodeString): TObject;
  2009. function IsEmpty: Boolean;
  2010. function KeyOfValue(Value: TObject): UnicodeString;
  2011. function KeySet: IJclUnicodeStrSet;
  2012. function MapEquals(const AMap: IJclUnicodeStrMap): Boolean;
  2013. procedure PutAll(const AMap: IJclUnicodeStrMap);
  2014. procedure PutValue(const Key: UnicodeString; Value: TObject);
  2015. function Remove(const Key: UnicodeString): TObject;
  2016. function Size: Integer;
  2017. function Values: IJclCollection;
  2018. { IJclUnicodeStrSortedMap }
  2019. function FirstKey: UnicodeString;
  2020. function HeadMap(const ToKey: UnicodeString): IJclUnicodeStrSortedMap;
  2021. function LastKey: UnicodeString;
  2022. function SubMap(const FromKey, ToKey: UnicodeString): IJclUnicodeStrSortedMap;
  2023. function TailMap(const FromKey: UnicodeString): IJclUnicodeStrSortedMap;
  2024. end;
  2025. {$ENDIF SUPPORTS_UNICODE_STRING}
  2026. {$IFDEF CONTAINER_ANSISTR}
  2027. TJclStrSortedMapEntry = TJclAnsiStrSortedMapEntry;
  2028. {$ENDIF CONTAINER_ANSISTR}
  2029. {$IFDEF CONTAINER_WIDESTR}
  2030. TJclStrSortedMapEntry = TJclWideStrSortedMapEntry;
  2031. {$ENDIF CONTAINER_WIDESTR}
  2032. {$IFDEF CONTAINER_UNICODESTR}
  2033. TJclStrSortedMapEntry = TJclUnicodeStrSortedMapEntry;
  2034. {$ENDIF CONTAINER_UNICODESTR}
  2035. {$IFDEF CONTAINER_ANSISTR}
  2036. TJclStrSortedMap = TJclAnsiStrSortedMap;
  2037. {$ENDIF CONTAINER_ANSISTR}
  2038. {$IFDEF CONTAINER_WIDESTR}
  2039. TJclStrSortedMap = TJclWideStrSortedMap;
  2040. {$ENDIF CONTAINER_WIDESTR}
  2041. {$IFDEF CONTAINER_UNICODESTR}
  2042. TJclStrSortedMap = TJclUnicodeStrSortedMap;
  2043. {$ENDIF CONTAINER_UNICODESTR}
  2044. TJclSingleSortedMapEntry = record
  2045. Key: Single;
  2046. Value: TObject;
  2047. end;
  2048. TJclSingleSortedMapEntryArray = array of TJclSingleSortedMapEntry;
  2049. TJclSingleSortedMap = class(TJclSingleAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE}
  2050. IJclIntfCloneable, IJclCloneable, IJclGrowable, IJclPackable, IJclBaseContainer, IJclSingleContainer, IJclContainer, IJclValueOwner,
  2051. IJclSingleMap, IJclSingleSortedMap)
  2052. private
  2053. FOwnsValues: Boolean;
  2054. protected
  2055. function CreateEmptyContainer: TJclAbstractContainerBase; override;
  2056. function FreeKey(var Key: Single): Single;
  2057. function KeysCompare(const A, B: Single): Integer;
  2058. function ValuesCompare(A, B: TObject): Integer;
  2059. public
  2060. { IJclValueOwner }
  2061. function FreeValue(var Value: TObject): TObject;
  2062. function GetOwnsValues: Boolean;
  2063. property OwnsValues: Boolean read FOwnsValues;
  2064. private
  2065. FEntries: TJclSingleSortedMapEntryArray;
  2066. function BinarySearch(const Key: Single): Integer;
  2067. protected
  2068. procedure AssignDataTo(Dest: TJclAbstractContainerBase); override;
  2069. procedure InitializeArrayAfterMove(var List: TJclSingleSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  2070. {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
  2071. procedure MoveArray(var List: TJclSingleSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  2072. public
  2073. constructor Create(ACapacity: Integer; AOwnsValues: Boolean);
  2074. destructor Destroy; override;
  2075. { IJclPackable }
  2076. procedure SetCapacity(Value: Integer); override;
  2077. { IJclSingleMap }
  2078. procedure Clear;
  2079. function ContainsKey(const Key: Single): Boolean;
  2080. function ContainsValue(Value: TObject): Boolean;
  2081. function Extract(const Key: Single): TObject;
  2082. function GetValue(const Key: Single): TObject;
  2083. function IsEmpty: Boolean;
  2084. function KeyOfValue(Value: TObject): Single;
  2085. function KeySet: IJclSingleSet;
  2086. function MapEquals(const AMap: IJclSingleMap): Boolean;
  2087. procedure PutAll(const AMap: IJclSingleMap);
  2088. procedure PutValue(const Key: Single; Value: TObject);
  2089. function Remove(const Key: Single): TObject;
  2090. function Size: Integer;
  2091. function Values: IJclCollection;
  2092. { IJclSingleSortedMap }
  2093. function FirstKey: Single;
  2094. function HeadMap(const ToKey: Single): IJclSingleSortedMap;
  2095. function LastKey: Single;
  2096. function SubMap(const FromKey, ToKey: Single): IJclSingleSortedMap;
  2097. function TailMap(const FromKey: Single): IJclSingleSortedMap;
  2098. end;
  2099. TJclDoubleSortedMapEntry = record
  2100. Key: Double;
  2101. Value: TObject;
  2102. end;
  2103. TJclDoubleSortedMapEntryArray = array of TJclDoubleSortedMapEntry;
  2104. TJclDoubleSortedMap = class(TJclDoubleAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE}
  2105. IJclIntfCloneable, IJclCloneable, IJclGrowable, IJclPackable, IJclBaseContainer, IJclDoubleContainer, IJclContainer, IJclValueOwner,
  2106. IJclDoubleMap, IJclDoubleSortedMap)
  2107. private
  2108. FOwnsValues: Boolean;
  2109. protected
  2110. function CreateEmptyContainer: TJclAbstractContainerBase; override;
  2111. function FreeKey(var Key: Double): Double;
  2112. function KeysCompare(const A, B: Double): Integer;
  2113. function ValuesCompare(A, B: TObject): Integer;
  2114. public
  2115. { IJclValueOwner }
  2116. function FreeValue(var Value: TObject): TObject;
  2117. function GetOwnsValues: Boolean;
  2118. property OwnsValues: Boolean read FOwnsValues;
  2119. private
  2120. FEntries: TJclDoubleSortedMapEntryArray;
  2121. function BinarySearch(const Key: Double): Integer;
  2122. protected
  2123. procedure AssignDataTo(Dest: TJclAbstractContainerBase); override;
  2124. procedure InitializeArrayAfterMove(var List: TJclDoubleSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  2125. {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
  2126. procedure MoveArray(var List: TJclDoubleSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  2127. public
  2128. constructor Create(ACapacity: Integer; AOwnsValues: Boolean);
  2129. destructor Destroy; override;
  2130. { IJclPackable }
  2131. procedure SetCapacity(Value: Integer); override;
  2132. { IJclDoubleMap }
  2133. procedure Clear;
  2134. function ContainsKey(const Key: Double): Boolean;
  2135. function ContainsValue(Value: TObject): Boolean;
  2136. function Extract(const Key: Double): TObject;
  2137. function GetValue(const Key: Double): TObject;
  2138. function IsEmpty: Boolean;
  2139. function KeyOfValue(Value: TObject): Double;
  2140. function KeySet: IJclDoubleSet;
  2141. function MapEquals(const AMap: IJclDoubleMap): Boolean;
  2142. procedure PutAll(const AMap: IJclDoubleMap);
  2143. procedure PutValue(const Key: Double; Value: TObject);
  2144. function Remove(const Key: Double): TObject;
  2145. function Size: Integer;
  2146. function Values: IJclCollection;
  2147. { IJclDoubleSortedMap }
  2148. function FirstKey: Double;
  2149. function HeadMap(const ToKey: Double): IJclDoubleSortedMap;
  2150. function LastKey: Double;
  2151. function SubMap(const FromKey, ToKey: Double): IJclDoubleSortedMap;
  2152. function TailMap(const FromKey: Double): IJclDoubleSortedMap;
  2153. end;
  2154. TJclExtendedSortedMapEntry = record
  2155. Key: Extended;
  2156. Value: TObject;
  2157. end;
  2158. TJclExtendedSortedMapEntryArray = array of TJclExtendedSortedMapEntry;
  2159. TJclExtendedSortedMap = class(TJclExtendedAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE}
  2160. IJclIntfCloneable, IJclCloneable, IJclGrowable, IJclPackable, IJclBaseContainer, IJclExtendedContainer, IJclContainer, IJclValueOwner,
  2161. IJclExtendedMap, IJclExtendedSortedMap)
  2162. private
  2163. FOwnsValues: Boolean;
  2164. protected
  2165. function CreateEmptyContainer: TJclAbstractContainerBase; override;
  2166. function FreeKey(var Key: Extended): Extended;
  2167. function KeysCompare(const A, B: Extended): Integer;
  2168. function ValuesCompare(A, B: TObject): Integer;
  2169. public
  2170. { IJclValueOwner }
  2171. function FreeValue(var Value: TObject): TObject;
  2172. function GetOwnsValues: Boolean;
  2173. property OwnsValues: Boolean read FOwnsValues;
  2174. private
  2175. FEntries: TJclExtendedSortedMapEntryArray;
  2176. function BinarySearch(const Key: Extended): Integer;
  2177. protected
  2178. procedure AssignDataTo(Dest: TJclAbstractContainerBase); override;
  2179. procedure InitializeArrayAfterMove(var List: TJclExtendedSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  2180. {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
  2181. procedure MoveArray(var List: TJclExtendedSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  2182. public
  2183. constructor Create(ACapacity: Integer; AOwnsValues: Boolean);
  2184. destructor Destroy; override;
  2185. { IJclPackable }
  2186. procedure SetCapacity(Value: Integer); override;
  2187. { IJclExtendedMap }
  2188. procedure Clear;
  2189. function ContainsKey(const Key: Extended): Boolean;
  2190. function ContainsValue(Value: TObject): Boolean;
  2191. function Extract(const Key: Extended): TObject;
  2192. function GetValue(const Key: Extended): TObject;
  2193. function IsEmpty: Boolean;
  2194. function KeyOfValue(Value: TObject): Extended;
  2195. function KeySet: IJclExtendedSet;
  2196. function MapEquals(const AMap: IJclExtendedMap): Boolean;
  2197. procedure PutAll(const AMap: IJclExtendedMap);
  2198. procedure PutValue(const Key: Extended; Value: TObject);
  2199. function Remove(const Key: Extended): TObject;
  2200. function Size: Integer;
  2201. function Values: IJclCollection;
  2202. { IJclExtendedSortedMap }
  2203. function FirstKey: Extended;
  2204. function HeadMap(const ToKey: Extended): IJclExtendedSortedMap;
  2205. function LastKey: Extended;
  2206. function SubMap(const FromKey, ToKey: Extended): IJclExtendedSortedMap;
  2207. function TailMap(const FromKey: Extended): IJclExtendedSortedMap;
  2208. end;
  2209. {$IFDEF MATH_SINGLE_PRECISION}
  2210. TJclFloatSortedMapEntry = TJclSingleSortedMapEntry;
  2211. {$ENDIF MATH_SINGLE_PRECISION}
  2212. {$IFDEF MATH_DOUBLE_PRECISION}
  2213. TJclFloatSortedMapEntry = TJclDoubleSortedMapEntry;
  2214. {$ENDIF MATH_DOUBLE_PRECISION}
  2215. {$IFDEF MATH_EXTENDED_PRECISION}
  2216. TJclFloatSortedMapEntry = TJclExtendedSortedMapEntry;
  2217. {$ENDIF MATH_EXTENDED_PRECISION}
  2218. {$IFDEF MATH_SINGLE_PRECISION}
  2219. TJclFloatSortedMap = TJclSingleSortedMap;
  2220. {$ENDIF MATH_SINGLE_PRECISION}
  2221. {$IFDEF MATH_DOUBLE_PRECISION}
  2222. TJclFloatSortedMap = TJclDoubleSortedMap;
  2223. {$ENDIF MATH_DOUBLE_PRECISION}
  2224. {$IFDEF MATH_EXTENDED_PRECISION}
  2225. TJclFloatSortedMap = TJclExtendedSortedMap;
  2226. {$ENDIF MATH_EXTENDED_PRECISION}
  2227. TJclIntegerSortedMapEntry = record
  2228. Key: Integer;
  2229. Value: TObject;
  2230. end;
  2231. TJclIntegerSortedMapEntryArray = array of TJclIntegerSortedMapEntry;
  2232. TJclIntegerSortedMap = class(TJclIntegerAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE}
  2233. IJclIntfCloneable, IJclCloneable, IJclGrowable, IJclPackable, IJclBaseContainer, IJclIntegerContainer, IJclContainer, IJclValueOwner,
  2234. IJclIntegerMap, IJclIntegerSortedMap)
  2235. private
  2236. FOwnsValues: Boolean;
  2237. protected
  2238. function CreateEmptyContainer: TJclAbstractContainerBase; override;
  2239. function FreeKey(var Key: Integer): Integer;
  2240. function KeysCompare(A, B: Integer): Integer;
  2241. function ValuesCompare(A, B: TObject): Integer;
  2242. public
  2243. { IJclValueOwner }
  2244. function FreeValue(var Value: TObject): TObject;
  2245. function GetOwnsValues: Boolean;
  2246. property OwnsValues: Boolean read FOwnsValues;
  2247. private
  2248. FEntries: TJclIntegerSortedMapEntryArray;
  2249. function BinarySearch(Key: Integer): Integer;
  2250. protected
  2251. procedure AssignDataTo(Dest: TJclAbstractContainerBase); override;
  2252. procedure InitializeArrayAfterMove(var List: TJclIntegerSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  2253. {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
  2254. procedure MoveArray(var List: TJclIntegerSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  2255. public
  2256. constructor Create(ACapacity: Integer; AOwnsValues: Boolean);
  2257. destructor Destroy; override;
  2258. { IJclPackable }
  2259. procedure SetCapacity(Value: Integer); override;
  2260. { IJclIntegerMap }
  2261. procedure Clear;
  2262. function ContainsKey(Key: Integer): Boolean;
  2263. function ContainsValue(Value: TObject): Boolean;
  2264. function Extract(Key: Integer): TObject;
  2265. function GetValue(Key: Integer): TObject;
  2266. function IsEmpty: Boolean;
  2267. function KeyOfValue(Value: TObject): Integer;
  2268. function KeySet: IJclIntegerSet;
  2269. function MapEquals(const AMap: IJclIntegerMap): Boolean;
  2270. procedure PutAll(const AMap: IJclIntegerMap);
  2271. procedure PutValue(Key: Integer; Value: TObject);
  2272. function Remove(Key: Integer): TObject;
  2273. function Size: Integer;
  2274. function Values: IJclCollection;
  2275. { IJclIntegerSortedMap }
  2276. function FirstKey: Integer;
  2277. function HeadMap(ToKey: Integer): IJclIntegerSortedMap;
  2278. function LastKey: Integer;
  2279. function SubMap(FromKey, ToKey: Integer): IJclIntegerSortedMap;
  2280. function TailMap(FromKey: Integer): IJclIntegerSortedMap;
  2281. end;
  2282. TJclCardinalSortedMapEntry = record
  2283. Key: Cardinal;
  2284. Value: TObject;
  2285. end;
  2286. TJclCardinalSortedMapEntryArray = array of TJclCardinalSortedMapEntry;
  2287. TJclCardinalSortedMap = class(TJclCardinalAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE}
  2288. IJclIntfCloneable, IJclCloneable, IJclGrowable, IJclPackable, IJclBaseContainer, IJclCardinalContainer, IJclContainer, IJclValueOwner,
  2289. IJclCardinalMap, IJclCardinalSortedMap)
  2290. private
  2291. FOwnsValues: Boolean;
  2292. protected
  2293. function CreateEmptyContainer: TJclAbstractContainerBase; override;
  2294. function FreeKey(var Key: Cardinal): Cardinal;
  2295. function KeysCompare(A, B: Cardinal): Integer;
  2296. function ValuesCompare(A, B: TObject): Integer;
  2297. public
  2298. { IJclValueOwner }
  2299. function FreeValue(var Value: TObject): TObject;
  2300. function GetOwnsValues: Boolean;
  2301. property OwnsValues: Boolean read FOwnsValues;
  2302. private
  2303. FEntries: TJclCardinalSortedMapEntryArray;
  2304. function BinarySearch(Key: Cardinal): Integer;
  2305. protected
  2306. procedure AssignDataTo(Dest: TJclAbstractContainerBase); override;
  2307. procedure InitializeArrayAfterMove(var List: TJclCardinalSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  2308. {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
  2309. procedure MoveArray(var List: TJclCardinalSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  2310. public
  2311. constructor Create(ACapacity: Integer; AOwnsValues: Boolean);
  2312. destructor Destroy; override;
  2313. { IJclPackable }
  2314. procedure SetCapacity(Value: Integer); override;
  2315. { IJclCardinalMap }
  2316. procedure Clear;
  2317. function ContainsKey(Key: Cardinal): Boolean;
  2318. function ContainsValue(Value: TObject): Boolean;
  2319. function Extract(Key: Cardinal): TObject;
  2320. function GetValue(Key: Cardinal): TObject;
  2321. function IsEmpty: Boolean;
  2322. function KeyOfValue(Value: TObject): Cardinal;
  2323. function KeySet: IJclCardinalSet;
  2324. function MapEquals(const AMap: IJclCardinalMap): Boolean;
  2325. procedure PutAll(const AMap: IJclCardinalMap);
  2326. procedure PutValue(Key: Cardinal; Value: TObject);
  2327. function Remove(Key: Cardinal): TObject;
  2328. function Size: Integer;
  2329. function Values: IJclCollection;
  2330. { IJclCardinalSortedMap }
  2331. function FirstKey: Cardinal;
  2332. function HeadMap(ToKey: Cardinal): IJclCardinalSortedMap;
  2333. function LastKey: Cardinal;
  2334. function SubMap(FromKey, ToKey: Cardinal): IJclCardinalSortedMap;
  2335. function TailMap(FromKey: Cardinal): IJclCardinalSortedMap;
  2336. end;
  2337. TJclInt64SortedMapEntry = record
  2338. Key: Int64;
  2339. Value: TObject;
  2340. end;
  2341. TJclInt64SortedMapEntryArray = array of TJclInt64SortedMapEntry;
  2342. TJclInt64SortedMap = class(TJclInt64AbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE}
  2343. IJclIntfCloneable, IJclCloneable, IJclGrowable, IJclPackable, IJclBaseContainer, IJclInt64Container, IJclContainer, IJclValueOwner,
  2344. IJclInt64Map, IJclInt64SortedMap)
  2345. private
  2346. FOwnsValues: Boolean;
  2347. protected
  2348. function CreateEmptyContainer: TJclAbstractContainerBase; override;
  2349. function FreeKey(var Key: Int64): Int64;
  2350. function KeysCompare(const A, B: Int64): Integer;
  2351. function ValuesCompare(A, B: TObject): Integer;
  2352. public
  2353. { IJclValueOwner }
  2354. function FreeValue(var Value: TObject): TObject;
  2355. function GetOwnsValues: Boolean;
  2356. property OwnsValues: Boolean read FOwnsValues;
  2357. private
  2358. FEntries: TJclInt64SortedMapEntryArray;
  2359. function BinarySearch(const Key: Int64): Integer;
  2360. protected
  2361. procedure AssignDataTo(Dest: TJclAbstractContainerBase); override;
  2362. procedure InitializeArrayAfterMove(var List: TJclInt64SortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  2363. {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
  2364. procedure MoveArray(var List: TJclInt64SortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  2365. public
  2366. constructor Create(ACapacity: Integer; AOwnsValues: Boolean);
  2367. destructor Destroy; override;
  2368. { IJclPackable }
  2369. procedure SetCapacity(Value: Integer); override;
  2370. { IJclInt64Map }
  2371. procedure Clear;
  2372. function ContainsKey(const Key: Int64): Boolean;
  2373. function ContainsValue(Value: TObject): Boolean;
  2374. function Extract(const Key: Int64): TObject;
  2375. function GetValue(const Key: Int64): TObject;
  2376. function IsEmpty: Boolean;
  2377. function KeyOfValue(Value: TObject): Int64;
  2378. function KeySet: IJclInt64Set;
  2379. function MapEquals(const AMap: IJclInt64Map): Boolean;
  2380. procedure PutAll(const AMap: IJclInt64Map);
  2381. procedure PutValue(const Key: Int64; Value: TObject);
  2382. function Remove(const Key: Int64): TObject;
  2383. function Size: Integer;
  2384. function Values: IJclCollection;
  2385. { IJclInt64SortedMap }
  2386. function FirstKey: Int64;
  2387. function HeadMap(const ToKey: Int64): IJclInt64SortedMap;
  2388. function LastKey: Int64;
  2389. function SubMap(const FromKey, ToKey: Int64): IJclInt64SortedMap;
  2390. function TailMap(const FromKey: Int64): IJclInt64SortedMap;
  2391. end;
  2392. TJclPtrSortedMapEntry = record
  2393. Key: Pointer;
  2394. Value: TObject;
  2395. end;
  2396. TJclPtrSortedMapEntryArray = array of TJclPtrSortedMapEntry;
  2397. TJclPtrSortedMap = class(TJclPtrAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE}
  2398. IJclIntfCloneable, IJclCloneable, IJclGrowable, IJclPackable, IJclBaseContainer, IJclPtrContainer, IJclContainer, IJclValueOwner,
  2399. IJclPtrMap, IJclPtrSortedMap)
  2400. private
  2401. FOwnsValues: Boolean;
  2402. protected
  2403. function CreateEmptyContainer: TJclAbstractContainerBase; override;
  2404. function FreeKey(var Key: Pointer): Pointer;
  2405. function KeysCompare(A, B: Pointer): Integer;
  2406. function ValuesCompare(A, B: TObject): Integer;
  2407. public
  2408. { IJclValueOwner }
  2409. function FreeValue(var Value: TObject): TObject;
  2410. function GetOwnsValues: Boolean;
  2411. property OwnsValues: Boolean read FOwnsValues;
  2412. private
  2413. FEntries: TJclPtrSortedMapEntryArray;
  2414. function BinarySearch(Key: Pointer): Integer;
  2415. protected
  2416. procedure AssignDataTo(Dest: TJclAbstractContainerBase); override;
  2417. procedure InitializeArrayAfterMove(var List: TJclPtrSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  2418. {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
  2419. procedure MoveArray(var List: TJclPtrSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  2420. public
  2421. constructor Create(ACapacity: Integer; AOwnsValues: Boolean);
  2422. destructor Destroy; override;
  2423. { IJclPackable }
  2424. procedure SetCapacity(Value: Integer); override;
  2425. { IJclPtrMap }
  2426. procedure Clear;
  2427. function ContainsKey(Key: Pointer): Boolean;
  2428. function ContainsValue(Value: TObject): Boolean;
  2429. function Extract(Key: Pointer): TObject;
  2430. function GetValue(Key: Pointer): TObject;
  2431. function IsEmpty: Boolean;
  2432. function KeyOfValue(Value: TObject): Pointer;
  2433. function KeySet: IJclPtrSet;
  2434. function MapEquals(const AMap: IJclPtrMap): Boolean;
  2435. procedure PutAll(const AMap: IJclPtrMap);
  2436. procedure PutValue(Key: Pointer; Value: TObject);
  2437. function Remove(Key: Pointer): TObject;
  2438. function Size: Integer;
  2439. function Values: IJclCollection;
  2440. { IJclPtrSortedMap }
  2441. function FirstKey: Pointer;
  2442. function HeadMap(ToKey: Pointer): IJclPtrSortedMap;
  2443. function LastKey: Pointer;
  2444. function SubMap(FromKey, ToKey: Pointer): IJclPtrSortedMap;
  2445. function TailMap(FromKey: Pointer): IJclPtrSortedMap;
  2446. end;
  2447. TJclSortedMapEntry = record
  2448. Key: TObject;
  2449. Value: TObject;
  2450. end;
  2451. TJclSortedMapEntryArray = array of TJclSortedMapEntry;
  2452. TJclSortedMap = class(TJclAbstractContainerBase, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE}
  2453. IJclIntfCloneable, IJclCloneable, IJclGrowable, IJclPackable, IJclBaseContainer, IJclContainer, IJclKeyOwner, IJclValueOwner,
  2454. IJclMap, IJclSortedMap)
  2455. private
  2456. FOwnsKeys: Boolean;
  2457. FOwnsValues: Boolean;
  2458. protected
  2459. function CreateEmptyContainer: TJclAbstractContainerBase; override;
  2460. function KeysCompare(A, B: TObject): Integer;
  2461. function ValuesCompare(A, B: TObject): Integer;
  2462. public
  2463. { IJclKeyOwner }
  2464. function FreeKey(var Key: TObject): TObject;
  2465. function GetOwnsKeys: Boolean;
  2466. property OwnsKeys: Boolean read FOwnsKeys;
  2467. { IJclValueOwner }
  2468. function FreeValue(var Value: TObject): TObject;
  2469. function GetOwnsValues: Boolean;
  2470. property OwnsValues: Boolean read FOwnsValues;
  2471. private
  2472. FEntries: TJclSortedMapEntryArray;
  2473. function BinarySearch(Key: TObject): Integer;
  2474. protected
  2475. procedure AssignDataTo(Dest: TJclAbstractContainerBase); override;
  2476. procedure InitializeArrayAfterMove(var List: TJclSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  2477. {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
  2478. procedure MoveArray(var List: TJclSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  2479. public
  2480. constructor Create(ACapacity: Integer; AOwnsValues: Boolean; AOwnsKeys: Boolean);
  2481. destructor Destroy; override;
  2482. { IJclPackable }
  2483. procedure SetCapacity(Value: Integer); override;
  2484. { IJclMap }
  2485. procedure Clear;
  2486. function ContainsKey(Key: TObject): Boolean;
  2487. function ContainsValue(Value: TObject): Boolean;
  2488. function Extract(Key: TObject): TObject;
  2489. function GetValue(Key: TObject): TObject;
  2490. function IsEmpty: Boolean;
  2491. function KeyOfValue(Value: TObject): TObject;
  2492. function KeySet: IJclSet;
  2493. function MapEquals(const AMap: IJclMap): Boolean;
  2494. procedure PutAll(const AMap: IJclMap);
  2495. procedure PutValue(Key: TObject; Value: TObject);
  2496. function Remove(Key: TObject): TObject;
  2497. function Size: Integer;
  2498. function Values: IJclCollection;
  2499. { IJclSortedMap }
  2500. function FirstKey: TObject;
  2501. function HeadMap(ToKey: TObject): IJclSortedMap;
  2502. function LastKey: TObject;
  2503. function SubMap(FromKey, ToKey: TObject): IJclSortedMap;
  2504. function TailMap(FromKey: TObject): IJclSortedMap;
  2505. end;
  2506. {$IFDEF SUPPORTS_GENERICS}
  2507. //DOM-IGNORE-BEGIN
  2508. TJclSortedEntry<TKey,TValue> = record
  2509. Key: TKey;
  2510. Value: TValue;
  2511. end;
  2512. TJclSortedMap<TKey,TValue> = class(TJclAbstractContainerBase, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE}
  2513. IJclIntfCloneable, IJclCloneable, IJclGrowable, IJclPackable, IJclBaseContainer, IJclPairOwner<TKey,TValue>,
  2514. IJclMap<TKey,TValue>, IJclSortedMap<TKey,TValue>)
  2515. protected
  2516. type
  2517. TSortedEntry = TJclSortedEntry<TKey,TValue>;
  2518. TSortedEntryArray = array of TSortedEntry;
  2519. private
  2520. FOwnsKeys: Boolean;
  2521. FOwnsValues: Boolean;
  2522. protected
  2523. function KeysCompare(const A, B: TKey): Integer; virtual; abstract;
  2524. function ValuesCompare(const A, B: TValue): Integer; virtual; abstract;
  2525. function CreateEmptyArrayList(ACapacity: Integer; AOwnsObjects: Boolean): IJclCollection<TValue>; virtual; abstract;
  2526. function CreateEmptyArraySet(ACapacity: Integer; AOwnsObjects: Boolean): IJclSet<TKey>; virtual; abstract;
  2527. public
  2528. { IJclPairOwner }
  2529. function FreeKey(var Key: TKey): TKey;
  2530. function FreeValue(var Value: TValue): TValue;
  2531. function GetOwnsKeys: Boolean;
  2532. function GetOwnsValues: Boolean;
  2533. property OwnsKeys: Boolean read FOwnsKeys;
  2534. property OwnsValues: Boolean read FOwnsValues;
  2535. private
  2536. FEntries: TSortedEntryArray;
  2537. function BinarySearch(const Key: TKey): Integer;
  2538. protected
  2539. procedure AssignDataTo(Dest: TJclAbstractContainerBase); override;
  2540. procedure MoveArray(var List: TSortedEntryArray; FromIndex, ToIndex, Count: SizeInt);
  2541. public
  2542. constructor Create(ACapacity: Integer; AOwnsValues: Boolean; AOwnsKeys: Boolean);
  2543. destructor Destroy; override;
  2544. { IJclPackable }
  2545. procedure SetCapacity(Value: Integer); override;
  2546. { IJclMap<TKey,TValue> }
  2547. procedure Clear;
  2548. function ContainsKey(const Key: TKey): Boolean;
  2549. function ContainsValue(const Value: TValue): Boolean;
  2550. function Extract(const Key: TKey): TValue;
  2551. function GetValue(const Key: TKey): TValue;
  2552. function IsEmpty: Boolean;
  2553. function KeyOfValue(const Value: TValue): TKey;
  2554. function KeySet: IJclSet<TKey>;
  2555. function MapEquals(const AMap: IJclMap<TKey,TValue>): Boolean;
  2556. procedure PutAll(const AMap: IJclMap<TKey,TValue>);
  2557. procedure PutValue(const Key: TKey; const Value: TValue);
  2558. function Remove(const Key: TKey): TValue;
  2559. function Size: Integer;
  2560. function Values: IJclCollection<TValue>;
  2561. { IJclSortedMap<TKey,TValue> }
  2562. function FirstKey: TKey;
  2563. function HeadMap(const ToKey: TKey): IJclSortedMap<TKey,TValue>;
  2564. function LastKey: TKey;
  2565. function SubMap(const FromKey, ToKey: TKey): IJclSortedMap<TKey,TValue>;
  2566. function TailMap(const FromKey: TKey): IJclSortedMap<TKey,TValue>;
  2567. end;
  2568. // E = external helper to compare items
  2569. TJclSortedMapE<TKey, TValue> = class(TJclSortedMap<TKey,TValue>, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE}
  2570. IJclIntfCloneable, IJclCloneable, IJclPackable, IJclBaseContainer, IJclMap<TKey,TValue>, IJclSortedMap<TKey,TValue>, IJclPairOwner<TKey,TValue>)
  2571. protected
  2572. type
  2573. TArrayList = TJclArrayListE<TValue>;
  2574. TArraySet = TJclArraySetE<TKey>;
  2575. private
  2576. FKeyComparer: IJclComparer<TKey>;
  2577. FValueComparer: IJclComparer<TValue>;
  2578. FValueEqualityComparer: IJclEqualityComparer<TValue>;
  2579. protected
  2580. procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override;
  2581. function KeysCompare(const A, B: TKey): Integer; override;
  2582. function ValuesCompare(const A, B: TValue): Integer; override;
  2583. function CreateEmptyArrayList(ACapacity: Integer; AOwnsObjects: Boolean): IJclCollection<TValue>; override;
  2584. function CreateEmptyContainer: TJclAbstractContainerBase; override;
  2585. function CreateEmptyArraySet(ACapacity: Integer; AOwnsObjects: Boolean): IJclSet<TKey>; override;
  2586. public
  2587. constructor Create(const AKeyComparer: IJclComparer<TKey>; const AValueComparer: IJclComparer<TValue>;
  2588. const AValueEqualityComparer: IJclEqualityComparer<TValue>; ACapacity: Integer; AOwnsValues: Boolean;
  2589. AOwnsKeys: Boolean);
  2590. property KeyComparer: IJclComparer<TKey> read FKeyComparer write FKeyComparer;
  2591. property ValueComparer: IJclComparer<TValue> read FValueComparer write FValueComparer;
  2592. property ValueEqualityComparer: IJclEqualityComparer<TValue> read FValueEqualityComparer write FValueEqualityComparer;
  2593. end;
  2594. // F = Functions to compare items
  2595. TJclSortedMapF<TKey, TValue> = class(TJclSortedMap<TKey, TValue>, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE}
  2596. IJclIntfCloneable, IJclCloneable, IJclPackable, IJclBaseContainer, IJclMap<TKey,TValue>, IJclSortedMap<TKey,TValue>, IJclPairOwner<TKey, TValue>)
  2597. protected
  2598. type
  2599. TArrayList = TJclArrayListF<TValue>;
  2600. TArraySet = TJclArraySetF<TKey>;
  2601. private
  2602. FKeyCompare: TCompare<TKey>;
  2603. FValueCompare: TCompare<TValue>;
  2604. FValueEqualityCompare: TEqualityCompare<TValue>;
  2605. protected
  2606. procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override;
  2607. function KeysCompare(const A, B: TKey): Integer; override;
  2608. function ValuesCompare(const A, B: TValue): Integer; override;
  2609. function CreateEmptyArrayList(ACapacity: Integer; AOwnsObjects: Boolean): IJclCollection<TValue>; override;
  2610. function CreateEmptyContainer: TJclAbstractContainerBase; override;
  2611. function CreateEmptyArraySet(ACapacity: Integer; AOwnsObjects: Boolean): IJclSet<TKey>; override;
  2612. public
  2613. constructor Create(AKeyCompare: TCompare<TKey>; AValueCompare: TCompare<TValue>;
  2614. AValueEqualityCompare: TEqualityCompare<TValue>; ACapacity: Integer; AOwnsValues: Boolean; AOwnsKeys: Boolean);
  2615. property KeyCompare: TCompare<TKey> read FKeyCompare write FKeyCompare;
  2616. property ValueCompare: TCompare<TValue> read FValueCompare write FValueCompare;
  2617. property ValueEqualityCompare: TEqualityCompare<TValue> read FValueEqualityCompare write FValueEqualityCompare;
  2618. end;
  2619. // I = items can compare themselves to an other
  2620. TJclSortedMapI<TKey: IComparable<TKey>; TValue: IComparable<TValue>, IEquatable<TValue>> = class(TJclSortedMap<TKey, TValue>,
  2621. {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} IJclIntfCloneable, IJclCloneable, IJclPackable, IJclBaseContainer,
  2622. IJclMap<TKey,TValue>, IJclSortedMap<TKey,TValue>, IJclPairOwner<TKey, TValue>)
  2623. protected
  2624. type
  2625. TArrayList = TJclArrayListI<TValue>;
  2626. TArraySet = TJclArraySetI<TKey>;
  2627. protected
  2628. function KeysCompare(const A, B: TKey): Integer; override;
  2629. function ValuesCompare(const A, B: TValue): Integer; override;
  2630. function CreateEmptyArrayList(ACapacity: Integer; AOwnsObjects: Boolean): IJclCollection<TValue>; override;
  2631. function CreateEmptyContainer: TJclAbstractContainerBase; override;
  2632. function CreateEmptyArraySet(ACapacity: Integer; AOwnsObjects: Boolean): IJclSet<TKey>; override;
  2633. end;
  2634. //DOM-IGNORE-END
  2635. {$ENDIF SUPPORTS_GENERICS}
  2636. {$IFDEF UNITVERSIONING}
  2637. const
  2638. UnitVersioning: TUnitVersionInfo = (
  2639. RCSfile: '$URL$';
  2640. Revision: '$Revision$';
  2641. Date: '$Date$';
  2642. LogPath: 'JCL\source\common';
  2643. Extra: '';
  2644. Data: nil
  2645. );
  2646. {$ENDIF UNITVERSIONING}
  2647. implementation
  2648. uses
  2649. {$IFDEF HAS_UNITSCOPE}
  2650. System.SysUtils;
  2651. {$ELSE ~HAS_UNITSCOPE}
  2652. SysUtils;
  2653. {$ENDIF ~HAS_UNITSCOPE}
  2654. //=== { TJclIntfIntfSortedMap } ==============================================
  2655. constructor TJclIntfIntfSortedMap.Create(ACapacity: Integer);
  2656. begin
  2657. inherited Create();
  2658. SetCapacity(ACapacity);
  2659. end;
  2660. destructor TJclIntfIntfSortedMap.Destroy;
  2661. begin
  2662. FReadOnly := False;
  2663. Clear;
  2664. inherited Destroy;
  2665. end;
  2666. procedure TJclIntfIntfSortedMap.AssignDataTo(Dest: TJclAbstractContainerBase);
  2667. var
  2668. MyDest: TJclIntfIntfSortedMap;
  2669. begin
  2670. inherited AssignDataTo(Dest);
  2671. if Dest is TJclIntfIntfSortedMap then
  2672. begin
  2673. MyDest := TJclIntfIntfSortedMap(Dest);
  2674. MyDest.SetCapacity(FSize);
  2675. MyDest.FEntries := FEntries;
  2676. MyDest.FSize := FSize;
  2677. end;
  2678. end;
  2679. function TJclIntfIntfSortedMap.BinarySearch(const Key: IInterface): Integer;
  2680. var
  2681. HiPos, LoPos, CompPos: Integer;
  2682. Comp: Integer;
  2683. begin
  2684. {$IFDEF THREADSAFE}
  2685. if FThreadSafe then
  2686. SyncReaderWriter.BeginRead;
  2687. try
  2688. {$ENDIF THREADSAFE}
  2689. LoPos := 0;
  2690. HiPos := FSize - 1;
  2691. CompPos := (HiPos + LoPos) div 2;
  2692. while HiPos >= LoPos do
  2693. begin
  2694. Comp := KeysCompare(FEntries[CompPos].Key, Key);
  2695. if Comp < 0 then
  2696. LoPos := CompPos + 1
  2697. else
  2698. if Comp > 0 then
  2699. HiPos := CompPos - 1
  2700. else
  2701. begin
  2702. HiPos := CompPos;
  2703. LoPos := CompPos + 1;
  2704. end;
  2705. CompPos := (HiPos + LoPos) div 2;
  2706. end;
  2707. Result := HiPos;
  2708. {$IFDEF THREADSAFE}
  2709. finally
  2710. if FThreadSafe then
  2711. SyncReaderWriter.EndRead;
  2712. end;
  2713. {$ENDIF THREADSAFE}
  2714. end;
  2715. procedure TJclIntfIntfSortedMap.Clear;
  2716. var
  2717. Index: Integer;
  2718. begin
  2719. if ReadOnly then
  2720. raise EJclReadOnlyError.Create;
  2721. {$IFDEF THREADSAFE}
  2722. if FThreadSafe then
  2723. SyncReaderWriter.BeginWrite;
  2724. try
  2725. {$ENDIF THREADSAFE}
  2726. for Index := 0 to FSize - 1 do
  2727. begin
  2728. FreeKey(FEntries[Index].Key);
  2729. FreeValue(FEntries[Index].Value);
  2730. end;
  2731. FSize := 0;
  2732. AutoPack;
  2733. {$IFDEF THREADSAFE}
  2734. finally
  2735. if FThreadSafe then
  2736. SyncReaderWriter.EndWrite;
  2737. end;
  2738. {$ENDIF THREADSAFE}
  2739. end;
  2740. function TJclIntfIntfSortedMap.ContainsKey(const Key: IInterface): Boolean;
  2741. var
  2742. Index: Integer;
  2743. begin
  2744. {$IFDEF THREADSAFE}
  2745. if FThreadSafe then
  2746. SyncReaderWriter.BeginRead;
  2747. try
  2748. {$ENDIF THREADSAFE}
  2749. Index := BinarySearch(Key);
  2750. Result := (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0);
  2751. {$IFDEF THREADSAFE}
  2752. finally
  2753. if FThreadSafe then
  2754. SyncReaderWriter.EndRead;
  2755. end;
  2756. {$ENDIF THREADSAFE}
  2757. end;
  2758. function TJclIntfIntfSortedMap.ContainsValue(const Value: IInterface): Boolean;
  2759. var
  2760. Index: Integer;
  2761. begin
  2762. {$IFDEF THREADSAFE}
  2763. if FThreadSafe then
  2764. SyncReaderWriter.BeginRead;
  2765. try
  2766. {$ENDIF THREADSAFE}
  2767. Result := False;
  2768. for Index := 0 to FSize - 1 do
  2769. if ValuesCompare(FEntries[Index].Value, Value) = 0 then
  2770. begin
  2771. Result := True;
  2772. Break;
  2773. end;
  2774. {$IFDEF THREADSAFE}
  2775. finally
  2776. if FThreadSafe then
  2777. SyncReaderWriter.EndRead;
  2778. end;
  2779. {$ENDIF THREADSAFE}
  2780. end;
  2781. function TJclIntfIntfSortedMap.FirstKey: IInterface;
  2782. begin
  2783. {$IFDEF THREADSAFE}
  2784. if FThreadSafe then
  2785. SyncReaderWriter.BeginRead;
  2786. try
  2787. {$ENDIF THREADSAFE}
  2788. Result := nil;
  2789. if FSize > 0 then
  2790. Result := FEntries[0].Key
  2791. else
  2792. if not FReturnDefaultElements then
  2793. raise EJclNoSuchElementError.Create('');
  2794. {$IFDEF THREADSAFE}
  2795. finally
  2796. if FThreadSafe then
  2797. SyncReaderWriter.EndRead;
  2798. end;
  2799. {$ENDIF THREADSAFE}
  2800. end;
  2801. function TJclIntfIntfSortedMap.Extract(const Key: IInterface): IInterface;
  2802. var
  2803. Index: Integer;
  2804. begin
  2805. if ReadOnly then
  2806. raise EJclReadOnlyError.Create;
  2807. {$IFDEF THREADSAFE}
  2808. if FThreadSafe then
  2809. SyncReaderWriter.BeginWrite;
  2810. try
  2811. {$ENDIF THREADSAFE}
  2812. Index := BinarySearch(Key);
  2813. if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then
  2814. begin
  2815. Result := FEntries[Index].Value;
  2816. FEntries[Index].Value := nil;
  2817. FreeKey(FEntries[Index].Key);
  2818. if Index < (FSize - 1) then
  2819. MoveArray(FEntries, Index + 1, Index, FSize - Index - 1);
  2820. Dec(FSize);
  2821. AutoPack;
  2822. end
  2823. else
  2824. Result := nil;
  2825. {$IFDEF THREADSAFE}
  2826. finally
  2827. if FThreadSafe then
  2828. SyncReaderWriter.EndWrite;
  2829. end;
  2830. {$ENDIF THREADSAFE}
  2831. end;
  2832. function TJclIntfIntfSortedMap.GetValue(const Key: IInterface): IInterface;
  2833. var
  2834. Index: Integer;
  2835. begin
  2836. {$IFDEF THREADSAFE}
  2837. if FThreadSafe then
  2838. SyncReaderWriter.BeginRead;
  2839. try
  2840. {$ENDIF THREADSAFE}
  2841. Index := BinarySearch(Key);
  2842. Result := nil;
  2843. if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then
  2844. Result := FEntries[Index].Value
  2845. else if not FReturnDefaultElements then
  2846. raise EJclNoSuchElementError.Create('');
  2847. {$IFDEF THREADSAFE}
  2848. finally
  2849. if FThreadSafe then
  2850. SyncReaderWriter.EndRead;
  2851. end;
  2852. {$ENDIF THREADSAFE}
  2853. end;
  2854. function TJclIntfIntfSortedMap.HeadMap(const ToKey: IInterface): IJclIntfIntfSortedMap;
  2855. var
  2856. ToIndex: Integer;
  2857. NewMap: TJclIntfIntfSortedMap;
  2858. begin
  2859. {$IFDEF THREADSAFE}
  2860. if FThreadSafe then
  2861. SyncReaderWriter.BeginRead;
  2862. try
  2863. {$ENDIF THREADSAFE}
  2864. NewMap := CreateEmptyContainer as TJclIntfIntfSortedMap;
  2865. ToIndex := BinarySearch(ToKey);
  2866. if ToIndex >= 0 then
  2867. begin
  2868. NewMap.SetCapacity(ToIndex + 1);
  2869. NewMap.FSize := ToIndex + 1;
  2870. while ToIndex >= 0 do
  2871. begin
  2872. NewMap.FEntries[ToIndex] := FEntries[ToIndex];
  2873. Dec(ToIndex);
  2874. end;
  2875. end;
  2876. Result := NewMap;
  2877. {$IFDEF THREADSAFE}
  2878. finally
  2879. if FThreadSafe then
  2880. SyncReaderWriter.EndRead;
  2881. end;
  2882. {$ENDIF THREADSAFE}
  2883. end;
  2884. function TJclIntfIntfSortedMap.IsEmpty: Boolean;
  2885. begin
  2886. {$IFDEF THREADSAFE}
  2887. if FThreadSafe then
  2888. SyncReaderWriter.BeginRead;
  2889. try
  2890. {$ENDIF THREADSAFE}
  2891. Result := FSize = 0;
  2892. {$IFDEF THREADSAFE}
  2893. finally
  2894. if FThreadSafe then
  2895. SyncReaderWriter.EndRead;
  2896. end;
  2897. {$ENDIF THREADSAFE}
  2898. end;
  2899. function TJclIntfIntfSortedMap.KeyOfValue(const Value: IInterface): IInterface;
  2900. var
  2901. Index: Integer;
  2902. Found: Boolean;
  2903. begin
  2904. {$IFDEF THREADSAFE}
  2905. if FThreadSafe then
  2906. SyncReaderWriter.BeginRead;
  2907. try
  2908. {$ENDIF THREADSAFE}
  2909. Found := False;
  2910. Result := nil;
  2911. for Index := 0 to FSize - 1 do
  2912. if ValuesCompare(FEntries[Index].Value, Value) = 0 then
  2913. begin
  2914. Result := FEntries[Index].Key;
  2915. Found := True;
  2916. Break;
  2917. end;
  2918. if (not Found) and (not FReturnDefaultElements) then
  2919. raise EJclNoSuchElementError.Create('');
  2920. {$IFDEF THREADSAFE}
  2921. finally
  2922. if FThreadSafe then
  2923. SyncReaderWriter.EndRead;
  2924. end;
  2925. {$ENDIF THREADSAFE}
  2926. end;
  2927. function TJclIntfIntfSortedMap.KeySet: IJclIntfSet;
  2928. var
  2929. Index: Integer;
  2930. begin
  2931. {$IFDEF THREADSAFE}
  2932. if FThreadSafe then
  2933. SyncReaderWriter.BeginRead;
  2934. try
  2935. {$ENDIF THREADSAFE}
  2936. Result := TJclIntfArraySet.Create(FSize);
  2937. for Index := 0 to FSize - 1 do
  2938. Result.Add(FEntries[Index].Key);
  2939. {$IFDEF THREADSAFE}
  2940. finally
  2941. if FThreadSafe then
  2942. SyncReaderWriter.EndRead;
  2943. end;
  2944. {$ENDIF THREADSAFE}
  2945. end;
  2946. function TJclIntfIntfSortedMap.LastKey: IInterface;
  2947. begin
  2948. {$IFDEF THREADSAFE}
  2949. if FThreadSafe then
  2950. SyncReaderWriter.BeginRead;
  2951. try
  2952. {$ENDIF THREADSAFE}
  2953. Result := nil;
  2954. if FSize > 0 then
  2955. Result := FEntries[FSize - 1].Key
  2956. else
  2957. if not FReturnDefaultElements then
  2958. raise EJclNoSuchElementError.Create('');
  2959. {$IFDEF THREADSAFE}
  2960. finally
  2961. if FThreadSafe then
  2962. SyncReaderWriter.EndRead;
  2963. end;
  2964. {$ENDIF THREADSAFE}
  2965. end;
  2966. function TJclIntfIntfSortedMap.MapEquals(const AMap: IJclIntfIntfMap): Boolean;
  2967. var
  2968. It: IJclIntfIterator;
  2969. Index: Integer;
  2970. AKey: IInterface;
  2971. begin
  2972. {$IFDEF THREADSAFE}
  2973. if FThreadSafe then
  2974. SyncReaderWriter.BeginRead;
  2975. try
  2976. {$ENDIF THREADSAFE}
  2977. Result := False;
  2978. if AMap = nil then
  2979. Exit;
  2980. if FSize <> AMap.Size then
  2981. Exit;
  2982. It := AMap.KeySet.First;
  2983. Index := 0;
  2984. while It.HasNext do
  2985. begin
  2986. if Index >= FSize then
  2987. Exit;
  2988. AKey := It.Next;
  2989. if ValuesCompare(AMap.GetValue(AKey), FEntries[Index].Value) <> 0 then
  2990. Exit;
  2991. Inc(Index);
  2992. end;
  2993. Result := True;
  2994. {$IFDEF THREADSAFE}
  2995. finally
  2996. if FThreadSafe then
  2997. SyncReaderWriter.EndRead;
  2998. end;
  2999. {$ENDIF THREADSAFE}
  3000. end;
  3001. procedure TJclIntfIntfSortedMap.FinalizeArrayBeforeMove(var List: TJclIntfIntfSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  3002. begin
  3003. Assert(Count > 0);
  3004. if FromIndex < ToIndex then
  3005. begin
  3006. if Count > (ToIndex - FromIndex) then
  3007. Finalize(List[FromIndex + Count], ToIndex - FromIndex)
  3008. else
  3009. Finalize(List[ToIndex], Count);
  3010. end
  3011. else
  3012. if FromIndex > ToIndex then
  3013. begin
  3014. if Count > (FromIndex - ToIndex) then
  3015. Count := FromIndex - ToIndex;
  3016. Finalize(List[ToIndex], Count)
  3017. end;
  3018. end;
  3019. procedure TJclIntfIntfSortedMap.InitializeArray(var List: TJclIntfIntfSortedMapEntryArray; FromIndex, Count: SizeInt);
  3020. begin
  3021. {$IFDEF FPC}
  3022. while Count > 0 do
  3023. begin
  3024. Initialize(List[FromIndex]);
  3025. Inc(FromIndex);
  3026. Dec(Count);
  3027. end;
  3028. {$ELSE ~FPC}
  3029. Initialize(List[FromIndex], Count);
  3030. {$ENDIF ~FPC}
  3031. end;
  3032. procedure TJclIntfIntfSortedMap.InitializeArrayAfterMove(var List: TJclIntfIntfSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  3033. begin
  3034. { Keep reference counting working }
  3035. if FromIndex < ToIndex then
  3036. begin
  3037. if (ToIndex - FromIndex) < Count then
  3038. Count := ToIndex - FromIndex;
  3039. InitializeArray(List, FromIndex, Count);
  3040. end
  3041. else
  3042. if FromIndex > ToIndex then
  3043. begin
  3044. if (FromIndex - ToIndex) < Count then
  3045. InitializeArray(List, ToIndex + Count, FromIndex - ToIndex)
  3046. else
  3047. InitializeArray(List, FromIndex, Count);
  3048. end;
  3049. end;
  3050. procedure TJclIntfIntfSortedMap.MoveArray(var List: TJclIntfIntfSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  3051. begin
  3052. if Count > 0 then
  3053. begin
  3054. FinalizeArrayBeforeMove(List, FromIndex, ToIndex, Count);
  3055. Move(List[FromIndex], List[ToIndex], Count * SizeOf(List[0]));
  3056. InitializeArrayAfterMove(List, FromIndex, ToIndex, Count);
  3057. end;
  3058. end;
  3059. procedure TJclIntfIntfSortedMap.PutAll(const AMap: IJclIntfIntfMap);
  3060. var
  3061. It: IJclIntfIterator;
  3062. Key: IInterface;
  3063. begin
  3064. if ReadOnly then
  3065. raise EJclReadOnlyError.Create;
  3066. {$IFDEF THREADSAFE}
  3067. if FThreadSafe then
  3068. SyncReaderWriter.BeginWrite;
  3069. try
  3070. {$ENDIF THREADSAFE}
  3071. if AMap = nil then
  3072. Exit;
  3073. It := AMap.KeySet.First;
  3074. while It.HasNext do
  3075. begin
  3076. Key := It.Next;
  3077. PutValue(Key, AMap.GetValue(Key));
  3078. end;
  3079. {$IFDEF THREADSAFE}
  3080. finally
  3081. if FThreadSafe then
  3082. SyncReaderWriter.EndWrite;
  3083. end;
  3084. {$ENDIF THREADSAFE}
  3085. end;
  3086. procedure TJclIntfIntfSortedMap.PutValue(const Key: IInterface; const Value: IInterface);
  3087. var
  3088. Index: Integer;
  3089. begin
  3090. if ReadOnly then
  3091. raise EJclReadOnlyError.Create;
  3092. {$IFDEF THREADSAFE}
  3093. if FThreadSafe then
  3094. SyncReaderWriter.BeginWrite;
  3095. try
  3096. {$ENDIF THREADSAFE}
  3097. if FAllowDefaultElements or ((KeysCompare(Key, nil) <> 0) and (ValuesCompare(Value, nil) <> 0)) then
  3098. begin
  3099. Index := BinarySearch(Key);
  3100. if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then
  3101. begin
  3102. FreeValue(FEntries[Index].Value);
  3103. FEntries[Index].Value := Value;
  3104. end
  3105. else
  3106. begin
  3107. if FSize = FCapacity then
  3108. AutoGrow;
  3109. if FSize < FCapacity then
  3110. begin
  3111. Inc(Index);
  3112. if (Index < FSize) and (KeysCompare(FEntries[Index].Key, Key) <> 0) then
  3113. MoveArray(FEntries, Index, Index + 1, FSize - Index);
  3114. FEntries[Index].Key := Key;
  3115. FEntries[Index].Value := Value;
  3116. Inc(FSize);
  3117. end;
  3118. end;
  3119. end;
  3120. {$IFDEF THREADSAFE}
  3121. finally
  3122. if FThreadSafe then
  3123. SyncReaderWriter.EndWrite;
  3124. end;
  3125. {$ENDIF THREADSAFE}
  3126. end;
  3127. function TJclIntfIntfSortedMap.Remove(const Key: IInterface): IInterface;
  3128. begin
  3129. if ReadOnly then
  3130. raise EJclReadOnlyError.Create;
  3131. {$IFDEF THREADSAFE}
  3132. if FThreadSafe then
  3133. SyncReaderWriter.BeginWrite;
  3134. try
  3135. {$ENDIF THREADSAFE}
  3136. Result := Extract(Key);
  3137. Result := FreeValue(Result);
  3138. {$IFDEF THREADSAFE}
  3139. finally
  3140. if FThreadSafe then
  3141. SyncReaderWriter.EndWrite;
  3142. end;
  3143. {$ENDIF THREADSAFE}
  3144. end;
  3145. procedure TJclIntfIntfSortedMap.SetCapacity(Value: Integer);
  3146. begin
  3147. if ReadOnly then
  3148. raise EJclReadOnlyError.Create;
  3149. {$IFDEF THREADSAFE}
  3150. if FThreadSafe then
  3151. SyncReaderWriter.BeginWrite;
  3152. try
  3153. {$ENDIF THREADSAFE}
  3154. if FSize <= Value then
  3155. begin
  3156. SetLength(FEntries, Value);
  3157. inherited SetCapacity(Value);
  3158. end
  3159. else
  3160. raise EJclOperationNotSupportedError.Create;
  3161. {$IFDEF THREADSAFE}
  3162. finally
  3163. if FThreadSafe then
  3164. SyncReaderWriter.EndWrite;
  3165. end;
  3166. {$ENDIF THREADSAFE}
  3167. end;
  3168. function TJclIntfIntfSortedMap.Size: Integer;
  3169. begin
  3170. Result := FSize;
  3171. end;
  3172. function TJclIntfIntfSortedMap.SubMap(const FromKey, ToKey: IInterface): IJclIntfIntfSortedMap;
  3173. var
  3174. FromIndex, ToIndex: Integer;
  3175. NewMap: TJclIntfIntfSortedMap;
  3176. begin
  3177. {$IFDEF THREADSAFE}
  3178. if FThreadSafe then
  3179. SyncReaderWriter.BeginRead;
  3180. try
  3181. {$ENDIF THREADSAFE}
  3182. NewMap := CreateEmptyContainer as TJclIntfIntfSortedMap;
  3183. FromIndex := BinarySearch(FromKey);
  3184. if (FromIndex = -1) or (KeysCompare(FEntries[FromIndex].Key, FromKey) < 0) then
  3185. Inc(FromIndex);
  3186. ToIndex := BinarySearch(ToKey);
  3187. if (FromIndex >= 0) and (FromIndex <= ToIndex) then
  3188. begin
  3189. NewMap.SetCapacity(ToIndex - FromIndex + 1);
  3190. NewMap.FSize := ToIndex - FromIndex + 1;
  3191. while ToIndex >= FromIndex do
  3192. begin
  3193. NewMap.FEntries[ToIndex - FromIndex] := FEntries[ToIndex];
  3194. Dec(ToIndex);
  3195. end;
  3196. end;
  3197. Result := NewMap;
  3198. {$IFDEF THREADSAFE}
  3199. finally
  3200. if FThreadSafe then
  3201. SyncReaderWriter.EndRead;
  3202. end;
  3203. {$ENDIF THREADSAFE}
  3204. end;
  3205. function TJclIntfIntfSortedMap.TailMap(const FromKey: IInterface): IJclIntfIntfSortedMap;
  3206. var
  3207. FromIndex, Index: Integer;
  3208. NewMap: TJclIntfIntfSortedMap;
  3209. begin
  3210. {$IFDEF THREADSAFE}
  3211. if FThreadSafe then
  3212. SyncReaderWriter.BeginRead;
  3213. try
  3214. {$ENDIF THREADSAFE}
  3215. NewMap := CreateEmptyContainer as TJclIntfIntfSortedMap;
  3216. FromIndex := BinarySearch(FromKey);
  3217. if (FromIndex = -1) or (KeysCompare(FEntries[FromIndex].Key, FromKey) < 0) then
  3218. Inc(FromIndex);
  3219. if (FromIndex >= 0) and (FromIndex < FSize) then
  3220. begin
  3221. NewMap.SetCapacity(FSize - FromIndex);
  3222. NewMap.FSize := FSize - FromIndex;
  3223. Index := FromIndex;
  3224. while Index < FSize do
  3225. begin
  3226. NewMap.FEntries[Index - FromIndex] := FEntries[Index];
  3227. Inc(Index);
  3228. end;
  3229. end;
  3230. Result := NewMap;
  3231. {$IFDEF THREADSAFE}
  3232. finally
  3233. if FThreadSafe then
  3234. SyncReaderWriter.EndRead;
  3235. end;
  3236. {$ENDIF THREADSAFE}
  3237. end;
  3238. function TJclIntfIntfSortedMap.Values: IJclIntfCollection;
  3239. var
  3240. Index: Integer;
  3241. begin
  3242. {$IFDEF THREADSAFE}
  3243. if FThreadSafe then
  3244. SyncReaderWriter.BeginRead;
  3245. try
  3246. {$ENDIF THREADSAFE}
  3247. Result := TJclIntfArrayList.Create(FSize);
  3248. for Index := 0 to FSize - 1 do
  3249. Result.Add(FEntries[Index].Value);
  3250. {$IFDEF THREADSAFE}
  3251. finally
  3252. if FThreadSafe then
  3253. SyncReaderWriter.EndRead;
  3254. end;
  3255. {$ENDIF THREADSAFE}
  3256. end;
  3257. function TJclIntfIntfSortedMap.CreateEmptyContainer: TJclAbstractContainerBase;
  3258. begin
  3259. Result := TJclIntfIntfSortedMap.Create(FSize);
  3260. AssignPropertiesTo(Result);
  3261. end;
  3262. function TJclIntfIntfSortedMap.FreeKey(var Key: IInterface): IInterface;
  3263. begin
  3264. Result := Key;
  3265. Key := nil;
  3266. end;
  3267. function TJclIntfIntfSortedMap.FreeValue(var Value: IInterface): IInterface;
  3268. begin
  3269. Result := Value;
  3270. Value := nil;
  3271. end;
  3272. function TJclIntfIntfSortedMap.KeysCompare(const A, B: IInterface): Integer;
  3273. begin
  3274. Result := ItemsCompare(A, B);
  3275. end;
  3276. function TJclIntfIntfSortedMap.ValuesCompare(const A, B: IInterface): Integer;
  3277. begin
  3278. Result := ItemsCompare(A, B);
  3279. end;
  3280. //=== { TJclAnsiStrIntfSortedMap } ==============================================
  3281. constructor TJclAnsiStrIntfSortedMap.Create(ACapacity: Integer);
  3282. begin
  3283. inherited Create();
  3284. SetCapacity(ACapacity);
  3285. end;
  3286. destructor TJclAnsiStrIntfSortedMap.Destroy;
  3287. begin
  3288. FReadOnly := False;
  3289. Clear;
  3290. inherited Destroy;
  3291. end;
  3292. procedure TJclAnsiStrIntfSortedMap.AssignDataTo(Dest: TJclAbstractContainerBase);
  3293. var
  3294. MyDest: TJclAnsiStrIntfSortedMap;
  3295. begin
  3296. inherited AssignDataTo(Dest);
  3297. if Dest is TJclAnsiStrIntfSortedMap then
  3298. begin
  3299. MyDest := TJclAnsiStrIntfSortedMap(Dest);
  3300. MyDest.SetCapacity(FSize);
  3301. MyDest.FEntries := FEntries;
  3302. MyDest.FSize := FSize;
  3303. end;
  3304. end;
  3305. function TJclAnsiStrIntfSortedMap.BinarySearch(const Key: AnsiString): Integer;
  3306. var
  3307. HiPos, LoPos, CompPos: Integer;
  3308. Comp: Integer;
  3309. begin
  3310. {$IFDEF THREADSAFE}
  3311. if FThreadSafe then
  3312. SyncReaderWriter.BeginRead;
  3313. try
  3314. {$ENDIF THREADSAFE}
  3315. LoPos := 0;
  3316. HiPos := FSize - 1;
  3317. CompPos := (HiPos + LoPos) div 2;
  3318. while HiPos >= LoPos do
  3319. begin
  3320. Comp := KeysCompare(FEntries[CompPos].Key, Key);
  3321. if Comp < 0 then
  3322. LoPos := CompPos + 1
  3323. else
  3324. if Comp > 0 then
  3325. HiPos := CompPos - 1
  3326. else
  3327. begin
  3328. HiPos := CompPos;
  3329. LoPos := CompPos + 1;
  3330. end;
  3331. CompPos := (HiPos + LoPos) div 2;
  3332. end;
  3333. Result := HiPos;
  3334. {$IFDEF THREADSAFE}
  3335. finally
  3336. if FThreadSafe then
  3337. SyncReaderWriter.EndRead;
  3338. end;
  3339. {$ENDIF THREADSAFE}
  3340. end;
  3341. procedure TJclAnsiStrIntfSortedMap.Clear;
  3342. var
  3343. Index: Integer;
  3344. begin
  3345. if ReadOnly then
  3346. raise EJclReadOnlyError.Create;
  3347. {$IFDEF THREADSAFE}
  3348. if FThreadSafe then
  3349. SyncReaderWriter.BeginWrite;
  3350. try
  3351. {$ENDIF THREADSAFE}
  3352. for Index := 0 to FSize - 1 do
  3353. begin
  3354. FreeKey(FEntries[Index].Key);
  3355. FreeValue(FEntries[Index].Value);
  3356. end;
  3357. FSize := 0;
  3358. AutoPack;
  3359. {$IFDEF THREADSAFE}
  3360. finally
  3361. if FThreadSafe then
  3362. SyncReaderWriter.EndWrite;
  3363. end;
  3364. {$ENDIF THREADSAFE}
  3365. end;
  3366. function TJclAnsiStrIntfSortedMap.ContainsKey(const Key: AnsiString): Boolean;
  3367. var
  3368. Index: Integer;
  3369. begin
  3370. {$IFDEF THREADSAFE}
  3371. if FThreadSafe then
  3372. SyncReaderWriter.BeginRead;
  3373. try
  3374. {$ENDIF THREADSAFE}
  3375. Index := BinarySearch(Key);
  3376. Result := (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0);
  3377. {$IFDEF THREADSAFE}
  3378. finally
  3379. if FThreadSafe then
  3380. SyncReaderWriter.EndRead;
  3381. end;
  3382. {$ENDIF THREADSAFE}
  3383. end;
  3384. function TJclAnsiStrIntfSortedMap.ContainsValue(const Value: IInterface): Boolean;
  3385. var
  3386. Index: Integer;
  3387. begin
  3388. {$IFDEF THREADSAFE}
  3389. if FThreadSafe then
  3390. SyncReaderWriter.BeginRead;
  3391. try
  3392. {$ENDIF THREADSAFE}
  3393. Result := False;
  3394. for Index := 0 to FSize - 1 do
  3395. if ValuesCompare(FEntries[Index].Value, Value) = 0 then
  3396. begin
  3397. Result := True;
  3398. Break;
  3399. end;
  3400. {$IFDEF THREADSAFE}
  3401. finally
  3402. if FThreadSafe then
  3403. SyncReaderWriter.EndRead;
  3404. end;
  3405. {$ENDIF THREADSAFE}
  3406. end;
  3407. function TJclAnsiStrIntfSortedMap.FirstKey: AnsiString;
  3408. begin
  3409. {$IFDEF THREADSAFE}
  3410. if FThreadSafe then
  3411. SyncReaderWriter.BeginRead;
  3412. try
  3413. {$ENDIF THREADSAFE}
  3414. Result := '';
  3415. if FSize > 0 then
  3416. Result := FEntries[0].Key
  3417. else
  3418. if not FReturnDefaultElements then
  3419. raise EJclNoSuchElementError.Create('');
  3420. {$IFDEF THREADSAFE}
  3421. finally
  3422. if FThreadSafe then
  3423. SyncReaderWriter.EndRead;
  3424. end;
  3425. {$ENDIF THREADSAFE}
  3426. end;
  3427. function TJclAnsiStrIntfSortedMap.Extract(const Key: AnsiString): IInterface;
  3428. var
  3429. Index: Integer;
  3430. begin
  3431. if ReadOnly then
  3432. raise EJclReadOnlyError.Create;
  3433. {$IFDEF THREADSAFE}
  3434. if FThreadSafe then
  3435. SyncReaderWriter.BeginWrite;
  3436. try
  3437. {$ENDIF THREADSAFE}
  3438. Index := BinarySearch(Key);
  3439. if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then
  3440. begin
  3441. Result := FEntries[Index].Value;
  3442. FEntries[Index].Value := nil;
  3443. FreeKey(FEntries[Index].Key);
  3444. if Index < (FSize - 1) then
  3445. MoveArray(FEntries, Index + 1, Index, FSize - Index - 1);
  3446. Dec(FSize);
  3447. AutoPack;
  3448. end
  3449. else
  3450. Result := nil;
  3451. {$IFDEF THREADSAFE}
  3452. finally
  3453. if FThreadSafe then
  3454. SyncReaderWriter.EndWrite;
  3455. end;
  3456. {$ENDIF THREADSAFE}
  3457. end;
  3458. function TJclAnsiStrIntfSortedMap.GetValue(const Key: AnsiString): IInterface;
  3459. var
  3460. Index: Integer;
  3461. begin
  3462. {$IFDEF THREADSAFE}
  3463. if FThreadSafe then
  3464. SyncReaderWriter.BeginRead;
  3465. try
  3466. {$ENDIF THREADSAFE}
  3467. Index := BinarySearch(Key);
  3468. Result := nil;
  3469. if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then
  3470. Result := FEntries[Index].Value
  3471. else if not FReturnDefaultElements then
  3472. raise EJclNoSuchElementError.Create('');
  3473. {$IFDEF THREADSAFE}
  3474. finally
  3475. if FThreadSafe then
  3476. SyncReaderWriter.EndRead;
  3477. end;
  3478. {$ENDIF THREADSAFE}
  3479. end;
  3480. function TJclAnsiStrIntfSortedMap.HeadMap(const ToKey: AnsiString): IJclAnsiStrIntfSortedMap;
  3481. var
  3482. ToIndex: Integer;
  3483. NewMap: TJclAnsiStrIntfSortedMap;
  3484. begin
  3485. {$IFDEF THREADSAFE}
  3486. if FThreadSafe then
  3487. SyncReaderWriter.BeginRead;
  3488. try
  3489. {$ENDIF THREADSAFE}
  3490. NewMap := CreateEmptyContainer as TJclAnsiStrIntfSortedMap;
  3491. ToIndex := BinarySearch(ToKey);
  3492. if ToIndex >= 0 then
  3493. begin
  3494. NewMap.SetCapacity(ToIndex + 1);
  3495. NewMap.FSize := ToIndex + 1;
  3496. while ToIndex >= 0 do
  3497. begin
  3498. NewMap.FEntries[ToIndex] := FEntries[ToIndex];
  3499. Dec(ToIndex);
  3500. end;
  3501. end;
  3502. Result := NewMap;
  3503. {$IFDEF THREADSAFE}
  3504. finally
  3505. if FThreadSafe then
  3506. SyncReaderWriter.EndRead;
  3507. end;
  3508. {$ENDIF THREADSAFE}
  3509. end;
  3510. function TJclAnsiStrIntfSortedMap.IsEmpty: Boolean;
  3511. begin
  3512. {$IFDEF THREADSAFE}
  3513. if FThreadSafe then
  3514. SyncReaderWriter.BeginRead;
  3515. try
  3516. {$ENDIF THREADSAFE}
  3517. Result := FSize = 0;
  3518. {$IFDEF THREADSAFE}
  3519. finally
  3520. if FThreadSafe then
  3521. SyncReaderWriter.EndRead;
  3522. end;
  3523. {$ENDIF THREADSAFE}
  3524. end;
  3525. function TJclAnsiStrIntfSortedMap.KeyOfValue(const Value: IInterface): AnsiString;
  3526. var
  3527. Index: Integer;
  3528. Found: Boolean;
  3529. begin
  3530. {$IFDEF THREADSAFE}
  3531. if FThreadSafe then
  3532. SyncReaderWriter.BeginRead;
  3533. try
  3534. {$ENDIF THREADSAFE}
  3535. Found := False;
  3536. Result := '';
  3537. for Index := 0 to FSize - 1 do
  3538. if ValuesCompare(FEntries[Index].Value, Value) = 0 then
  3539. begin
  3540. Result := FEntries[Index].Key;
  3541. Found := True;
  3542. Break;
  3543. end;
  3544. if (not Found) and (not FReturnDefaultElements) then
  3545. raise EJclNoSuchElementError.Create('');
  3546. {$IFDEF THREADSAFE}
  3547. finally
  3548. if FThreadSafe then
  3549. SyncReaderWriter.EndRead;
  3550. end;
  3551. {$ENDIF THREADSAFE}
  3552. end;
  3553. function TJclAnsiStrIntfSortedMap.KeySet: IJclAnsiStrSet;
  3554. var
  3555. Index: Integer;
  3556. begin
  3557. {$IFDEF THREADSAFE}
  3558. if FThreadSafe then
  3559. SyncReaderWriter.BeginRead;
  3560. try
  3561. {$ENDIF THREADSAFE}
  3562. Result := TJclAnsiStrArraySet.Create(FSize);
  3563. for Index := 0 to FSize - 1 do
  3564. Result.Add(FEntries[Index].Key);
  3565. {$IFDEF THREADSAFE}
  3566. finally
  3567. if FThreadSafe then
  3568. SyncReaderWriter.EndRead;
  3569. end;
  3570. {$ENDIF THREADSAFE}
  3571. end;
  3572. function TJclAnsiStrIntfSortedMap.LastKey: AnsiString;
  3573. begin
  3574. {$IFDEF THREADSAFE}
  3575. if FThreadSafe then
  3576. SyncReaderWriter.BeginRead;
  3577. try
  3578. {$ENDIF THREADSAFE}
  3579. Result := '';
  3580. if FSize > 0 then
  3581. Result := FEntries[FSize - 1].Key
  3582. else
  3583. if not FReturnDefaultElements then
  3584. raise EJclNoSuchElementError.Create('');
  3585. {$IFDEF THREADSAFE}
  3586. finally
  3587. if FThreadSafe then
  3588. SyncReaderWriter.EndRead;
  3589. end;
  3590. {$ENDIF THREADSAFE}
  3591. end;
  3592. function TJclAnsiStrIntfSortedMap.MapEquals(const AMap: IJclAnsiStrIntfMap): Boolean;
  3593. var
  3594. It: IJclAnsiStrIterator;
  3595. Index: Integer;
  3596. AKey: AnsiString;
  3597. begin
  3598. {$IFDEF THREADSAFE}
  3599. if FThreadSafe then
  3600. SyncReaderWriter.BeginRead;
  3601. try
  3602. {$ENDIF THREADSAFE}
  3603. Result := False;
  3604. if AMap = nil then
  3605. Exit;
  3606. if FSize <> AMap.Size then
  3607. Exit;
  3608. It := AMap.KeySet.First;
  3609. Index := 0;
  3610. while It.HasNext do
  3611. begin
  3612. if Index >= FSize then
  3613. Exit;
  3614. AKey := It.Next;
  3615. if ValuesCompare(AMap.GetValue(AKey), FEntries[Index].Value) <> 0 then
  3616. Exit;
  3617. Inc(Index);
  3618. end;
  3619. Result := True;
  3620. {$IFDEF THREADSAFE}
  3621. finally
  3622. if FThreadSafe then
  3623. SyncReaderWriter.EndRead;
  3624. end;
  3625. {$ENDIF THREADSAFE}
  3626. end;
  3627. procedure TJclAnsiStrIntfSortedMap.FinalizeArrayBeforeMove(var List: TJclAnsiStrIntfSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  3628. begin
  3629. Assert(Count > 0);
  3630. if FromIndex < ToIndex then
  3631. begin
  3632. if Count > (ToIndex - FromIndex) then
  3633. Finalize(List[FromIndex + Count], ToIndex - FromIndex)
  3634. else
  3635. Finalize(List[ToIndex], Count);
  3636. end
  3637. else
  3638. if FromIndex > ToIndex then
  3639. begin
  3640. if Count > (FromIndex - ToIndex) then
  3641. Count := FromIndex - ToIndex;
  3642. Finalize(List[ToIndex], Count)
  3643. end;
  3644. end;
  3645. procedure TJclAnsiStrIntfSortedMap.InitializeArray(var List: TJclAnsiStrIntfSortedMapEntryArray; FromIndex, Count: SizeInt);
  3646. begin
  3647. {$IFDEF FPC}
  3648. while Count > 0 do
  3649. begin
  3650. Initialize(List[FromIndex]);
  3651. Inc(FromIndex);
  3652. Dec(Count);
  3653. end;
  3654. {$ELSE ~FPC}
  3655. Initialize(List[FromIndex], Count);
  3656. {$ENDIF ~FPC}
  3657. end;
  3658. procedure TJclAnsiStrIntfSortedMap.InitializeArrayAfterMove(var List: TJclAnsiStrIntfSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  3659. begin
  3660. { Keep reference counting working }
  3661. if FromIndex < ToIndex then
  3662. begin
  3663. if (ToIndex - FromIndex) < Count then
  3664. Count := ToIndex - FromIndex;
  3665. InitializeArray(List, FromIndex, Count);
  3666. end
  3667. else
  3668. if FromIndex > ToIndex then
  3669. begin
  3670. if (FromIndex - ToIndex) < Count then
  3671. InitializeArray(List, ToIndex + Count, FromIndex - ToIndex)
  3672. else
  3673. InitializeArray(List, FromIndex, Count);
  3674. end;
  3675. end;
  3676. procedure TJclAnsiStrIntfSortedMap.MoveArray(var List: TJclAnsiStrIntfSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  3677. begin
  3678. if Count > 0 then
  3679. begin
  3680. FinalizeArrayBeforeMove(List, FromIndex, ToIndex, Count);
  3681. Move(List[FromIndex], List[ToIndex], Count * SizeOf(List[0]));
  3682. InitializeArrayAfterMove(List, FromIndex, ToIndex, Count);
  3683. end;
  3684. end;
  3685. procedure TJclAnsiStrIntfSortedMap.PutAll(const AMap: IJclAnsiStrIntfMap);
  3686. var
  3687. It: IJclAnsiStrIterator;
  3688. Key: AnsiString;
  3689. begin
  3690. if ReadOnly then
  3691. raise EJclReadOnlyError.Create;
  3692. {$IFDEF THREADSAFE}
  3693. if FThreadSafe then
  3694. SyncReaderWriter.BeginWrite;
  3695. try
  3696. {$ENDIF THREADSAFE}
  3697. if AMap = nil then
  3698. Exit;
  3699. It := AMap.KeySet.First;
  3700. while It.HasNext do
  3701. begin
  3702. Key := It.Next;
  3703. PutValue(Key, AMap.GetValue(Key));
  3704. end;
  3705. {$IFDEF THREADSAFE}
  3706. finally
  3707. if FThreadSafe then
  3708. SyncReaderWriter.EndWrite;
  3709. end;
  3710. {$ENDIF THREADSAFE}
  3711. end;
  3712. procedure TJclAnsiStrIntfSortedMap.PutValue(const Key: AnsiString; const Value: IInterface);
  3713. var
  3714. Index: Integer;
  3715. begin
  3716. if ReadOnly then
  3717. raise EJclReadOnlyError.Create;
  3718. {$IFDEF THREADSAFE}
  3719. if FThreadSafe then
  3720. SyncReaderWriter.BeginWrite;
  3721. try
  3722. {$ENDIF THREADSAFE}
  3723. if FAllowDefaultElements or ((KeysCompare(Key, '') <> 0) and (ValuesCompare(Value, nil) <> 0)) then
  3724. begin
  3725. Index := BinarySearch(Key);
  3726. if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then
  3727. begin
  3728. FreeValue(FEntries[Index].Value);
  3729. FEntries[Index].Value := Value;
  3730. end
  3731. else
  3732. begin
  3733. if FSize = FCapacity then
  3734. AutoGrow;
  3735. if FSize < FCapacity then
  3736. begin
  3737. Inc(Index);
  3738. if (Index < FSize) and (KeysCompare(FEntries[Index].Key, Key) <> 0) then
  3739. MoveArray(FEntries, Index, Index + 1, FSize - Index);
  3740. FEntries[Index].Key := Key;
  3741. FEntries[Index].Value := Value;
  3742. Inc(FSize);
  3743. end;
  3744. end;
  3745. end;
  3746. {$IFDEF THREADSAFE}
  3747. finally
  3748. if FThreadSafe then
  3749. SyncReaderWriter.EndWrite;
  3750. end;
  3751. {$ENDIF THREADSAFE}
  3752. end;
  3753. function TJclAnsiStrIntfSortedMap.Remove(const Key: AnsiString): IInterface;
  3754. begin
  3755. if ReadOnly then
  3756. raise EJclReadOnlyError.Create;
  3757. {$IFDEF THREADSAFE}
  3758. if FThreadSafe then
  3759. SyncReaderWriter.BeginWrite;
  3760. try
  3761. {$ENDIF THREADSAFE}
  3762. Result := Extract(Key);
  3763. Result := FreeValue(Result);
  3764. {$IFDEF THREADSAFE}
  3765. finally
  3766. if FThreadSafe then
  3767. SyncReaderWriter.EndWrite;
  3768. end;
  3769. {$ENDIF THREADSAFE}
  3770. end;
  3771. procedure TJclAnsiStrIntfSortedMap.SetCapacity(Value: Integer);
  3772. begin
  3773. if ReadOnly then
  3774. raise EJclReadOnlyError.Create;
  3775. {$IFDEF THREADSAFE}
  3776. if FThreadSafe then
  3777. SyncReaderWriter.BeginWrite;
  3778. try
  3779. {$ENDIF THREADSAFE}
  3780. if FSize <= Value then
  3781. begin
  3782. SetLength(FEntries, Value);
  3783. inherited SetCapacity(Value);
  3784. end
  3785. else
  3786. raise EJclOperationNotSupportedError.Create;
  3787. {$IFDEF THREADSAFE}
  3788. finally
  3789. if FThreadSafe then
  3790. SyncReaderWriter.EndWrite;
  3791. end;
  3792. {$ENDIF THREADSAFE}
  3793. end;
  3794. function TJclAnsiStrIntfSortedMap.Size: Integer;
  3795. begin
  3796. Result := FSize;
  3797. end;
  3798. function TJclAnsiStrIntfSortedMap.SubMap(const FromKey, ToKey: AnsiString): IJclAnsiStrIntfSortedMap;
  3799. var
  3800. FromIndex, ToIndex: Integer;
  3801. NewMap: TJclAnsiStrIntfSortedMap;
  3802. begin
  3803. {$IFDEF THREADSAFE}
  3804. if FThreadSafe then
  3805. SyncReaderWriter.BeginRead;
  3806. try
  3807. {$ENDIF THREADSAFE}
  3808. NewMap := CreateEmptyContainer as TJclAnsiStrIntfSortedMap;
  3809. FromIndex := BinarySearch(FromKey);
  3810. if (FromIndex = -1) or (KeysCompare(FEntries[FromIndex].Key, FromKey) < 0) then
  3811. Inc(FromIndex);
  3812. ToIndex := BinarySearch(ToKey);
  3813. if (FromIndex >= 0) and (FromIndex <= ToIndex) then
  3814. begin
  3815. NewMap.SetCapacity(ToIndex - FromIndex + 1);
  3816. NewMap.FSize := ToIndex - FromIndex + 1;
  3817. while ToIndex >= FromIndex do
  3818. begin
  3819. NewMap.FEntries[ToIndex - FromIndex] := FEntries[ToIndex];
  3820. Dec(ToIndex);
  3821. end;
  3822. end;
  3823. Result := NewMap;
  3824. {$IFDEF THREADSAFE}
  3825. finally
  3826. if FThreadSafe then
  3827. SyncReaderWriter.EndRead;
  3828. end;
  3829. {$ENDIF THREADSAFE}
  3830. end;
  3831. function TJclAnsiStrIntfSortedMap.TailMap(const FromKey: AnsiString): IJclAnsiStrIntfSortedMap;
  3832. var
  3833. FromIndex, Index: Integer;
  3834. NewMap: TJclAnsiStrIntfSortedMap;
  3835. begin
  3836. {$IFDEF THREADSAFE}
  3837. if FThreadSafe then
  3838. SyncReaderWriter.BeginRead;
  3839. try
  3840. {$ENDIF THREADSAFE}
  3841. NewMap := CreateEmptyContainer as TJclAnsiStrIntfSortedMap;
  3842. FromIndex := BinarySearch(FromKey);
  3843. if (FromIndex = -1) or (KeysCompare(FEntries[FromIndex].Key, FromKey) < 0) then
  3844. Inc(FromIndex);
  3845. if (FromIndex >= 0) and (FromIndex < FSize) then
  3846. begin
  3847. NewMap.SetCapacity(FSize - FromIndex);
  3848. NewMap.FSize := FSize - FromIndex;
  3849. Index := FromIndex;
  3850. while Index < FSize do
  3851. begin
  3852. NewMap.FEntries[Index - FromIndex] := FEntries[Index];
  3853. Inc(Index);
  3854. end;
  3855. end;
  3856. Result := NewMap;
  3857. {$IFDEF THREADSAFE}
  3858. finally
  3859. if FThreadSafe then
  3860. SyncReaderWriter.EndRead;
  3861. end;
  3862. {$ENDIF THREADSAFE}
  3863. end;
  3864. function TJclAnsiStrIntfSortedMap.Values: IJclIntfCollection;
  3865. var
  3866. Index: Integer;
  3867. begin
  3868. {$IFDEF THREADSAFE}
  3869. if FThreadSafe then
  3870. SyncReaderWriter.BeginRead;
  3871. try
  3872. {$ENDIF THREADSAFE}
  3873. Result := TJclIntfArrayList.Create(FSize);
  3874. for Index := 0 to FSize - 1 do
  3875. Result.Add(FEntries[Index].Value);
  3876. {$IFDEF THREADSAFE}
  3877. finally
  3878. if FThreadSafe then
  3879. SyncReaderWriter.EndRead;
  3880. end;
  3881. {$ENDIF THREADSAFE}
  3882. end;
  3883. function TJclAnsiStrIntfSortedMap.CreateEmptyContainer: TJclAbstractContainerBase;
  3884. begin
  3885. Result := TJclAnsiStrIntfSortedMap.Create(FSize);
  3886. AssignPropertiesTo(Result);
  3887. end;
  3888. function TJclAnsiStrIntfSortedMap.FreeKey(var Key: AnsiString): AnsiString;
  3889. begin
  3890. Result := Key;
  3891. Key := '';
  3892. end;
  3893. function TJclAnsiStrIntfSortedMap.FreeValue(var Value: IInterface): IInterface;
  3894. begin
  3895. Result := Value;
  3896. Value := nil;
  3897. end;
  3898. function TJclAnsiStrIntfSortedMap.KeysCompare(const A, B: AnsiString): Integer;
  3899. begin
  3900. Result := ItemsCompare(A, B);
  3901. end;
  3902. function TJclAnsiStrIntfSortedMap.ValuesCompare(const A, B: IInterface): Integer;
  3903. begin
  3904. Result := IntfSimpleCompare(A, B);
  3905. end;
  3906. //=== { TJclIntfAnsiStrSortedMap } ==============================================
  3907. constructor TJclIntfAnsiStrSortedMap.Create(ACapacity: Integer);
  3908. begin
  3909. inherited Create();
  3910. SetCapacity(ACapacity);
  3911. end;
  3912. destructor TJclIntfAnsiStrSortedMap.Destroy;
  3913. begin
  3914. FReadOnly := False;
  3915. Clear;
  3916. inherited Destroy;
  3917. end;
  3918. procedure TJclIntfAnsiStrSortedMap.AssignDataTo(Dest: TJclAbstractContainerBase);
  3919. var
  3920. MyDest: TJclIntfAnsiStrSortedMap;
  3921. begin
  3922. inherited AssignDataTo(Dest);
  3923. if Dest is TJclIntfAnsiStrSortedMap then
  3924. begin
  3925. MyDest := TJclIntfAnsiStrSortedMap(Dest);
  3926. MyDest.SetCapacity(FSize);
  3927. MyDest.FEntries := FEntries;
  3928. MyDest.FSize := FSize;
  3929. end;
  3930. end;
  3931. function TJclIntfAnsiStrSortedMap.BinarySearch(const Key: IInterface): Integer;
  3932. var
  3933. HiPos, LoPos, CompPos: Integer;
  3934. Comp: Integer;
  3935. begin
  3936. {$IFDEF THREADSAFE}
  3937. if FThreadSafe then
  3938. SyncReaderWriter.BeginRead;
  3939. try
  3940. {$ENDIF THREADSAFE}
  3941. LoPos := 0;
  3942. HiPos := FSize - 1;
  3943. CompPos := (HiPos + LoPos) div 2;
  3944. while HiPos >= LoPos do
  3945. begin
  3946. Comp := KeysCompare(FEntries[CompPos].Key, Key);
  3947. if Comp < 0 then
  3948. LoPos := CompPos + 1
  3949. else
  3950. if Comp > 0 then
  3951. HiPos := CompPos - 1
  3952. else
  3953. begin
  3954. HiPos := CompPos;
  3955. LoPos := CompPos + 1;
  3956. end;
  3957. CompPos := (HiPos + LoPos) div 2;
  3958. end;
  3959. Result := HiPos;
  3960. {$IFDEF THREADSAFE}
  3961. finally
  3962. if FThreadSafe then
  3963. SyncReaderWriter.EndRead;
  3964. end;
  3965. {$ENDIF THREADSAFE}
  3966. end;
  3967. procedure TJclIntfAnsiStrSortedMap.Clear;
  3968. var
  3969. Index: Integer;
  3970. begin
  3971. if ReadOnly then
  3972. raise EJclReadOnlyError.Create;
  3973. {$IFDEF THREADSAFE}
  3974. if FThreadSafe then
  3975. SyncReaderWriter.BeginWrite;
  3976. try
  3977. {$ENDIF THREADSAFE}
  3978. for Index := 0 to FSize - 1 do
  3979. begin
  3980. FreeKey(FEntries[Index].Key);
  3981. FreeValue(FEntries[Index].Value);
  3982. end;
  3983. FSize := 0;
  3984. AutoPack;
  3985. {$IFDEF THREADSAFE}
  3986. finally
  3987. if FThreadSafe then
  3988. SyncReaderWriter.EndWrite;
  3989. end;
  3990. {$ENDIF THREADSAFE}
  3991. end;
  3992. function TJclIntfAnsiStrSortedMap.ContainsKey(const Key: IInterface): Boolean;
  3993. var
  3994. Index: Integer;
  3995. begin
  3996. {$IFDEF THREADSAFE}
  3997. if FThreadSafe then
  3998. SyncReaderWriter.BeginRead;
  3999. try
  4000. {$ENDIF THREADSAFE}
  4001. Index := BinarySearch(Key);
  4002. Result := (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0);
  4003. {$IFDEF THREADSAFE}
  4004. finally
  4005. if FThreadSafe then
  4006. SyncReaderWriter.EndRead;
  4007. end;
  4008. {$ENDIF THREADSAFE}
  4009. end;
  4010. function TJclIntfAnsiStrSortedMap.ContainsValue(const Value: AnsiString): Boolean;
  4011. var
  4012. Index: Integer;
  4013. begin
  4014. {$IFDEF THREADSAFE}
  4015. if FThreadSafe then
  4016. SyncReaderWriter.BeginRead;
  4017. try
  4018. {$ENDIF THREADSAFE}
  4019. Result := False;
  4020. for Index := 0 to FSize - 1 do
  4021. if ValuesCompare(FEntries[Index].Value, Value) = 0 then
  4022. begin
  4023. Result := True;
  4024. Break;
  4025. end;
  4026. {$IFDEF THREADSAFE}
  4027. finally
  4028. if FThreadSafe then
  4029. SyncReaderWriter.EndRead;
  4030. end;
  4031. {$ENDIF THREADSAFE}
  4032. end;
  4033. function TJclIntfAnsiStrSortedMap.FirstKey: IInterface;
  4034. begin
  4035. {$IFDEF THREADSAFE}
  4036. if FThreadSafe then
  4037. SyncReaderWriter.BeginRead;
  4038. try
  4039. {$ENDIF THREADSAFE}
  4040. Result := nil;
  4041. if FSize > 0 then
  4042. Result := FEntries[0].Key
  4043. else
  4044. if not FReturnDefaultElements then
  4045. raise EJclNoSuchElementError.Create('');
  4046. {$IFDEF THREADSAFE}
  4047. finally
  4048. if FThreadSafe then
  4049. SyncReaderWriter.EndRead;
  4050. end;
  4051. {$ENDIF THREADSAFE}
  4052. end;
  4053. function TJclIntfAnsiStrSortedMap.Extract(const Key: IInterface): AnsiString;
  4054. var
  4055. Index: Integer;
  4056. begin
  4057. if ReadOnly then
  4058. raise EJclReadOnlyError.Create;
  4059. {$IFDEF THREADSAFE}
  4060. if FThreadSafe then
  4061. SyncReaderWriter.BeginWrite;
  4062. try
  4063. {$ENDIF THREADSAFE}
  4064. Index := BinarySearch(Key);
  4065. if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then
  4066. begin
  4067. Result := FEntries[Index].Value;
  4068. FEntries[Index].Value := '';
  4069. FreeKey(FEntries[Index].Key);
  4070. if Index < (FSize - 1) then
  4071. MoveArray(FEntries, Index + 1, Index, FSize - Index - 1);
  4072. Dec(FSize);
  4073. AutoPack;
  4074. end
  4075. else
  4076. Result := '';
  4077. {$IFDEF THREADSAFE}
  4078. finally
  4079. if FThreadSafe then
  4080. SyncReaderWriter.EndWrite;
  4081. end;
  4082. {$ENDIF THREADSAFE}
  4083. end;
  4084. function TJclIntfAnsiStrSortedMap.GetValue(const Key: IInterface): AnsiString;
  4085. var
  4086. Index: Integer;
  4087. begin
  4088. {$IFDEF THREADSAFE}
  4089. if FThreadSafe then
  4090. SyncReaderWriter.BeginRead;
  4091. try
  4092. {$ENDIF THREADSAFE}
  4093. Index := BinarySearch(Key);
  4094. Result := '';
  4095. if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then
  4096. Result := FEntries[Index].Value
  4097. else if not FReturnDefaultElements then
  4098. raise EJclNoSuchElementError.Create('');
  4099. {$IFDEF THREADSAFE}
  4100. finally
  4101. if FThreadSafe then
  4102. SyncReaderWriter.EndRead;
  4103. end;
  4104. {$ENDIF THREADSAFE}
  4105. end;
  4106. function TJclIntfAnsiStrSortedMap.HeadMap(const ToKey: IInterface): IJclIntfAnsiStrSortedMap;
  4107. var
  4108. ToIndex: Integer;
  4109. NewMap: TJclIntfAnsiStrSortedMap;
  4110. begin
  4111. {$IFDEF THREADSAFE}
  4112. if FThreadSafe then
  4113. SyncReaderWriter.BeginRead;
  4114. try
  4115. {$ENDIF THREADSAFE}
  4116. NewMap := CreateEmptyContainer as TJclIntfAnsiStrSortedMap;
  4117. ToIndex := BinarySearch(ToKey);
  4118. if ToIndex >= 0 then
  4119. begin
  4120. NewMap.SetCapacity(ToIndex + 1);
  4121. NewMap.FSize := ToIndex + 1;
  4122. while ToIndex >= 0 do
  4123. begin
  4124. NewMap.FEntries[ToIndex] := FEntries[ToIndex];
  4125. Dec(ToIndex);
  4126. end;
  4127. end;
  4128. Result := NewMap;
  4129. {$IFDEF THREADSAFE}
  4130. finally
  4131. if FThreadSafe then
  4132. SyncReaderWriter.EndRead;
  4133. end;
  4134. {$ENDIF THREADSAFE}
  4135. end;
  4136. function TJclIntfAnsiStrSortedMap.IsEmpty: Boolean;
  4137. begin
  4138. {$IFDEF THREADSAFE}
  4139. if FThreadSafe then
  4140. SyncReaderWriter.BeginRead;
  4141. try
  4142. {$ENDIF THREADSAFE}
  4143. Result := FSize = 0;
  4144. {$IFDEF THREADSAFE}
  4145. finally
  4146. if FThreadSafe then
  4147. SyncReaderWriter.EndRead;
  4148. end;
  4149. {$ENDIF THREADSAFE}
  4150. end;
  4151. function TJclIntfAnsiStrSortedMap.KeyOfValue(const Value: AnsiString): IInterface;
  4152. var
  4153. Index: Integer;
  4154. Found: Boolean;
  4155. begin
  4156. {$IFDEF THREADSAFE}
  4157. if FThreadSafe then
  4158. SyncReaderWriter.BeginRead;
  4159. try
  4160. {$ENDIF THREADSAFE}
  4161. Found := False;
  4162. Result := nil;
  4163. for Index := 0 to FSize - 1 do
  4164. if ValuesCompare(FEntries[Index].Value, Value) = 0 then
  4165. begin
  4166. Result := FEntries[Index].Key;
  4167. Found := True;
  4168. Break;
  4169. end;
  4170. if (not Found) and (not FReturnDefaultElements) then
  4171. raise EJclNoSuchElementError.Create('');
  4172. {$IFDEF THREADSAFE}
  4173. finally
  4174. if FThreadSafe then
  4175. SyncReaderWriter.EndRead;
  4176. end;
  4177. {$ENDIF THREADSAFE}
  4178. end;
  4179. function TJclIntfAnsiStrSortedMap.KeySet: IJclIntfSet;
  4180. var
  4181. Index: Integer;
  4182. begin
  4183. {$IFDEF THREADSAFE}
  4184. if FThreadSafe then
  4185. SyncReaderWriter.BeginRead;
  4186. try
  4187. {$ENDIF THREADSAFE}
  4188. Result := TJclIntfArraySet.Create(FSize);
  4189. for Index := 0 to FSize - 1 do
  4190. Result.Add(FEntries[Index].Key);
  4191. {$IFDEF THREADSAFE}
  4192. finally
  4193. if FThreadSafe then
  4194. SyncReaderWriter.EndRead;
  4195. end;
  4196. {$ENDIF THREADSAFE}
  4197. end;
  4198. function TJclIntfAnsiStrSortedMap.LastKey: IInterface;
  4199. begin
  4200. {$IFDEF THREADSAFE}
  4201. if FThreadSafe then
  4202. SyncReaderWriter.BeginRead;
  4203. try
  4204. {$ENDIF THREADSAFE}
  4205. Result := nil;
  4206. if FSize > 0 then
  4207. Result := FEntries[FSize - 1].Key
  4208. else
  4209. if not FReturnDefaultElements then
  4210. raise EJclNoSuchElementError.Create('');
  4211. {$IFDEF THREADSAFE}
  4212. finally
  4213. if FThreadSafe then
  4214. SyncReaderWriter.EndRead;
  4215. end;
  4216. {$ENDIF THREADSAFE}
  4217. end;
  4218. function TJclIntfAnsiStrSortedMap.MapEquals(const AMap: IJclIntfAnsiStrMap): Boolean;
  4219. var
  4220. It: IJclIntfIterator;
  4221. Index: Integer;
  4222. AKey: IInterface;
  4223. begin
  4224. {$IFDEF THREADSAFE}
  4225. if FThreadSafe then
  4226. SyncReaderWriter.BeginRead;
  4227. try
  4228. {$ENDIF THREADSAFE}
  4229. Result := False;
  4230. if AMap = nil then
  4231. Exit;
  4232. if FSize <> AMap.Size then
  4233. Exit;
  4234. It := AMap.KeySet.First;
  4235. Index := 0;
  4236. while It.HasNext do
  4237. begin
  4238. if Index >= FSize then
  4239. Exit;
  4240. AKey := It.Next;
  4241. if ValuesCompare(AMap.GetValue(AKey), FEntries[Index].Value) <> 0 then
  4242. Exit;
  4243. Inc(Index);
  4244. end;
  4245. Result := True;
  4246. {$IFDEF THREADSAFE}
  4247. finally
  4248. if FThreadSafe then
  4249. SyncReaderWriter.EndRead;
  4250. end;
  4251. {$ENDIF THREADSAFE}
  4252. end;
  4253. procedure TJclIntfAnsiStrSortedMap.FinalizeArrayBeforeMove(var List: TJclIntfAnsiStrSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  4254. begin
  4255. Assert(Count > 0);
  4256. if FromIndex < ToIndex then
  4257. begin
  4258. if Count > (ToIndex - FromIndex) then
  4259. Finalize(List[FromIndex + Count], ToIndex - FromIndex)
  4260. else
  4261. Finalize(List[ToIndex], Count);
  4262. end
  4263. else
  4264. if FromIndex > ToIndex then
  4265. begin
  4266. if Count > (FromIndex - ToIndex) then
  4267. Count := FromIndex - ToIndex;
  4268. Finalize(List[ToIndex], Count)
  4269. end;
  4270. end;
  4271. procedure TJclIntfAnsiStrSortedMap.InitializeArray(var List: TJclIntfAnsiStrSortedMapEntryArray; FromIndex, Count: SizeInt);
  4272. begin
  4273. {$IFDEF FPC}
  4274. while Count > 0 do
  4275. begin
  4276. Initialize(List[FromIndex]);
  4277. Inc(FromIndex);
  4278. Dec(Count);
  4279. end;
  4280. {$ELSE ~FPC}
  4281. Initialize(List[FromIndex], Count);
  4282. {$ENDIF ~FPC}
  4283. end;
  4284. procedure TJclIntfAnsiStrSortedMap.InitializeArrayAfterMove(var List: TJclIntfAnsiStrSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  4285. begin
  4286. { Keep reference counting working }
  4287. if FromIndex < ToIndex then
  4288. begin
  4289. if (ToIndex - FromIndex) < Count then
  4290. Count := ToIndex - FromIndex;
  4291. InitializeArray(List, FromIndex, Count);
  4292. end
  4293. else
  4294. if FromIndex > ToIndex then
  4295. begin
  4296. if (FromIndex - ToIndex) < Count then
  4297. InitializeArray(List, ToIndex + Count, FromIndex - ToIndex)
  4298. else
  4299. InitializeArray(List, FromIndex, Count);
  4300. end;
  4301. end;
  4302. procedure TJclIntfAnsiStrSortedMap.MoveArray(var List: TJclIntfAnsiStrSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  4303. begin
  4304. if Count > 0 then
  4305. begin
  4306. FinalizeArrayBeforeMove(List, FromIndex, ToIndex, Count);
  4307. Move(List[FromIndex], List[ToIndex], Count * SizeOf(List[0]));
  4308. InitializeArrayAfterMove(List, FromIndex, ToIndex, Count);
  4309. end;
  4310. end;
  4311. procedure TJclIntfAnsiStrSortedMap.PutAll(const AMap: IJclIntfAnsiStrMap);
  4312. var
  4313. It: IJclIntfIterator;
  4314. Key: IInterface;
  4315. begin
  4316. if ReadOnly then
  4317. raise EJclReadOnlyError.Create;
  4318. {$IFDEF THREADSAFE}
  4319. if FThreadSafe then
  4320. SyncReaderWriter.BeginWrite;
  4321. try
  4322. {$ENDIF THREADSAFE}
  4323. if AMap = nil then
  4324. Exit;
  4325. It := AMap.KeySet.First;
  4326. while It.HasNext do
  4327. begin
  4328. Key := It.Next;
  4329. PutValue(Key, AMap.GetValue(Key));
  4330. end;
  4331. {$IFDEF THREADSAFE}
  4332. finally
  4333. if FThreadSafe then
  4334. SyncReaderWriter.EndWrite;
  4335. end;
  4336. {$ENDIF THREADSAFE}
  4337. end;
  4338. procedure TJclIntfAnsiStrSortedMap.PutValue(const Key: IInterface; const Value: AnsiString);
  4339. var
  4340. Index: Integer;
  4341. begin
  4342. if ReadOnly then
  4343. raise EJclReadOnlyError.Create;
  4344. {$IFDEF THREADSAFE}
  4345. if FThreadSafe then
  4346. SyncReaderWriter.BeginWrite;
  4347. try
  4348. {$ENDIF THREADSAFE}
  4349. if FAllowDefaultElements or ((KeysCompare(Key, nil) <> 0) and (ValuesCompare(Value, '') <> 0)) then
  4350. begin
  4351. Index := BinarySearch(Key);
  4352. if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then
  4353. begin
  4354. FreeValue(FEntries[Index].Value);
  4355. FEntries[Index].Value := Value;
  4356. end
  4357. else
  4358. begin
  4359. if FSize = FCapacity then
  4360. AutoGrow;
  4361. if FSize < FCapacity then
  4362. begin
  4363. Inc(Index);
  4364. if (Index < FSize) and (KeysCompare(FEntries[Index].Key, Key) <> 0) then
  4365. MoveArray(FEntries, Index, Index + 1, FSize - Index);
  4366. FEntries[Index].Key := Key;
  4367. FEntries[Index].Value := Value;
  4368. Inc(FSize);
  4369. end;
  4370. end;
  4371. end;
  4372. {$IFDEF THREADSAFE}
  4373. finally
  4374. if FThreadSafe then
  4375. SyncReaderWriter.EndWrite;
  4376. end;
  4377. {$ENDIF THREADSAFE}
  4378. end;
  4379. function TJclIntfAnsiStrSortedMap.Remove(const Key: IInterface): AnsiString;
  4380. begin
  4381. if ReadOnly then
  4382. raise EJclReadOnlyError.Create;
  4383. {$IFDEF THREADSAFE}
  4384. if FThreadSafe then
  4385. SyncReaderWriter.BeginWrite;
  4386. try
  4387. {$ENDIF THREADSAFE}
  4388. Result := Extract(Key);
  4389. Result := FreeValue(Result);
  4390. {$IFDEF THREADSAFE}
  4391. finally
  4392. if FThreadSafe then
  4393. SyncReaderWriter.EndWrite;
  4394. end;
  4395. {$ENDIF THREADSAFE}
  4396. end;
  4397. procedure TJclIntfAnsiStrSortedMap.SetCapacity(Value: Integer);
  4398. begin
  4399. if ReadOnly then
  4400. raise EJclReadOnlyError.Create;
  4401. {$IFDEF THREADSAFE}
  4402. if FThreadSafe then
  4403. SyncReaderWriter.BeginWrite;
  4404. try
  4405. {$ENDIF THREADSAFE}
  4406. if FSize <= Value then
  4407. begin
  4408. SetLength(FEntries, Value);
  4409. inherited SetCapacity(Value);
  4410. end
  4411. else
  4412. raise EJclOperationNotSupportedError.Create;
  4413. {$IFDEF THREADSAFE}
  4414. finally
  4415. if FThreadSafe then
  4416. SyncReaderWriter.EndWrite;
  4417. end;
  4418. {$ENDIF THREADSAFE}
  4419. end;
  4420. function TJclIntfAnsiStrSortedMap.Size: Integer;
  4421. begin
  4422. Result := FSize;
  4423. end;
  4424. function TJclIntfAnsiStrSortedMap.SubMap(const FromKey, ToKey: IInterface): IJclIntfAnsiStrSortedMap;
  4425. var
  4426. FromIndex, ToIndex: Integer;
  4427. NewMap: TJclIntfAnsiStrSortedMap;
  4428. begin
  4429. {$IFDEF THREADSAFE}
  4430. if FThreadSafe then
  4431. SyncReaderWriter.BeginRead;
  4432. try
  4433. {$ENDIF THREADSAFE}
  4434. NewMap := CreateEmptyContainer as TJclIntfAnsiStrSortedMap;
  4435. FromIndex := BinarySearch(FromKey);
  4436. if (FromIndex = -1) or (KeysCompare(FEntries[FromIndex].Key, FromKey) < 0) then
  4437. Inc(FromIndex);
  4438. ToIndex := BinarySearch(ToKey);
  4439. if (FromIndex >= 0) and (FromIndex <= ToIndex) then
  4440. begin
  4441. NewMap.SetCapacity(ToIndex - FromIndex + 1);
  4442. NewMap.FSize := ToIndex - FromIndex + 1;
  4443. while ToIndex >= FromIndex do
  4444. begin
  4445. NewMap.FEntries[ToIndex - FromIndex] := FEntries[ToIndex];
  4446. Dec(ToIndex);
  4447. end;
  4448. end;
  4449. Result := NewMap;
  4450. {$IFDEF THREADSAFE}
  4451. finally
  4452. if FThreadSafe then
  4453. SyncReaderWriter.EndRead;
  4454. end;
  4455. {$ENDIF THREADSAFE}
  4456. end;
  4457. function TJclIntfAnsiStrSortedMap.TailMap(const FromKey: IInterface): IJclIntfAnsiStrSortedMap;
  4458. var
  4459. FromIndex, Index: Integer;
  4460. NewMap: TJclIntfAnsiStrSortedMap;
  4461. begin
  4462. {$IFDEF THREADSAFE}
  4463. if FThreadSafe then
  4464. SyncReaderWriter.BeginRead;
  4465. try
  4466. {$ENDIF THREADSAFE}
  4467. NewMap := CreateEmptyContainer as TJclIntfAnsiStrSortedMap;
  4468. FromIndex := BinarySearch(FromKey);
  4469. if (FromIndex = -1) or (KeysCompare(FEntries[FromIndex].Key, FromKey) < 0) then
  4470. Inc(FromIndex);
  4471. if (FromIndex >= 0) and (FromIndex < FSize) then
  4472. begin
  4473. NewMap.SetCapacity(FSize - FromIndex);
  4474. NewMap.FSize := FSize - FromIndex;
  4475. Index := FromIndex;
  4476. while Index < FSize do
  4477. begin
  4478. NewMap.FEntries[Index - FromIndex] := FEntries[Index];
  4479. Inc(Index);
  4480. end;
  4481. end;
  4482. Result := NewMap;
  4483. {$IFDEF THREADSAFE}
  4484. finally
  4485. if FThreadSafe then
  4486. SyncReaderWriter.EndRead;
  4487. end;
  4488. {$ENDIF THREADSAFE}
  4489. end;
  4490. function TJclIntfAnsiStrSortedMap.Values: IJclAnsiStrCollection;
  4491. var
  4492. Index: Integer;
  4493. begin
  4494. {$IFDEF THREADSAFE}
  4495. if FThreadSafe then
  4496. SyncReaderWriter.BeginRead;
  4497. try
  4498. {$ENDIF THREADSAFE}
  4499. Result := TJclAnsiStrArrayList.Create(FSize);
  4500. for Index := 0 to FSize - 1 do
  4501. Result.Add(FEntries[Index].Value);
  4502. {$IFDEF THREADSAFE}
  4503. finally
  4504. if FThreadSafe then
  4505. SyncReaderWriter.EndRead;
  4506. end;
  4507. {$ENDIF THREADSAFE}
  4508. end;
  4509. function TJclIntfAnsiStrSortedMap.CreateEmptyContainer: TJclAbstractContainerBase;
  4510. begin
  4511. Result := TJclIntfAnsiStrSortedMap.Create(FSize);
  4512. AssignPropertiesTo(Result);
  4513. end;
  4514. function TJclIntfAnsiStrSortedMap.FreeKey(var Key: IInterface): IInterface;
  4515. begin
  4516. Result := Key;
  4517. Key := nil;
  4518. end;
  4519. function TJclIntfAnsiStrSortedMap.FreeValue(var Value: AnsiString): AnsiString;
  4520. begin
  4521. Result := Value;
  4522. Value := '';
  4523. end;
  4524. function TJclIntfAnsiStrSortedMap.KeysCompare(const A, B: IInterface): Integer;
  4525. begin
  4526. Result := IntfSimpleCompare(A, B);
  4527. end;
  4528. function TJclIntfAnsiStrSortedMap.ValuesCompare(const A, B: AnsiString): Integer;
  4529. begin
  4530. Result := ItemsCompare(A, B);
  4531. end;
  4532. //=== { TJclAnsiStrAnsiStrSortedMap } ==============================================
  4533. constructor TJclAnsiStrAnsiStrSortedMap.Create(ACapacity: Integer);
  4534. begin
  4535. inherited Create();
  4536. SetCapacity(ACapacity);
  4537. end;
  4538. destructor TJclAnsiStrAnsiStrSortedMap.Destroy;
  4539. begin
  4540. FReadOnly := False;
  4541. Clear;
  4542. inherited Destroy;
  4543. end;
  4544. procedure TJclAnsiStrAnsiStrSortedMap.AssignDataTo(Dest: TJclAbstractContainerBase);
  4545. var
  4546. MyDest: TJclAnsiStrAnsiStrSortedMap;
  4547. begin
  4548. inherited AssignDataTo(Dest);
  4549. if Dest is TJclAnsiStrAnsiStrSortedMap then
  4550. begin
  4551. MyDest := TJclAnsiStrAnsiStrSortedMap(Dest);
  4552. MyDest.SetCapacity(FSize);
  4553. MyDest.FEntries := FEntries;
  4554. MyDest.FSize := FSize;
  4555. end;
  4556. end;
  4557. function TJclAnsiStrAnsiStrSortedMap.BinarySearch(const Key: AnsiString): Integer;
  4558. var
  4559. HiPos, LoPos, CompPos: Integer;
  4560. Comp: Integer;
  4561. begin
  4562. {$IFDEF THREADSAFE}
  4563. if FThreadSafe then
  4564. SyncReaderWriter.BeginRead;
  4565. try
  4566. {$ENDIF THREADSAFE}
  4567. LoPos := 0;
  4568. HiPos := FSize - 1;
  4569. CompPos := (HiPos + LoPos) div 2;
  4570. while HiPos >= LoPos do
  4571. begin
  4572. Comp := KeysCompare(FEntries[CompPos].Key, Key);
  4573. if Comp < 0 then
  4574. LoPos := CompPos + 1
  4575. else
  4576. if Comp > 0 then
  4577. HiPos := CompPos - 1
  4578. else
  4579. begin
  4580. HiPos := CompPos;
  4581. LoPos := CompPos + 1;
  4582. end;
  4583. CompPos := (HiPos + LoPos) div 2;
  4584. end;
  4585. Result := HiPos;
  4586. {$IFDEF THREADSAFE}
  4587. finally
  4588. if FThreadSafe then
  4589. SyncReaderWriter.EndRead;
  4590. end;
  4591. {$ENDIF THREADSAFE}
  4592. end;
  4593. procedure TJclAnsiStrAnsiStrSortedMap.Clear;
  4594. var
  4595. Index: Integer;
  4596. begin
  4597. if ReadOnly then
  4598. raise EJclReadOnlyError.Create;
  4599. {$IFDEF THREADSAFE}
  4600. if FThreadSafe then
  4601. SyncReaderWriter.BeginWrite;
  4602. try
  4603. {$ENDIF THREADSAFE}
  4604. for Index := 0 to FSize - 1 do
  4605. begin
  4606. FreeKey(FEntries[Index].Key);
  4607. FreeValue(FEntries[Index].Value);
  4608. end;
  4609. FSize := 0;
  4610. AutoPack;
  4611. {$IFDEF THREADSAFE}
  4612. finally
  4613. if FThreadSafe then
  4614. SyncReaderWriter.EndWrite;
  4615. end;
  4616. {$ENDIF THREADSAFE}
  4617. end;
  4618. function TJclAnsiStrAnsiStrSortedMap.ContainsKey(const Key: AnsiString): Boolean;
  4619. var
  4620. Index: Integer;
  4621. begin
  4622. {$IFDEF THREADSAFE}
  4623. if FThreadSafe then
  4624. SyncReaderWriter.BeginRead;
  4625. try
  4626. {$ENDIF THREADSAFE}
  4627. Index := BinarySearch(Key);
  4628. Result := (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0);
  4629. {$IFDEF THREADSAFE}
  4630. finally
  4631. if FThreadSafe then
  4632. SyncReaderWriter.EndRead;
  4633. end;
  4634. {$ENDIF THREADSAFE}
  4635. end;
  4636. function TJclAnsiStrAnsiStrSortedMap.ContainsValue(const Value: AnsiString): Boolean;
  4637. var
  4638. Index: Integer;
  4639. begin
  4640. {$IFDEF THREADSAFE}
  4641. if FThreadSafe then
  4642. SyncReaderWriter.BeginRead;
  4643. try
  4644. {$ENDIF THREADSAFE}
  4645. Result := False;
  4646. for Index := 0 to FSize - 1 do
  4647. if ValuesCompare(FEntries[Index].Value, Value) = 0 then
  4648. begin
  4649. Result := True;
  4650. Break;
  4651. end;
  4652. {$IFDEF THREADSAFE}
  4653. finally
  4654. if FThreadSafe then
  4655. SyncReaderWriter.EndRead;
  4656. end;
  4657. {$ENDIF THREADSAFE}
  4658. end;
  4659. function TJclAnsiStrAnsiStrSortedMap.FirstKey: AnsiString;
  4660. begin
  4661. {$IFDEF THREADSAFE}
  4662. if FThreadSafe then
  4663. SyncReaderWriter.BeginRead;
  4664. try
  4665. {$ENDIF THREADSAFE}
  4666. Result := '';
  4667. if FSize > 0 then
  4668. Result := FEntries[0].Key
  4669. else
  4670. if not FReturnDefaultElements then
  4671. raise EJclNoSuchElementError.Create('');
  4672. {$IFDEF THREADSAFE}
  4673. finally
  4674. if FThreadSafe then
  4675. SyncReaderWriter.EndRead;
  4676. end;
  4677. {$ENDIF THREADSAFE}
  4678. end;
  4679. function TJclAnsiStrAnsiStrSortedMap.Extract(const Key: AnsiString): AnsiString;
  4680. var
  4681. Index: Integer;
  4682. begin
  4683. if ReadOnly then
  4684. raise EJclReadOnlyError.Create;
  4685. {$IFDEF THREADSAFE}
  4686. if FThreadSafe then
  4687. SyncReaderWriter.BeginWrite;
  4688. try
  4689. {$ENDIF THREADSAFE}
  4690. Index := BinarySearch(Key);
  4691. if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then
  4692. begin
  4693. Result := FEntries[Index].Value;
  4694. FEntries[Index].Value := '';
  4695. FreeKey(FEntries[Index].Key);
  4696. if Index < (FSize - 1) then
  4697. MoveArray(FEntries, Index + 1, Index, FSize - Index - 1);
  4698. Dec(FSize);
  4699. AutoPack;
  4700. end
  4701. else
  4702. Result := '';
  4703. {$IFDEF THREADSAFE}
  4704. finally
  4705. if FThreadSafe then
  4706. SyncReaderWriter.EndWrite;
  4707. end;
  4708. {$ENDIF THREADSAFE}
  4709. end;
  4710. function TJclAnsiStrAnsiStrSortedMap.GetValue(const Key: AnsiString): AnsiString;
  4711. var
  4712. Index: Integer;
  4713. begin
  4714. {$IFDEF THREADSAFE}
  4715. if FThreadSafe then
  4716. SyncReaderWriter.BeginRead;
  4717. try
  4718. {$ENDIF THREADSAFE}
  4719. Index := BinarySearch(Key);
  4720. Result := '';
  4721. if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then
  4722. Result := FEntries[Index].Value
  4723. else if not FReturnDefaultElements then
  4724. raise EJclNoSuchElementError.Create('');
  4725. {$IFDEF THREADSAFE}
  4726. finally
  4727. if FThreadSafe then
  4728. SyncReaderWriter.EndRead;
  4729. end;
  4730. {$ENDIF THREADSAFE}
  4731. end;
  4732. function TJclAnsiStrAnsiStrSortedMap.HeadMap(const ToKey: AnsiString): IJclAnsiStrAnsiStrSortedMap;
  4733. var
  4734. ToIndex: Integer;
  4735. NewMap: TJclAnsiStrAnsiStrSortedMap;
  4736. begin
  4737. {$IFDEF THREADSAFE}
  4738. if FThreadSafe then
  4739. SyncReaderWriter.BeginRead;
  4740. try
  4741. {$ENDIF THREADSAFE}
  4742. NewMap := CreateEmptyContainer as TJclAnsiStrAnsiStrSortedMap;
  4743. ToIndex := BinarySearch(ToKey);
  4744. if ToIndex >= 0 then
  4745. begin
  4746. NewMap.SetCapacity(ToIndex + 1);
  4747. NewMap.FSize := ToIndex + 1;
  4748. while ToIndex >= 0 do
  4749. begin
  4750. NewMap.FEntries[ToIndex] := FEntries[ToIndex];
  4751. Dec(ToIndex);
  4752. end;
  4753. end;
  4754. Result := NewMap;
  4755. {$IFDEF THREADSAFE}
  4756. finally
  4757. if FThreadSafe then
  4758. SyncReaderWriter.EndRead;
  4759. end;
  4760. {$ENDIF THREADSAFE}
  4761. end;
  4762. function TJclAnsiStrAnsiStrSortedMap.IsEmpty: Boolean;
  4763. begin
  4764. {$IFDEF THREADSAFE}
  4765. if FThreadSafe then
  4766. SyncReaderWriter.BeginRead;
  4767. try
  4768. {$ENDIF THREADSAFE}
  4769. Result := FSize = 0;
  4770. {$IFDEF THREADSAFE}
  4771. finally
  4772. if FThreadSafe then
  4773. SyncReaderWriter.EndRead;
  4774. end;
  4775. {$ENDIF THREADSAFE}
  4776. end;
  4777. function TJclAnsiStrAnsiStrSortedMap.KeyOfValue(const Value: AnsiString): AnsiString;
  4778. var
  4779. Index: Integer;
  4780. Found: Boolean;
  4781. begin
  4782. {$IFDEF THREADSAFE}
  4783. if FThreadSafe then
  4784. SyncReaderWriter.BeginRead;
  4785. try
  4786. {$ENDIF THREADSAFE}
  4787. Found := False;
  4788. Result := '';
  4789. for Index := 0 to FSize - 1 do
  4790. if ValuesCompare(FEntries[Index].Value, Value) = 0 then
  4791. begin
  4792. Result := FEntries[Index].Key;
  4793. Found := True;
  4794. Break;
  4795. end;
  4796. if (not Found) and (not FReturnDefaultElements) then
  4797. raise EJclNoSuchElementError.Create('');
  4798. {$IFDEF THREADSAFE}
  4799. finally
  4800. if FThreadSafe then
  4801. SyncReaderWriter.EndRead;
  4802. end;
  4803. {$ENDIF THREADSAFE}
  4804. end;
  4805. function TJclAnsiStrAnsiStrSortedMap.KeySet: IJclAnsiStrSet;
  4806. var
  4807. Index: Integer;
  4808. begin
  4809. {$IFDEF THREADSAFE}
  4810. if FThreadSafe then
  4811. SyncReaderWriter.BeginRead;
  4812. try
  4813. {$ENDIF THREADSAFE}
  4814. Result := TJclAnsiStrArraySet.Create(FSize);
  4815. for Index := 0 to FSize - 1 do
  4816. Result.Add(FEntries[Index].Key);
  4817. {$IFDEF THREADSAFE}
  4818. finally
  4819. if FThreadSafe then
  4820. SyncReaderWriter.EndRead;
  4821. end;
  4822. {$ENDIF THREADSAFE}
  4823. end;
  4824. function TJclAnsiStrAnsiStrSortedMap.LastKey: AnsiString;
  4825. begin
  4826. {$IFDEF THREADSAFE}
  4827. if FThreadSafe then
  4828. SyncReaderWriter.BeginRead;
  4829. try
  4830. {$ENDIF THREADSAFE}
  4831. Result := '';
  4832. if FSize > 0 then
  4833. Result := FEntries[FSize - 1].Key
  4834. else
  4835. if not FReturnDefaultElements then
  4836. raise EJclNoSuchElementError.Create('');
  4837. {$IFDEF THREADSAFE}
  4838. finally
  4839. if FThreadSafe then
  4840. SyncReaderWriter.EndRead;
  4841. end;
  4842. {$ENDIF THREADSAFE}
  4843. end;
  4844. function TJclAnsiStrAnsiStrSortedMap.MapEquals(const AMap: IJclAnsiStrAnsiStrMap): Boolean;
  4845. var
  4846. It: IJclAnsiStrIterator;
  4847. Index: Integer;
  4848. AKey: AnsiString;
  4849. begin
  4850. {$IFDEF THREADSAFE}
  4851. if FThreadSafe then
  4852. SyncReaderWriter.BeginRead;
  4853. try
  4854. {$ENDIF THREADSAFE}
  4855. Result := False;
  4856. if AMap = nil then
  4857. Exit;
  4858. if FSize <> AMap.Size then
  4859. Exit;
  4860. It := AMap.KeySet.First;
  4861. Index := 0;
  4862. while It.HasNext do
  4863. begin
  4864. if Index >= FSize then
  4865. Exit;
  4866. AKey := It.Next;
  4867. if ValuesCompare(AMap.GetValue(AKey), FEntries[Index].Value) <> 0 then
  4868. Exit;
  4869. Inc(Index);
  4870. end;
  4871. Result := True;
  4872. {$IFDEF THREADSAFE}
  4873. finally
  4874. if FThreadSafe then
  4875. SyncReaderWriter.EndRead;
  4876. end;
  4877. {$ENDIF THREADSAFE}
  4878. end;
  4879. procedure TJclAnsiStrAnsiStrSortedMap.FinalizeArrayBeforeMove(var List: TJclAnsiStrAnsiStrSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  4880. begin
  4881. Assert(Count > 0);
  4882. if FromIndex < ToIndex then
  4883. begin
  4884. if Count > (ToIndex - FromIndex) then
  4885. Finalize(List[FromIndex + Count], ToIndex - FromIndex)
  4886. else
  4887. Finalize(List[ToIndex], Count);
  4888. end
  4889. else
  4890. if FromIndex > ToIndex then
  4891. begin
  4892. if Count > (FromIndex - ToIndex) then
  4893. Count := FromIndex - ToIndex;
  4894. Finalize(List[ToIndex], Count)
  4895. end;
  4896. end;
  4897. procedure TJclAnsiStrAnsiStrSortedMap.InitializeArray(var List: TJclAnsiStrAnsiStrSortedMapEntryArray; FromIndex, Count: SizeInt);
  4898. begin
  4899. {$IFDEF FPC}
  4900. while Count > 0 do
  4901. begin
  4902. Initialize(List[FromIndex]);
  4903. Inc(FromIndex);
  4904. Dec(Count);
  4905. end;
  4906. {$ELSE ~FPC}
  4907. Initialize(List[FromIndex], Count);
  4908. {$ENDIF ~FPC}
  4909. end;
  4910. procedure TJclAnsiStrAnsiStrSortedMap.InitializeArrayAfterMove(var List: TJclAnsiStrAnsiStrSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  4911. begin
  4912. { Keep reference counting working }
  4913. if FromIndex < ToIndex then
  4914. begin
  4915. if (ToIndex - FromIndex) < Count then
  4916. Count := ToIndex - FromIndex;
  4917. InitializeArray(List, FromIndex, Count);
  4918. end
  4919. else
  4920. if FromIndex > ToIndex then
  4921. begin
  4922. if (FromIndex - ToIndex) < Count then
  4923. InitializeArray(List, ToIndex + Count, FromIndex - ToIndex)
  4924. else
  4925. InitializeArray(List, FromIndex, Count);
  4926. end;
  4927. end;
  4928. procedure TJclAnsiStrAnsiStrSortedMap.MoveArray(var List: TJclAnsiStrAnsiStrSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  4929. begin
  4930. if Count > 0 then
  4931. begin
  4932. FinalizeArrayBeforeMove(List, FromIndex, ToIndex, Count);
  4933. Move(List[FromIndex], List[ToIndex], Count * SizeOf(List[0]));
  4934. InitializeArrayAfterMove(List, FromIndex, ToIndex, Count);
  4935. end;
  4936. end;
  4937. procedure TJclAnsiStrAnsiStrSortedMap.PutAll(const AMap: IJclAnsiStrAnsiStrMap);
  4938. var
  4939. It: IJclAnsiStrIterator;
  4940. Key: AnsiString;
  4941. begin
  4942. if ReadOnly then
  4943. raise EJclReadOnlyError.Create;
  4944. {$IFDEF THREADSAFE}
  4945. if FThreadSafe then
  4946. SyncReaderWriter.BeginWrite;
  4947. try
  4948. {$ENDIF THREADSAFE}
  4949. if AMap = nil then
  4950. Exit;
  4951. It := AMap.KeySet.First;
  4952. while It.HasNext do
  4953. begin
  4954. Key := It.Next;
  4955. PutValue(Key, AMap.GetValue(Key));
  4956. end;
  4957. {$IFDEF THREADSAFE}
  4958. finally
  4959. if FThreadSafe then
  4960. SyncReaderWriter.EndWrite;
  4961. end;
  4962. {$ENDIF THREADSAFE}
  4963. end;
  4964. procedure TJclAnsiStrAnsiStrSortedMap.PutValue(const Key: AnsiString; const Value: AnsiString);
  4965. var
  4966. Index: Integer;
  4967. begin
  4968. if ReadOnly then
  4969. raise EJclReadOnlyError.Create;
  4970. {$IFDEF THREADSAFE}
  4971. if FThreadSafe then
  4972. SyncReaderWriter.BeginWrite;
  4973. try
  4974. {$ENDIF THREADSAFE}
  4975. if FAllowDefaultElements or ((KeysCompare(Key, '') <> 0) and (ValuesCompare(Value, '') <> 0)) then
  4976. begin
  4977. Index := BinarySearch(Key);
  4978. if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then
  4979. begin
  4980. FreeValue(FEntries[Index].Value);
  4981. FEntries[Index].Value := Value;
  4982. end
  4983. else
  4984. begin
  4985. if FSize = FCapacity then
  4986. AutoGrow;
  4987. if FSize < FCapacity then
  4988. begin
  4989. Inc(Index);
  4990. if (Index < FSize) and (KeysCompare(FEntries[Index].Key, Key) <> 0) then
  4991. MoveArray(FEntries, Index, Index + 1, FSize - Index);
  4992. FEntries[Index].Key := Key;
  4993. FEntries[Index].Value := Value;
  4994. Inc(FSize);
  4995. end;
  4996. end;
  4997. end;
  4998. {$IFDEF THREADSAFE}
  4999. finally
  5000. if FThreadSafe then
  5001. SyncReaderWriter.EndWrite;
  5002. end;
  5003. {$ENDIF THREADSAFE}
  5004. end;
  5005. function TJclAnsiStrAnsiStrSortedMap.Remove(const Key: AnsiString): AnsiString;
  5006. begin
  5007. if ReadOnly then
  5008. raise EJclReadOnlyError.Create;
  5009. {$IFDEF THREADSAFE}
  5010. if FThreadSafe then
  5011. SyncReaderWriter.BeginWrite;
  5012. try
  5013. {$ENDIF THREADSAFE}
  5014. Result := Extract(Key);
  5015. Result := FreeValue(Result);
  5016. {$IFDEF THREADSAFE}
  5017. finally
  5018. if FThreadSafe then
  5019. SyncReaderWriter.EndWrite;
  5020. end;
  5021. {$ENDIF THREADSAFE}
  5022. end;
  5023. procedure TJclAnsiStrAnsiStrSortedMap.SetCapacity(Value: Integer);
  5024. begin
  5025. if ReadOnly then
  5026. raise EJclReadOnlyError.Create;
  5027. {$IFDEF THREADSAFE}
  5028. if FThreadSafe then
  5029. SyncReaderWriter.BeginWrite;
  5030. try
  5031. {$ENDIF THREADSAFE}
  5032. if FSize <= Value then
  5033. begin
  5034. SetLength(FEntries, Value);
  5035. inherited SetCapacity(Value);
  5036. end
  5037. else
  5038. raise EJclOperationNotSupportedError.Create;
  5039. {$IFDEF THREADSAFE}
  5040. finally
  5041. if FThreadSafe then
  5042. SyncReaderWriter.EndWrite;
  5043. end;
  5044. {$ENDIF THREADSAFE}
  5045. end;
  5046. function TJclAnsiStrAnsiStrSortedMap.Size: Integer;
  5047. begin
  5048. Result := FSize;
  5049. end;
  5050. function TJclAnsiStrAnsiStrSortedMap.SubMap(const FromKey, ToKey: AnsiString): IJclAnsiStrAnsiStrSortedMap;
  5051. var
  5052. FromIndex, ToIndex: Integer;
  5053. NewMap: TJclAnsiStrAnsiStrSortedMap;
  5054. begin
  5055. {$IFDEF THREADSAFE}
  5056. if FThreadSafe then
  5057. SyncReaderWriter.BeginRead;
  5058. try
  5059. {$ENDIF THREADSAFE}
  5060. NewMap := CreateEmptyContainer as TJclAnsiStrAnsiStrSortedMap;
  5061. FromIndex := BinarySearch(FromKey);
  5062. if (FromIndex = -1) or (KeysCompare(FEntries[FromIndex].Key, FromKey) < 0) then
  5063. Inc(FromIndex);
  5064. ToIndex := BinarySearch(ToKey);
  5065. if (FromIndex >= 0) and (FromIndex <= ToIndex) then
  5066. begin
  5067. NewMap.SetCapacity(ToIndex - FromIndex + 1);
  5068. NewMap.FSize := ToIndex - FromIndex + 1;
  5069. while ToIndex >= FromIndex do
  5070. begin
  5071. NewMap.FEntries[ToIndex - FromIndex] := FEntries[ToIndex];
  5072. Dec(ToIndex);
  5073. end;
  5074. end;
  5075. Result := NewMap;
  5076. {$IFDEF THREADSAFE}
  5077. finally
  5078. if FThreadSafe then
  5079. SyncReaderWriter.EndRead;
  5080. end;
  5081. {$ENDIF THREADSAFE}
  5082. end;
  5083. function TJclAnsiStrAnsiStrSortedMap.TailMap(const FromKey: AnsiString): IJclAnsiStrAnsiStrSortedMap;
  5084. var
  5085. FromIndex, Index: Integer;
  5086. NewMap: TJclAnsiStrAnsiStrSortedMap;
  5087. begin
  5088. {$IFDEF THREADSAFE}
  5089. if FThreadSafe then
  5090. SyncReaderWriter.BeginRead;
  5091. try
  5092. {$ENDIF THREADSAFE}
  5093. NewMap := CreateEmptyContainer as TJclAnsiStrAnsiStrSortedMap;
  5094. FromIndex := BinarySearch(FromKey);
  5095. if (FromIndex = -1) or (KeysCompare(FEntries[FromIndex].Key, FromKey) < 0) then
  5096. Inc(FromIndex);
  5097. if (FromIndex >= 0) and (FromIndex < FSize) then
  5098. begin
  5099. NewMap.SetCapacity(FSize - FromIndex);
  5100. NewMap.FSize := FSize - FromIndex;
  5101. Index := FromIndex;
  5102. while Index < FSize do
  5103. begin
  5104. NewMap.FEntries[Index - FromIndex] := FEntries[Index];
  5105. Inc(Index);
  5106. end;
  5107. end;
  5108. Result := NewMap;
  5109. {$IFDEF THREADSAFE}
  5110. finally
  5111. if FThreadSafe then
  5112. SyncReaderWriter.EndRead;
  5113. end;
  5114. {$ENDIF THREADSAFE}
  5115. end;
  5116. function TJclAnsiStrAnsiStrSortedMap.Values: IJclAnsiStrCollection;
  5117. var
  5118. Index: Integer;
  5119. begin
  5120. {$IFDEF THREADSAFE}
  5121. if FThreadSafe then
  5122. SyncReaderWriter.BeginRead;
  5123. try
  5124. {$ENDIF THREADSAFE}
  5125. Result := TJclAnsiStrArrayList.Create(FSize);
  5126. for Index := 0 to FSize - 1 do
  5127. Result.Add(FEntries[Index].Value);
  5128. {$IFDEF THREADSAFE}
  5129. finally
  5130. if FThreadSafe then
  5131. SyncReaderWriter.EndRead;
  5132. end;
  5133. {$ENDIF THREADSAFE}
  5134. end;
  5135. function TJclAnsiStrAnsiStrSortedMap.CreateEmptyContainer: TJclAbstractContainerBase;
  5136. begin
  5137. Result := TJclAnsiStrAnsiStrSortedMap.Create(FSize);
  5138. AssignPropertiesTo(Result);
  5139. end;
  5140. function TJclAnsiStrAnsiStrSortedMap.FreeKey(var Key: AnsiString): AnsiString;
  5141. begin
  5142. Result := Key;
  5143. Key := '';
  5144. end;
  5145. function TJclAnsiStrAnsiStrSortedMap.FreeValue(var Value: AnsiString): AnsiString;
  5146. begin
  5147. Result := Value;
  5148. Value := '';
  5149. end;
  5150. function TJclAnsiStrAnsiStrSortedMap.KeysCompare(const A, B: AnsiString): Integer;
  5151. begin
  5152. Result := ItemsCompare(A, B);
  5153. end;
  5154. function TJclAnsiStrAnsiStrSortedMap.ValuesCompare(const A, B: AnsiString): Integer;
  5155. begin
  5156. Result := ItemsCompare(A, B);
  5157. end;
  5158. //=== { TJclWideStrIntfSortedMap } ==============================================
  5159. constructor TJclWideStrIntfSortedMap.Create(ACapacity: Integer);
  5160. begin
  5161. inherited Create();
  5162. SetCapacity(ACapacity);
  5163. end;
  5164. destructor TJclWideStrIntfSortedMap.Destroy;
  5165. begin
  5166. FReadOnly := False;
  5167. Clear;
  5168. inherited Destroy;
  5169. end;
  5170. procedure TJclWideStrIntfSortedMap.AssignDataTo(Dest: TJclAbstractContainerBase);
  5171. var
  5172. MyDest: TJclWideStrIntfSortedMap;
  5173. begin
  5174. inherited AssignDataTo(Dest);
  5175. if Dest is TJclWideStrIntfSortedMap then
  5176. begin
  5177. MyDest := TJclWideStrIntfSortedMap(Dest);
  5178. MyDest.SetCapacity(FSize);
  5179. MyDest.FEntries := FEntries;
  5180. MyDest.FSize := FSize;
  5181. end;
  5182. end;
  5183. function TJclWideStrIntfSortedMap.BinarySearch(const Key: WideString): Integer;
  5184. var
  5185. HiPos, LoPos, CompPos: Integer;
  5186. Comp: Integer;
  5187. begin
  5188. {$IFDEF THREADSAFE}
  5189. if FThreadSafe then
  5190. SyncReaderWriter.BeginRead;
  5191. try
  5192. {$ENDIF THREADSAFE}
  5193. LoPos := 0;
  5194. HiPos := FSize - 1;
  5195. CompPos := (HiPos + LoPos) div 2;
  5196. while HiPos >= LoPos do
  5197. begin
  5198. Comp := KeysCompare(FEntries[CompPos].Key, Key);
  5199. if Comp < 0 then
  5200. LoPos := CompPos + 1
  5201. else
  5202. if Comp > 0 then
  5203. HiPos := CompPos - 1
  5204. else
  5205. begin
  5206. HiPos := CompPos;
  5207. LoPos := CompPos + 1;
  5208. end;
  5209. CompPos := (HiPos + LoPos) div 2;
  5210. end;
  5211. Result := HiPos;
  5212. {$IFDEF THREADSAFE}
  5213. finally
  5214. if FThreadSafe then
  5215. SyncReaderWriter.EndRead;
  5216. end;
  5217. {$ENDIF THREADSAFE}
  5218. end;
  5219. procedure TJclWideStrIntfSortedMap.Clear;
  5220. var
  5221. Index: Integer;
  5222. begin
  5223. if ReadOnly then
  5224. raise EJclReadOnlyError.Create;
  5225. {$IFDEF THREADSAFE}
  5226. if FThreadSafe then
  5227. SyncReaderWriter.BeginWrite;
  5228. try
  5229. {$ENDIF THREADSAFE}
  5230. for Index := 0 to FSize - 1 do
  5231. begin
  5232. FreeKey(FEntries[Index].Key);
  5233. FreeValue(FEntries[Index].Value);
  5234. end;
  5235. FSize := 0;
  5236. AutoPack;
  5237. {$IFDEF THREADSAFE}
  5238. finally
  5239. if FThreadSafe then
  5240. SyncReaderWriter.EndWrite;
  5241. end;
  5242. {$ENDIF THREADSAFE}
  5243. end;
  5244. function TJclWideStrIntfSortedMap.ContainsKey(const Key: WideString): Boolean;
  5245. var
  5246. Index: Integer;
  5247. begin
  5248. {$IFDEF THREADSAFE}
  5249. if FThreadSafe then
  5250. SyncReaderWriter.BeginRead;
  5251. try
  5252. {$ENDIF THREADSAFE}
  5253. Index := BinarySearch(Key);
  5254. Result := (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0);
  5255. {$IFDEF THREADSAFE}
  5256. finally
  5257. if FThreadSafe then
  5258. SyncReaderWriter.EndRead;
  5259. end;
  5260. {$ENDIF THREADSAFE}
  5261. end;
  5262. function TJclWideStrIntfSortedMap.ContainsValue(const Value: IInterface): Boolean;
  5263. var
  5264. Index: Integer;
  5265. begin
  5266. {$IFDEF THREADSAFE}
  5267. if FThreadSafe then
  5268. SyncReaderWriter.BeginRead;
  5269. try
  5270. {$ENDIF THREADSAFE}
  5271. Result := False;
  5272. for Index := 0 to FSize - 1 do
  5273. if ValuesCompare(FEntries[Index].Value, Value) = 0 then
  5274. begin
  5275. Result := True;
  5276. Break;
  5277. end;
  5278. {$IFDEF THREADSAFE}
  5279. finally
  5280. if FThreadSafe then
  5281. SyncReaderWriter.EndRead;
  5282. end;
  5283. {$ENDIF THREADSAFE}
  5284. end;
  5285. function TJclWideStrIntfSortedMap.FirstKey: WideString;
  5286. begin
  5287. {$IFDEF THREADSAFE}
  5288. if FThreadSafe then
  5289. SyncReaderWriter.BeginRead;
  5290. try
  5291. {$ENDIF THREADSAFE}
  5292. Result := '';
  5293. if FSize > 0 then
  5294. Result := FEntries[0].Key
  5295. else
  5296. if not FReturnDefaultElements then
  5297. raise EJclNoSuchElementError.Create('');
  5298. {$IFDEF THREADSAFE}
  5299. finally
  5300. if FThreadSafe then
  5301. SyncReaderWriter.EndRead;
  5302. end;
  5303. {$ENDIF THREADSAFE}
  5304. end;
  5305. function TJclWideStrIntfSortedMap.Extract(const Key: WideString): IInterface;
  5306. var
  5307. Index: Integer;
  5308. begin
  5309. if ReadOnly then
  5310. raise EJclReadOnlyError.Create;
  5311. {$IFDEF THREADSAFE}
  5312. if FThreadSafe then
  5313. SyncReaderWriter.BeginWrite;
  5314. try
  5315. {$ENDIF THREADSAFE}
  5316. Index := BinarySearch(Key);
  5317. if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then
  5318. begin
  5319. Result := FEntries[Index].Value;
  5320. FEntries[Index].Value := nil;
  5321. FreeKey(FEntries[Index].Key);
  5322. if Index < (FSize - 1) then
  5323. MoveArray(FEntries, Index + 1, Index, FSize - Index - 1);
  5324. Dec(FSize);
  5325. AutoPack;
  5326. end
  5327. else
  5328. Result := nil;
  5329. {$IFDEF THREADSAFE}
  5330. finally
  5331. if FThreadSafe then
  5332. SyncReaderWriter.EndWrite;
  5333. end;
  5334. {$ENDIF THREADSAFE}
  5335. end;
  5336. function TJclWideStrIntfSortedMap.GetValue(const Key: WideString): IInterface;
  5337. var
  5338. Index: Integer;
  5339. begin
  5340. {$IFDEF THREADSAFE}
  5341. if FThreadSafe then
  5342. SyncReaderWriter.BeginRead;
  5343. try
  5344. {$ENDIF THREADSAFE}
  5345. Index := BinarySearch(Key);
  5346. Result := nil;
  5347. if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then
  5348. Result := FEntries[Index].Value
  5349. else if not FReturnDefaultElements then
  5350. raise EJclNoSuchElementError.Create('');
  5351. {$IFDEF THREADSAFE}
  5352. finally
  5353. if FThreadSafe then
  5354. SyncReaderWriter.EndRead;
  5355. end;
  5356. {$ENDIF THREADSAFE}
  5357. end;
  5358. function TJclWideStrIntfSortedMap.HeadMap(const ToKey: WideString): IJclWideStrIntfSortedMap;
  5359. var
  5360. ToIndex: Integer;
  5361. NewMap: TJclWideStrIntfSortedMap;
  5362. begin
  5363. {$IFDEF THREADSAFE}
  5364. if FThreadSafe then
  5365. SyncReaderWriter.BeginRead;
  5366. try
  5367. {$ENDIF THREADSAFE}
  5368. NewMap := CreateEmptyContainer as TJclWideStrIntfSortedMap;
  5369. ToIndex := BinarySearch(ToKey);
  5370. if ToIndex >= 0 then
  5371. begin
  5372. NewMap.SetCapacity(ToIndex + 1);
  5373. NewMap.FSize := ToIndex + 1;
  5374. while ToIndex >= 0 do
  5375. begin
  5376. NewMap.FEntries[ToIndex] := FEntries[ToIndex];
  5377. Dec(ToIndex);
  5378. end;
  5379. end;
  5380. Result := NewMap;
  5381. {$IFDEF THREADSAFE}
  5382. finally
  5383. if FThreadSafe then
  5384. SyncReaderWriter.EndRead;
  5385. end;
  5386. {$ENDIF THREADSAFE}
  5387. end;
  5388. function TJclWideStrIntfSortedMap.IsEmpty: Boolean;
  5389. begin
  5390. {$IFDEF THREADSAFE}
  5391. if FThreadSafe then
  5392. SyncReaderWriter.BeginRead;
  5393. try
  5394. {$ENDIF THREADSAFE}
  5395. Result := FSize = 0;
  5396. {$IFDEF THREADSAFE}
  5397. finally
  5398. if FThreadSafe then
  5399. SyncReaderWriter.EndRead;
  5400. end;
  5401. {$ENDIF THREADSAFE}
  5402. end;
  5403. function TJclWideStrIntfSortedMap.KeyOfValue(const Value: IInterface): WideString;
  5404. var
  5405. Index: Integer;
  5406. Found: Boolean;
  5407. begin
  5408. {$IFDEF THREADSAFE}
  5409. if FThreadSafe then
  5410. SyncReaderWriter.BeginRead;
  5411. try
  5412. {$ENDIF THREADSAFE}
  5413. Found := False;
  5414. Result := '';
  5415. for Index := 0 to FSize - 1 do
  5416. if ValuesCompare(FEntries[Index].Value, Value) = 0 then
  5417. begin
  5418. Result := FEntries[Index].Key;
  5419. Found := True;
  5420. Break;
  5421. end;
  5422. if (not Found) and (not FReturnDefaultElements) then
  5423. raise EJclNoSuchElementError.Create('');
  5424. {$IFDEF THREADSAFE}
  5425. finally
  5426. if FThreadSafe then
  5427. SyncReaderWriter.EndRead;
  5428. end;
  5429. {$ENDIF THREADSAFE}
  5430. end;
  5431. function TJclWideStrIntfSortedMap.KeySet: IJclWideStrSet;
  5432. var
  5433. Index: Integer;
  5434. begin
  5435. {$IFDEF THREADSAFE}
  5436. if FThreadSafe then
  5437. SyncReaderWriter.BeginRead;
  5438. try
  5439. {$ENDIF THREADSAFE}
  5440. Result := TJclWideStrArraySet.Create(FSize);
  5441. for Index := 0 to FSize - 1 do
  5442. Result.Add(FEntries[Index].Key);
  5443. {$IFDEF THREADSAFE}
  5444. finally
  5445. if FThreadSafe then
  5446. SyncReaderWriter.EndRead;
  5447. end;
  5448. {$ENDIF THREADSAFE}
  5449. end;
  5450. function TJclWideStrIntfSortedMap.LastKey: WideString;
  5451. begin
  5452. {$IFDEF THREADSAFE}
  5453. if FThreadSafe then
  5454. SyncReaderWriter.BeginRead;
  5455. try
  5456. {$ENDIF THREADSAFE}
  5457. Result := '';
  5458. if FSize > 0 then
  5459. Result := FEntries[FSize - 1].Key
  5460. else
  5461. if not FReturnDefaultElements then
  5462. raise EJclNoSuchElementError.Create('');
  5463. {$IFDEF THREADSAFE}
  5464. finally
  5465. if FThreadSafe then
  5466. SyncReaderWriter.EndRead;
  5467. end;
  5468. {$ENDIF THREADSAFE}
  5469. end;
  5470. function TJclWideStrIntfSortedMap.MapEquals(const AMap: IJclWideStrIntfMap): Boolean;
  5471. var
  5472. It: IJclWideStrIterator;
  5473. Index: Integer;
  5474. AKey: WideString;
  5475. begin
  5476. {$IFDEF THREADSAFE}
  5477. if FThreadSafe then
  5478. SyncReaderWriter.BeginRead;
  5479. try
  5480. {$ENDIF THREADSAFE}
  5481. Result := False;
  5482. if AMap = nil then
  5483. Exit;
  5484. if FSize <> AMap.Size then
  5485. Exit;
  5486. It := AMap.KeySet.First;
  5487. Index := 0;
  5488. while It.HasNext do
  5489. begin
  5490. if Index >= FSize then
  5491. Exit;
  5492. AKey := It.Next;
  5493. if ValuesCompare(AMap.GetValue(AKey), FEntries[Index].Value) <> 0 then
  5494. Exit;
  5495. Inc(Index);
  5496. end;
  5497. Result := True;
  5498. {$IFDEF THREADSAFE}
  5499. finally
  5500. if FThreadSafe then
  5501. SyncReaderWriter.EndRead;
  5502. end;
  5503. {$ENDIF THREADSAFE}
  5504. end;
  5505. procedure TJclWideStrIntfSortedMap.FinalizeArrayBeforeMove(var List: TJclWideStrIntfSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  5506. begin
  5507. Assert(Count > 0);
  5508. if FromIndex < ToIndex then
  5509. begin
  5510. if Count > (ToIndex - FromIndex) then
  5511. Finalize(List[FromIndex + Count], ToIndex - FromIndex)
  5512. else
  5513. Finalize(List[ToIndex], Count);
  5514. end
  5515. else
  5516. if FromIndex > ToIndex then
  5517. begin
  5518. if Count > (FromIndex - ToIndex) then
  5519. Count := FromIndex - ToIndex;
  5520. Finalize(List[ToIndex], Count)
  5521. end;
  5522. end;
  5523. procedure TJclWideStrIntfSortedMap.InitializeArray(var List: TJclWideStrIntfSortedMapEntryArray; FromIndex, Count: SizeInt);
  5524. begin
  5525. {$IFDEF FPC}
  5526. while Count > 0 do
  5527. begin
  5528. Initialize(List[FromIndex]);
  5529. Inc(FromIndex);
  5530. Dec(Count);
  5531. end;
  5532. {$ELSE ~FPC}
  5533. Initialize(List[FromIndex], Count);
  5534. {$ENDIF ~FPC}
  5535. end;
  5536. procedure TJclWideStrIntfSortedMap.InitializeArrayAfterMove(var List: TJclWideStrIntfSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  5537. begin
  5538. { Keep reference counting working }
  5539. if FromIndex < ToIndex then
  5540. begin
  5541. if (ToIndex - FromIndex) < Count then
  5542. Count := ToIndex - FromIndex;
  5543. InitializeArray(List, FromIndex, Count);
  5544. end
  5545. else
  5546. if FromIndex > ToIndex then
  5547. begin
  5548. if (FromIndex - ToIndex) < Count then
  5549. InitializeArray(List, ToIndex + Count, FromIndex - ToIndex)
  5550. else
  5551. InitializeArray(List, FromIndex, Count);
  5552. end;
  5553. end;
  5554. procedure TJclWideStrIntfSortedMap.MoveArray(var List: TJclWideStrIntfSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  5555. begin
  5556. if Count > 0 then
  5557. begin
  5558. FinalizeArrayBeforeMove(List, FromIndex, ToIndex, Count);
  5559. Move(List[FromIndex], List[ToIndex], Count * SizeOf(List[0]));
  5560. InitializeArrayAfterMove(List, FromIndex, ToIndex, Count);
  5561. end;
  5562. end;
  5563. procedure TJclWideStrIntfSortedMap.PutAll(const AMap: IJclWideStrIntfMap);
  5564. var
  5565. It: IJclWideStrIterator;
  5566. Key: WideString;
  5567. begin
  5568. if ReadOnly then
  5569. raise EJclReadOnlyError.Create;
  5570. {$IFDEF THREADSAFE}
  5571. if FThreadSafe then
  5572. SyncReaderWriter.BeginWrite;
  5573. try
  5574. {$ENDIF THREADSAFE}
  5575. if AMap = nil then
  5576. Exit;
  5577. It := AMap.KeySet.First;
  5578. while It.HasNext do
  5579. begin
  5580. Key := It.Next;
  5581. PutValue(Key, AMap.GetValue(Key));
  5582. end;
  5583. {$IFDEF THREADSAFE}
  5584. finally
  5585. if FThreadSafe then
  5586. SyncReaderWriter.EndWrite;
  5587. end;
  5588. {$ENDIF THREADSAFE}
  5589. end;
  5590. procedure TJclWideStrIntfSortedMap.PutValue(const Key: WideString; const Value: IInterface);
  5591. var
  5592. Index: Integer;
  5593. begin
  5594. if ReadOnly then
  5595. raise EJclReadOnlyError.Create;
  5596. {$IFDEF THREADSAFE}
  5597. if FThreadSafe then
  5598. SyncReaderWriter.BeginWrite;
  5599. try
  5600. {$ENDIF THREADSAFE}
  5601. if FAllowDefaultElements or ((KeysCompare(Key, '') <> 0) and (ValuesCompare(Value, nil) <> 0)) then
  5602. begin
  5603. Index := BinarySearch(Key);
  5604. if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then
  5605. begin
  5606. FreeValue(FEntries[Index].Value);
  5607. FEntries[Index].Value := Value;
  5608. end
  5609. else
  5610. begin
  5611. if FSize = FCapacity then
  5612. AutoGrow;
  5613. if FSize < FCapacity then
  5614. begin
  5615. Inc(Index);
  5616. if (Index < FSize) and (KeysCompare(FEntries[Index].Key, Key) <> 0) then
  5617. MoveArray(FEntries, Index, Index + 1, FSize - Index);
  5618. FEntries[Index].Key := Key;
  5619. FEntries[Index].Value := Value;
  5620. Inc(FSize);
  5621. end;
  5622. end;
  5623. end;
  5624. {$IFDEF THREADSAFE}
  5625. finally
  5626. if FThreadSafe then
  5627. SyncReaderWriter.EndWrite;
  5628. end;
  5629. {$ENDIF THREADSAFE}
  5630. end;
  5631. function TJclWideStrIntfSortedMap.Remove(const Key: WideString): IInterface;
  5632. begin
  5633. if ReadOnly then
  5634. raise EJclReadOnlyError.Create;
  5635. {$IFDEF THREADSAFE}
  5636. if FThreadSafe then
  5637. SyncReaderWriter.BeginWrite;
  5638. try
  5639. {$ENDIF THREADSAFE}
  5640. Result := Extract(Key);
  5641. Result := FreeValue(Result);
  5642. {$IFDEF THREADSAFE}
  5643. finally
  5644. if FThreadSafe then
  5645. SyncReaderWriter.EndWrite;
  5646. end;
  5647. {$ENDIF THREADSAFE}
  5648. end;
  5649. procedure TJclWideStrIntfSortedMap.SetCapacity(Value: Integer);
  5650. begin
  5651. if ReadOnly then
  5652. raise EJclReadOnlyError.Create;
  5653. {$IFDEF THREADSAFE}
  5654. if FThreadSafe then
  5655. SyncReaderWriter.BeginWrite;
  5656. try
  5657. {$ENDIF THREADSAFE}
  5658. if FSize <= Value then
  5659. begin
  5660. SetLength(FEntries, Value);
  5661. inherited SetCapacity(Value);
  5662. end
  5663. else
  5664. raise EJclOperationNotSupportedError.Create;
  5665. {$IFDEF THREADSAFE}
  5666. finally
  5667. if FThreadSafe then
  5668. SyncReaderWriter.EndWrite;
  5669. end;
  5670. {$ENDIF THREADSAFE}
  5671. end;
  5672. function TJclWideStrIntfSortedMap.Size: Integer;
  5673. begin
  5674. Result := FSize;
  5675. end;
  5676. function TJclWideStrIntfSortedMap.SubMap(const FromKey, ToKey: WideString): IJclWideStrIntfSortedMap;
  5677. var
  5678. FromIndex, ToIndex: Integer;
  5679. NewMap: TJclWideStrIntfSortedMap;
  5680. begin
  5681. {$IFDEF THREADSAFE}
  5682. if FThreadSafe then
  5683. SyncReaderWriter.BeginRead;
  5684. try
  5685. {$ENDIF THREADSAFE}
  5686. NewMap := CreateEmptyContainer as TJclWideStrIntfSortedMap;
  5687. FromIndex := BinarySearch(FromKey);
  5688. if (FromIndex = -1) or (KeysCompare(FEntries[FromIndex].Key, FromKey) < 0) then
  5689. Inc(FromIndex);
  5690. ToIndex := BinarySearch(ToKey);
  5691. if (FromIndex >= 0) and (FromIndex <= ToIndex) then
  5692. begin
  5693. NewMap.SetCapacity(ToIndex - FromIndex + 1);
  5694. NewMap.FSize := ToIndex - FromIndex + 1;
  5695. while ToIndex >= FromIndex do
  5696. begin
  5697. NewMap.FEntries[ToIndex - FromIndex] := FEntries[ToIndex];
  5698. Dec(ToIndex);
  5699. end;
  5700. end;
  5701. Result := NewMap;
  5702. {$IFDEF THREADSAFE}
  5703. finally
  5704. if FThreadSafe then
  5705. SyncReaderWriter.EndRead;
  5706. end;
  5707. {$ENDIF THREADSAFE}
  5708. end;
  5709. function TJclWideStrIntfSortedMap.TailMap(const FromKey: WideString): IJclWideStrIntfSortedMap;
  5710. var
  5711. FromIndex, Index: Integer;
  5712. NewMap: TJclWideStrIntfSortedMap;
  5713. begin
  5714. {$IFDEF THREADSAFE}
  5715. if FThreadSafe then
  5716. SyncReaderWriter.BeginRead;
  5717. try
  5718. {$ENDIF THREADSAFE}
  5719. NewMap := CreateEmptyContainer as TJclWideStrIntfSortedMap;
  5720. FromIndex := BinarySearch(FromKey);
  5721. if (FromIndex = -1) or (KeysCompare(FEntries[FromIndex].Key, FromKey) < 0) then
  5722. Inc(FromIndex);
  5723. if (FromIndex >= 0) and (FromIndex < FSize) then
  5724. begin
  5725. NewMap.SetCapacity(FSize - FromIndex);
  5726. NewMap.FSize := FSize - FromIndex;
  5727. Index := FromIndex;
  5728. while Index < FSize do
  5729. begin
  5730. NewMap.FEntries[Index - FromIndex] := FEntries[Index];
  5731. Inc(Index);
  5732. end;
  5733. end;
  5734. Result := NewMap;
  5735. {$IFDEF THREADSAFE}
  5736. finally
  5737. if FThreadSafe then
  5738. SyncReaderWriter.EndRead;
  5739. end;
  5740. {$ENDIF THREADSAFE}
  5741. end;
  5742. function TJclWideStrIntfSortedMap.Values: IJclIntfCollection;
  5743. var
  5744. Index: Integer;
  5745. begin
  5746. {$IFDEF THREADSAFE}
  5747. if FThreadSafe then
  5748. SyncReaderWriter.BeginRead;
  5749. try
  5750. {$ENDIF THREADSAFE}
  5751. Result := TJclIntfArrayList.Create(FSize);
  5752. for Index := 0 to FSize - 1 do
  5753. Result.Add(FEntries[Index].Value);
  5754. {$IFDEF THREADSAFE}
  5755. finally
  5756. if FThreadSafe then
  5757. SyncReaderWriter.EndRead;
  5758. end;
  5759. {$ENDIF THREADSAFE}
  5760. end;
  5761. function TJclWideStrIntfSortedMap.CreateEmptyContainer: TJclAbstractContainerBase;
  5762. begin
  5763. Result := TJclWideStrIntfSortedMap.Create(FSize);
  5764. AssignPropertiesTo(Result);
  5765. end;
  5766. function TJclWideStrIntfSortedMap.FreeKey(var Key: WideString): WideString;
  5767. begin
  5768. Result := Key;
  5769. Key := '';
  5770. end;
  5771. function TJclWideStrIntfSortedMap.FreeValue(var Value: IInterface): IInterface;
  5772. begin
  5773. Result := Value;
  5774. Value := nil;
  5775. end;
  5776. function TJclWideStrIntfSortedMap.KeysCompare(const A, B: WideString): Integer;
  5777. begin
  5778. Result := ItemsCompare(A, B);
  5779. end;
  5780. function TJclWideStrIntfSortedMap.ValuesCompare(const A, B: IInterface): Integer;
  5781. begin
  5782. Result := IntfSimpleCompare(A, B);
  5783. end;
  5784. //=== { TJclIntfWideStrSortedMap } ==============================================
  5785. constructor TJclIntfWideStrSortedMap.Create(ACapacity: Integer);
  5786. begin
  5787. inherited Create();
  5788. SetCapacity(ACapacity);
  5789. end;
  5790. destructor TJclIntfWideStrSortedMap.Destroy;
  5791. begin
  5792. FReadOnly := False;
  5793. Clear;
  5794. inherited Destroy;
  5795. end;
  5796. procedure TJclIntfWideStrSortedMap.AssignDataTo(Dest: TJclAbstractContainerBase);
  5797. var
  5798. MyDest: TJclIntfWideStrSortedMap;
  5799. begin
  5800. inherited AssignDataTo(Dest);
  5801. if Dest is TJclIntfWideStrSortedMap then
  5802. begin
  5803. MyDest := TJclIntfWideStrSortedMap(Dest);
  5804. MyDest.SetCapacity(FSize);
  5805. MyDest.FEntries := FEntries;
  5806. MyDest.FSize := FSize;
  5807. end;
  5808. end;
  5809. function TJclIntfWideStrSortedMap.BinarySearch(const Key: IInterface): Integer;
  5810. var
  5811. HiPos, LoPos, CompPos: Integer;
  5812. Comp: Integer;
  5813. begin
  5814. {$IFDEF THREADSAFE}
  5815. if FThreadSafe then
  5816. SyncReaderWriter.BeginRead;
  5817. try
  5818. {$ENDIF THREADSAFE}
  5819. LoPos := 0;
  5820. HiPos := FSize - 1;
  5821. CompPos := (HiPos + LoPos) div 2;
  5822. while HiPos >= LoPos do
  5823. begin
  5824. Comp := KeysCompare(FEntries[CompPos].Key, Key);
  5825. if Comp < 0 then
  5826. LoPos := CompPos + 1
  5827. else
  5828. if Comp > 0 then
  5829. HiPos := CompPos - 1
  5830. else
  5831. begin
  5832. HiPos := CompPos;
  5833. LoPos := CompPos + 1;
  5834. end;
  5835. CompPos := (HiPos + LoPos) div 2;
  5836. end;
  5837. Result := HiPos;
  5838. {$IFDEF THREADSAFE}
  5839. finally
  5840. if FThreadSafe then
  5841. SyncReaderWriter.EndRead;
  5842. end;
  5843. {$ENDIF THREADSAFE}
  5844. end;
  5845. procedure TJclIntfWideStrSortedMap.Clear;
  5846. var
  5847. Index: Integer;
  5848. begin
  5849. if ReadOnly then
  5850. raise EJclReadOnlyError.Create;
  5851. {$IFDEF THREADSAFE}
  5852. if FThreadSafe then
  5853. SyncReaderWriter.BeginWrite;
  5854. try
  5855. {$ENDIF THREADSAFE}
  5856. for Index := 0 to FSize - 1 do
  5857. begin
  5858. FreeKey(FEntries[Index].Key);
  5859. FreeValue(FEntries[Index].Value);
  5860. end;
  5861. FSize := 0;
  5862. AutoPack;
  5863. {$IFDEF THREADSAFE}
  5864. finally
  5865. if FThreadSafe then
  5866. SyncReaderWriter.EndWrite;
  5867. end;
  5868. {$ENDIF THREADSAFE}
  5869. end;
  5870. function TJclIntfWideStrSortedMap.ContainsKey(const Key: IInterface): Boolean;
  5871. var
  5872. Index: Integer;
  5873. begin
  5874. {$IFDEF THREADSAFE}
  5875. if FThreadSafe then
  5876. SyncReaderWriter.BeginRead;
  5877. try
  5878. {$ENDIF THREADSAFE}
  5879. Index := BinarySearch(Key);
  5880. Result := (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0);
  5881. {$IFDEF THREADSAFE}
  5882. finally
  5883. if FThreadSafe then
  5884. SyncReaderWriter.EndRead;
  5885. end;
  5886. {$ENDIF THREADSAFE}
  5887. end;
  5888. function TJclIntfWideStrSortedMap.ContainsValue(const Value: WideString): Boolean;
  5889. var
  5890. Index: Integer;
  5891. begin
  5892. {$IFDEF THREADSAFE}
  5893. if FThreadSafe then
  5894. SyncReaderWriter.BeginRead;
  5895. try
  5896. {$ENDIF THREADSAFE}
  5897. Result := False;
  5898. for Index := 0 to FSize - 1 do
  5899. if ValuesCompare(FEntries[Index].Value, Value) = 0 then
  5900. begin
  5901. Result := True;
  5902. Break;
  5903. end;
  5904. {$IFDEF THREADSAFE}
  5905. finally
  5906. if FThreadSafe then
  5907. SyncReaderWriter.EndRead;
  5908. end;
  5909. {$ENDIF THREADSAFE}
  5910. end;
  5911. function TJclIntfWideStrSortedMap.FirstKey: IInterface;
  5912. begin
  5913. {$IFDEF THREADSAFE}
  5914. if FThreadSafe then
  5915. SyncReaderWriter.BeginRead;
  5916. try
  5917. {$ENDIF THREADSAFE}
  5918. Result := nil;
  5919. if FSize > 0 then
  5920. Result := FEntries[0].Key
  5921. else
  5922. if not FReturnDefaultElements then
  5923. raise EJclNoSuchElementError.Create('');
  5924. {$IFDEF THREADSAFE}
  5925. finally
  5926. if FThreadSafe then
  5927. SyncReaderWriter.EndRead;
  5928. end;
  5929. {$ENDIF THREADSAFE}
  5930. end;
  5931. function TJclIntfWideStrSortedMap.Extract(const Key: IInterface): WideString;
  5932. var
  5933. Index: Integer;
  5934. begin
  5935. if ReadOnly then
  5936. raise EJclReadOnlyError.Create;
  5937. {$IFDEF THREADSAFE}
  5938. if FThreadSafe then
  5939. SyncReaderWriter.BeginWrite;
  5940. try
  5941. {$ENDIF THREADSAFE}
  5942. Index := BinarySearch(Key);
  5943. if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then
  5944. begin
  5945. Result := FEntries[Index].Value;
  5946. FEntries[Index].Value := '';
  5947. FreeKey(FEntries[Index].Key);
  5948. if Index < (FSize - 1) then
  5949. MoveArray(FEntries, Index + 1, Index, FSize - Index - 1);
  5950. Dec(FSize);
  5951. AutoPack;
  5952. end
  5953. else
  5954. Result := '';
  5955. {$IFDEF THREADSAFE}
  5956. finally
  5957. if FThreadSafe then
  5958. SyncReaderWriter.EndWrite;
  5959. end;
  5960. {$ENDIF THREADSAFE}
  5961. end;
  5962. function TJclIntfWideStrSortedMap.GetValue(const Key: IInterface): WideString;
  5963. var
  5964. Index: Integer;
  5965. begin
  5966. {$IFDEF THREADSAFE}
  5967. if FThreadSafe then
  5968. SyncReaderWriter.BeginRead;
  5969. try
  5970. {$ENDIF THREADSAFE}
  5971. Index := BinarySearch(Key);
  5972. Result := '';
  5973. if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then
  5974. Result := FEntries[Index].Value
  5975. else if not FReturnDefaultElements then
  5976. raise EJclNoSuchElementError.Create('');
  5977. {$IFDEF THREADSAFE}
  5978. finally
  5979. if FThreadSafe then
  5980. SyncReaderWriter.EndRead;
  5981. end;
  5982. {$ENDIF THREADSAFE}
  5983. end;
  5984. function TJclIntfWideStrSortedMap.HeadMap(const ToKey: IInterface): IJclIntfWideStrSortedMap;
  5985. var
  5986. ToIndex: Integer;
  5987. NewMap: TJclIntfWideStrSortedMap;
  5988. begin
  5989. {$IFDEF THREADSAFE}
  5990. if FThreadSafe then
  5991. SyncReaderWriter.BeginRead;
  5992. try
  5993. {$ENDIF THREADSAFE}
  5994. NewMap := CreateEmptyContainer as TJclIntfWideStrSortedMap;
  5995. ToIndex := BinarySearch(ToKey);
  5996. if ToIndex >= 0 then
  5997. begin
  5998. NewMap.SetCapacity(ToIndex + 1);
  5999. NewMap.FSize := ToIndex + 1;
  6000. while ToIndex >= 0 do
  6001. begin
  6002. NewMap.FEntries[ToIndex] := FEntries[ToIndex];
  6003. Dec(ToIndex);
  6004. end;
  6005. end;
  6006. Result := NewMap;
  6007. {$IFDEF THREADSAFE}
  6008. finally
  6009. if FThreadSafe then
  6010. SyncReaderWriter.EndRead;
  6011. end;
  6012. {$ENDIF THREADSAFE}
  6013. end;
  6014. function TJclIntfWideStrSortedMap.IsEmpty: Boolean;
  6015. begin
  6016. {$IFDEF THREADSAFE}
  6017. if FThreadSafe then
  6018. SyncReaderWriter.BeginRead;
  6019. try
  6020. {$ENDIF THREADSAFE}
  6021. Result := FSize = 0;
  6022. {$IFDEF THREADSAFE}
  6023. finally
  6024. if FThreadSafe then
  6025. SyncReaderWriter.EndRead;
  6026. end;
  6027. {$ENDIF THREADSAFE}
  6028. end;
  6029. function TJclIntfWideStrSortedMap.KeyOfValue(const Value: WideString): IInterface;
  6030. var
  6031. Index: Integer;
  6032. Found: Boolean;
  6033. begin
  6034. {$IFDEF THREADSAFE}
  6035. if FThreadSafe then
  6036. SyncReaderWriter.BeginRead;
  6037. try
  6038. {$ENDIF THREADSAFE}
  6039. Found := False;
  6040. Result := nil;
  6041. for Index := 0 to FSize - 1 do
  6042. if ValuesCompare(FEntries[Index].Value, Value) = 0 then
  6043. begin
  6044. Result := FEntries[Index].Key;
  6045. Found := True;
  6046. Break;
  6047. end;
  6048. if (not Found) and (not FReturnDefaultElements) then
  6049. raise EJclNoSuchElementError.Create('');
  6050. {$IFDEF THREADSAFE}
  6051. finally
  6052. if FThreadSafe then
  6053. SyncReaderWriter.EndRead;
  6054. end;
  6055. {$ENDIF THREADSAFE}
  6056. end;
  6057. function TJclIntfWideStrSortedMap.KeySet: IJclIntfSet;
  6058. var
  6059. Index: Integer;
  6060. begin
  6061. {$IFDEF THREADSAFE}
  6062. if FThreadSafe then
  6063. SyncReaderWriter.BeginRead;
  6064. try
  6065. {$ENDIF THREADSAFE}
  6066. Result := TJclIntfArraySet.Create(FSize);
  6067. for Index := 0 to FSize - 1 do
  6068. Result.Add(FEntries[Index].Key);
  6069. {$IFDEF THREADSAFE}
  6070. finally
  6071. if FThreadSafe then
  6072. SyncReaderWriter.EndRead;
  6073. end;
  6074. {$ENDIF THREADSAFE}
  6075. end;
  6076. function TJclIntfWideStrSortedMap.LastKey: IInterface;
  6077. begin
  6078. {$IFDEF THREADSAFE}
  6079. if FThreadSafe then
  6080. SyncReaderWriter.BeginRead;
  6081. try
  6082. {$ENDIF THREADSAFE}
  6083. Result := nil;
  6084. if FSize > 0 then
  6085. Result := FEntries[FSize - 1].Key
  6086. else
  6087. if not FReturnDefaultElements then
  6088. raise EJclNoSuchElementError.Create('');
  6089. {$IFDEF THREADSAFE}
  6090. finally
  6091. if FThreadSafe then
  6092. SyncReaderWriter.EndRead;
  6093. end;
  6094. {$ENDIF THREADSAFE}
  6095. end;
  6096. function TJclIntfWideStrSortedMap.MapEquals(const AMap: IJclIntfWideStrMap): Boolean;
  6097. var
  6098. It: IJclIntfIterator;
  6099. Index: Integer;
  6100. AKey: IInterface;
  6101. begin
  6102. {$IFDEF THREADSAFE}
  6103. if FThreadSafe then
  6104. SyncReaderWriter.BeginRead;
  6105. try
  6106. {$ENDIF THREADSAFE}
  6107. Result := False;
  6108. if AMap = nil then
  6109. Exit;
  6110. if FSize <> AMap.Size then
  6111. Exit;
  6112. It := AMap.KeySet.First;
  6113. Index := 0;
  6114. while It.HasNext do
  6115. begin
  6116. if Index >= FSize then
  6117. Exit;
  6118. AKey := It.Next;
  6119. if ValuesCompare(AMap.GetValue(AKey), FEntries[Index].Value) <> 0 then
  6120. Exit;
  6121. Inc(Index);
  6122. end;
  6123. Result := True;
  6124. {$IFDEF THREADSAFE}
  6125. finally
  6126. if FThreadSafe then
  6127. SyncReaderWriter.EndRead;
  6128. end;
  6129. {$ENDIF THREADSAFE}
  6130. end;
  6131. procedure TJclIntfWideStrSortedMap.FinalizeArrayBeforeMove(var List: TJclIntfWideStrSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  6132. begin
  6133. Assert(Count > 0);
  6134. if FromIndex < ToIndex then
  6135. begin
  6136. if Count > (ToIndex - FromIndex) then
  6137. Finalize(List[FromIndex + Count], ToIndex - FromIndex)
  6138. else
  6139. Finalize(List[ToIndex], Count);
  6140. end
  6141. else
  6142. if FromIndex > ToIndex then
  6143. begin
  6144. if Count > (FromIndex - ToIndex) then
  6145. Count := FromIndex - ToIndex;
  6146. Finalize(List[ToIndex], Count)
  6147. end;
  6148. end;
  6149. procedure TJclIntfWideStrSortedMap.InitializeArray(var List: TJclIntfWideStrSortedMapEntryArray; FromIndex, Count: SizeInt);
  6150. begin
  6151. {$IFDEF FPC}
  6152. while Count > 0 do
  6153. begin
  6154. Initialize(List[FromIndex]);
  6155. Inc(FromIndex);
  6156. Dec(Count);
  6157. end;
  6158. {$ELSE ~FPC}
  6159. Initialize(List[FromIndex], Count);
  6160. {$ENDIF ~FPC}
  6161. end;
  6162. procedure TJclIntfWideStrSortedMap.InitializeArrayAfterMove(var List: TJclIntfWideStrSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  6163. begin
  6164. { Keep reference counting working }
  6165. if FromIndex < ToIndex then
  6166. begin
  6167. if (ToIndex - FromIndex) < Count then
  6168. Count := ToIndex - FromIndex;
  6169. InitializeArray(List, FromIndex, Count);
  6170. end
  6171. else
  6172. if FromIndex > ToIndex then
  6173. begin
  6174. if (FromIndex - ToIndex) < Count then
  6175. InitializeArray(List, ToIndex + Count, FromIndex - ToIndex)
  6176. else
  6177. InitializeArray(List, FromIndex, Count);
  6178. end;
  6179. end;
  6180. procedure TJclIntfWideStrSortedMap.MoveArray(var List: TJclIntfWideStrSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  6181. begin
  6182. if Count > 0 then
  6183. begin
  6184. FinalizeArrayBeforeMove(List, FromIndex, ToIndex, Count);
  6185. Move(List[FromIndex], List[ToIndex], Count * SizeOf(List[0]));
  6186. InitializeArrayAfterMove(List, FromIndex, ToIndex, Count);
  6187. end;
  6188. end;
  6189. procedure TJclIntfWideStrSortedMap.PutAll(const AMap: IJclIntfWideStrMap);
  6190. var
  6191. It: IJclIntfIterator;
  6192. Key: IInterface;
  6193. begin
  6194. if ReadOnly then
  6195. raise EJclReadOnlyError.Create;
  6196. {$IFDEF THREADSAFE}
  6197. if FThreadSafe then
  6198. SyncReaderWriter.BeginWrite;
  6199. try
  6200. {$ENDIF THREADSAFE}
  6201. if AMap = nil then
  6202. Exit;
  6203. It := AMap.KeySet.First;
  6204. while It.HasNext do
  6205. begin
  6206. Key := It.Next;
  6207. PutValue(Key, AMap.GetValue(Key));
  6208. end;
  6209. {$IFDEF THREADSAFE}
  6210. finally
  6211. if FThreadSafe then
  6212. SyncReaderWriter.EndWrite;
  6213. end;
  6214. {$ENDIF THREADSAFE}
  6215. end;
  6216. procedure TJclIntfWideStrSortedMap.PutValue(const Key: IInterface; const Value: WideString);
  6217. var
  6218. Index: Integer;
  6219. begin
  6220. if ReadOnly then
  6221. raise EJclReadOnlyError.Create;
  6222. {$IFDEF THREADSAFE}
  6223. if FThreadSafe then
  6224. SyncReaderWriter.BeginWrite;
  6225. try
  6226. {$ENDIF THREADSAFE}
  6227. if FAllowDefaultElements or ((KeysCompare(Key, nil) <> 0) and (ValuesCompare(Value, '') <> 0)) then
  6228. begin
  6229. Index := BinarySearch(Key);
  6230. if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then
  6231. begin
  6232. FreeValue(FEntries[Index].Value);
  6233. FEntries[Index].Value := Value;
  6234. end
  6235. else
  6236. begin
  6237. if FSize = FCapacity then
  6238. AutoGrow;
  6239. if FSize < FCapacity then
  6240. begin
  6241. Inc(Index);
  6242. if (Index < FSize) and (KeysCompare(FEntries[Index].Key, Key) <> 0) then
  6243. MoveArray(FEntries, Index, Index + 1, FSize - Index);
  6244. FEntries[Index].Key := Key;
  6245. FEntries[Index].Value := Value;
  6246. Inc(FSize);
  6247. end;
  6248. end;
  6249. end;
  6250. {$IFDEF THREADSAFE}
  6251. finally
  6252. if FThreadSafe then
  6253. SyncReaderWriter.EndWrite;
  6254. end;
  6255. {$ENDIF THREADSAFE}
  6256. end;
  6257. function TJclIntfWideStrSortedMap.Remove(const Key: IInterface): WideString;
  6258. begin
  6259. if ReadOnly then
  6260. raise EJclReadOnlyError.Create;
  6261. {$IFDEF THREADSAFE}
  6262. if FThreadSafe then
  6263. SyncReaderWriter.BeginWrite;
  6264. try
  6265. {$ENDIF THREADSAFE}
  6266. Result := Extract(Key);
  6267. Result := FreeValue(Result);
  6268. {$IFDEF THREADSAFE}
  6269. finally
  6270. if FThreadSafe then
  6271. SyncReaderWriter.EndWrite;
  6272. end;
  6273. {$ENDIF THREADSAFE}
  6274. end;
  6275. procedure TJclIntfWideStrSortedMap.SetCapacity(Value: Integer);
  6276. begin
  6277. if ReadOnly then
  6278. raise EJclReadOnlyError.Create;
  6279. {$IFDEF THREADSAFE}
  6280. if FThreadSafe then
  6281. SyncReaderWriter.BeginWrite;
  6282. try
  6283. {$ENDIF THREADSAFE}
  6284. if FSize <= Value then
  6285. begin
  6286. SetLength(FEntries, Value);
  6287. inherited SetCapacity(Value);
  6288. end
  6289. else
  6290. raise EJclOperationNotSupportedError.Create;
  6291. {$IFDEF THREADSAFE}
  6292. finally
  6293. if FThreadSafe then
  6294. SyncReaderWriter.EndWrite;
  6295. end;
  6296. {$ENDIF THREADSAFE}
  6297. end;
  6298. function TJclIntfWideStrSortedMap.Size: Integer;
  6299. begin
  6300. Result := FSize;
  6301. end;
  6302. function TJclIntfWideStrSortedMap.SubMap(const FromKey, ToKey: IInterface): IJclIntfWideStrSortedMap;
  6303. var
  6304. FromIndex, ToIndex: Integer;
  6305. NewMap: TJclIntfWideStrSortedMap;
  6306. begin
  6307. {$IFDEF THREADSAFE}
  6308. if FThreadSafe then
  6309. SyncReaderWriter.BeginRead;
  6310. try
  6311. {$ENDIF THREADSAFE}
  6312. NewMap := CreateEmptyContainer as TJclIntfWideStrSortedMap;
  6313. FromIndex := BinarySearch(FromKey);
  6314. if (FromIndex = -1) or (KeysCompare(FEntries[FromIndex].Key, FromKey) < 0) then
  6315. Inc(FromIndex);
  6316. ToIndex := BinarySearch(ToKey);
  6317. if (FromIndex >= 0) and (FromIndex <= ToIndex) then
  6318. begin
  6319. NewMap.SetCapacity(ToIndex - FromIndex + 1);
  6320. NewMap.FSize := ToIndex - FromIndex + 1;
  6321. while ToIndex >= FromIndex do
  6322. begin
  6323. NewMap.FEntries[ToIndex - FromIndex] := FEntries[ToIndex];
  6324. Dec(ToIndex);
  6325. end;
  6326. end;
  6327. Result := NewMap;
  6328. {$IFDEF THREADSAFE}
  6329. finally
  6330. if FThreadSafe then
  6331. SyncReaderWriter.EndRead;
  6332. end;
  6333. {$ENDIF THREADSAFE}
  6334. end;
  6335. function TJclIntfWideStrSortedMap.TailMap(const FromKey: IInterface): IJclIntfWideStrSortedMap;
  6336. var
  6337. FromIndex, Index: Integer;
  6338. NewMap: TJclIntfWideStrSortedMap;
  6339. begin
  6340. {$IFDEF THREADSAFE}
  6341. if FThreadSafe then
  6342. SyncReaderWriter.BeginRead;
  6343. try
  6344. {$ENDIF THREADSAFE}
  6345. NewMap := CreateEmptyContainer as TJclIntfWideStrSortedMap;
  6346. FromIndex := BinarySearch(FromKey);
  6347. if (FromIndex = -1) or (KeysCompare(FEntries[FromIndex].Key, FromKey) < 0) then
  6348. Inc(FromIndex);
  6349. if (FromIndex >= 0) and (FromIndex < FSize) then
  6350. begin
  6351. NewMap.SetCapacity(FSize - FromIndex);
  6352. NewMap.FSize := FSize - FromIndex;
  6353. Index := FromIndex;
  6354. while Index < FSize do
  6355. begin
  6356. NewMap.FEntries[Index - FromIndex] := FEntries[Index];
  6357. Inc(Index);
  6358. end;
  6359. end;
  6360. Result := NewMap;
  6361. {$IFDEF THREADSAFE}
  6362. finally
  6363. if FThreadSafe then
  6364. SyncReaderWriter.EndRead;
  6365. end;
  6366. {$ENDIF THREADSAFE}
  6367. end;
  6368. function TJclIntfWideStrSortedMap.Values: IJclWideStrCollection;
  6369. var
  6370. Index: Integer;
  6371. begin
  6372. {$IFDEF THREADSAFE}
  6373. if FThreadSafe then
  6374. SyncReaderWriter.BeginRead;
  6375. try
  6376. {$ENDIF THREADSAFE}
  6377. Result := TJclWideStrArrayList.Create(FSize);
  6378. for Index := 0 to FSize - 1 do
  6379. Result.Add(FEntries[Index].Value);
  6380. {$IFDEF THREADSAFE}
  6381. finally
  6382. if FThreadSafe then
  6383. SyncReaderWriter.EndRead;
  6384. end;
  6385. {$ENDIF THREADSAFE}
  6386. end;
  6387. function TJclIntfWideStrSortedMap.CreateEmptyContainer: TJclAbstractContainerBase;
  6388. begin
  6389. Result := TJclIntfWideStrSortedMap.Create(FSize);
  6390. AssignPropertiesTo(Result);
  6391. end;
  6392. function TJclIntfWideStrSortedMap.FreeKey(var Key: IInterface): IInterface;
  6393. begin
  6394. Result := Key;
  6395. Key := nil;
  6396. end;
  6397. function TJclIntfWideStrSortedMap.FreeValue(var Value: WideString): WideString;
  6398. begin
  6399. Result := Value;
  6400. Value := '';
  6401. end;
  6402. function TJclIntfWideStrSortedMap.KeysCompare(const A, B: IInterface): Integer;
  6403. begin
  6404. Result := IntfSimpleCompare(A, B);
  6405. end;
  6406. function TJclIntfWideStrSortedMap.ValuesCompare(const A, B: WideString): Integer;
  6407. begin
  6408. Result := ItemsCompare(A, B);
  6409. end;
  6410. //=== { TJclWideStrWideStrSortedMap } ==============================================
  6411. constructor TJclWideStrWideStrSortedMap.Create(ACapacity: Integer);
  6412. begin
  6413. inherited Create();
  6414. SetCapacity(ACapacity);
  6415. end;
  6416. destructor TJclWideStrWideStrSortedMap.Destroy;
  6417. begin
  6418. FReadOnly := False;
  6419. Clear;
  6420. inherited Destroy;
  6421. end;
  6422. procedure TJclWideStrWideStrSortedMap.AssignDataTo(Dest: TJclAbstractContainerBase);
  6423. var
  6424. MyDest: TJclWideStrWideStrSortedMap;
  6425. begin
  6426. inherited AssignDataTo(Dest);
  6427. if Dest is TJclWideStrWideStrSortedMap then
  6428. begin
  6429. MyDest := TJclWideStrWideStrSortedMap(Dest);
  6430. MyDest.SetCapacity(FSize);
  6431. MyDest.FEntries := FEntries;
  6432. MyDest.FSize := FSize;
  6433. end;
  6434. end;
  6435. function TJclWideStrWideStrSortedMap.BinarySearch(const Key: WideString): Integer;
  6436. var
  6437. HiPos, LoPos, CompPos: Integer;
  6438. Comp: Integer;
  6439. begin
  6440. {$IFDEF THREADSAFE}
  6441. if FThreadSafe then
  6442. SyncReaderWriter.BeginRead;
  6443. try
  6444. {$ENDIF THREADSAFE}
  6445. LoPos := 0;
  6446. HiPos := FSize - 1;
  6447. CompPos := (HiPos + LoPos) div 2;
  6448. while HiPos >= LoPos do
  6449. begin
  6450. Comp := KeysCompare(FEntries[CompPos].Key, Key);
  6451. if Comp < 0 then
  6452. LoPos := CompPos + 1
  6453. else
  6454. if Comp > 0 then
  6455. HiPos := CompPos - 1
  6456. else
  6457. begin
  6458. HiPos := CompPos;
  6459. LoPos := CompPos + 1;
  6460. end;
  6461. CompPos := (HiPos + LoPos) div 2;
  6462. end;
  6463. Result := HiPos;
  6464. {$IFDEF THREADSAFE}
  6465. finally
  6466. if FThreadSafe then
  6467. SyncReaderWriter.EndRead;
  6468. end;
  6469. {$ENDIF THREADSAFE}
  6470. end;
  6471. procedure TJclWideStrWideStrSortedMap.Clear;
  6472. var
  6473. Index: Integer;
  6474. begin
  6475. if ReadOnly then
  6476. raise EJclReadOnlyError.Create;
  6477. {$IFDEF THREADSAFE}
  6478. if FThreadSafe then
  6479. SyncReaderWriter.BeginWrite;
  6480. try
  6481. {$ENDIF THREADSAFE}
  6482. for Index := 0 to FSize - 1 do
  6483. begin
  6484. FreeKey(FEntries[Index].Key);
  6485. FreeValue(FEntries[Index].Value);
  6486. end;
  6487. FSize := 0;
  6488. AutoPack;
  6489. {$IFDEF THREADSAFE}
  6490. finally
  6491. if FThreadSafe then
  6492. SyncReaderWriter.EndWrite;
  6493. end;
  6494. {$ENDIF THREADSAFE}
  6495. end;
  6496. function TJclWideStrWideStrSortedMap.ContainsKey(const Key: WideString): Boolean;
  6497. var
  6498. Index: Integer;
  6499. begin
  6500. {$IFDEF THREADSAFE}
  6501. if FThreadSafe then
  6502. SyncReaderWriter.BeginRead;
  6503. try
  6504. {$ENDIF THREADSAFE}
  6505. Index := BinarySearch(Key);
  6506. Result := (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0);
  6507. {$IFDEF THREADSAFE}
  6508. finally
  6509. if FThreadSafe then
  6510. SyncReaderWriter.EndRead;
  6511. end;
  6512. {$ENDIF THREADSAFE}
  6513. end;
  6514. function TJclWideStrWideStrSortedMap.ContainsValue(const Value: WideString): Boolean;
  6515. var
  6516. Index: Integer;
  6517. begin
  6518. {$IFDEF THREADSAFE}
  6519. if FThreadSafe then
  6520. SyncReaderWriter.BeginRead;
  6521. try
  6522. {$ENDIF THREADSAFE}
  6523. Result := False;
  6524. for Index := 0 to FSize - 1 do
  6525. if ValuesCompare(FEntries[Index].Value, Value) = 0 then
  6526. begin
  6527. Result := True;
  6528. Break;
  6529. end;
  6530. {$IFDEF THREADSAFE}
  6531. finally
  6532. if FThreadSafe then
  6533. SyncReaderWriter.EndRead;
  6534. end;
  6535. {$ENDIF THREADSAFE}
  6536. end;
  6537. function TJclWideStrWideStrSortedMap.FirstKey: WideString;
  6538. begin
  6539. {$IFDEF THREADSAFE}
  6540. if FThreadSafe then
  6541. SyncReaderWriter.BeginRead;
  6542. try
  6543. {$ENDIF THREADSAFE}
  6544. Result := '';
  6545. if FSize > 0 then
  6546. Result := FEntries[0].Key
  6547. else
  6548. if not FReturnDefaultElements then
  6549. raise EJclNoSuchElementError.Create('');
  6550. {$IFDEF THREADSAFE}
  6551. finally
  6552. if FThreadSafe then
  6553. SyncReaderWriter.EndRead;
  6554. end;
  6555. {$ENDIF THREADSAFE}
  6556. end;
  6557. function TJclWideStrWideStrSortedMap.Extract(const Key: WideString): WideString;
  6558. var
  6559. Index: Integer;
  6560. begin
  6561. if ReadOnly then
  6562. raise EJclReadOnlyError.Create;
  6563. {$IFDEF THREADSAFE}
  6564. if FThreadSafe then
  6565. SyncReaderWriter.BeginWrite;
  6566. try
  6567. {$ENDIF THREADSAFE}
  6568. Index := BinarySearch(Key);
  6569. if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then
  6570. begin
  6571. Result := FEntries[Index].Value;
  6572. FEntries[Index].Value := '';
  6573. FreeKey(FEntries[Index].Key);
  6574. if Index < (FSize - 1) then
  6575. MoveArray(FEntries, Index + 1, Index, FSize - Index - 1);
  6576. Dec(FSize);
  6577. AutoPack;
  6578. end
  6579. else
  6580. Result := '';
  6581. {$IFDEF THREADSAFE}
  6582. finally
  6583. if FThreadSafe then
  6584. SyncReaderWriter.EndWrite;
  6585. end;
  6586. {$ENDIF THREADSAFE}
  6587. end;
  6588. function TJclWideStrWideStrSortedMap.GetValue(const Key: WideString): WideString;
  6589. var
  6590. Index: Integer;
  6591. begin
  6592. {$IFDEF THREADSAFE}
  6593. if FThreadSafe then
  6594. SyncReaderWriter.BeginRead;
  6595. try
  6596. {$ENDIF THREADSAFE}
  6597. Index := BinarySearch(Key);
  6598. Result := '';
  6599. if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then
  6600. Result := FEntries[Index].Value
  6601. else if not FReturnDefaultElements then
  6602. raise EJclNoSuchElementError.Create('');
  6603. {$IFDEF THREADSAFE}
  6604. finally
  6605. if FThreadSafe then
  6606. SyncReaderWriter.EndRead;
  6607. end;
  6608. {$ENDIF THREADSAFE}
  6609. end;
  6610. function TJclWideStrWideStrSortedMap.HeadMap(const ToKey: WideString): IJclWideStrWideStrSortedMap;
  6611. var
  6612. ToIndex: Integer;
  6613. NewMap: TJclWideStrWideStrSortedMap;
  6614. begin
  6615. {$IFDEF THREADSAFE}
  6616. if FThreadSafe then
  6617. SyncReaderWriter.BeginRead;
  6618. try
  6619. {$ENDIF THREADSAFE}
  6620. NewMap := CreateEmptyContainer as TJclWideStrWideStrSortedMap;
  6621. ToIndex := BinarySearch(ToKey);
  6622. if ToIndex >= 0 then
  6623. begin
  6624. NewMap.SetCapacity(ToIndex + 1);
  6625. NewMap.FSize := ToIndex + 1;
  6626. while ToIndex >= 0 do
  6627. begin
  6628. NewMap.FEntries[ToIndex] := FEntries[ToIndex];
  6629. Dec(ToIndex);
  6630. end;
  6631. end;
  6632. Result := NewMap;
  6633. {$IFDEF THREADSAFE}
  6634. finally
  6635. if FThreadSafe then
  6636. SyncReaderWriter.EndRead;
  6637. end;
  6638. {$ENDIF THREADSAFE}
  6639. end;
  6640. function TJclWideStrWideStrSortedMap.IsEmpty: Boolean;
  6641. begin
  6642. {$IFDEF THREADSAFE}
  6643. if FThreadSafe then
  6644. SyncReaderWriter.BeginRead;
  6645. try
  6646. {$ENDIF THREADSAFE}
  6647. Result := FSize = 0;
  6648. {$IFDEF THREADSAFE}
  6649. finally
  6650. if FThreadSafe then
  6651. SyncReaderWriter.EndRead;
  6652. end;
  6653. {$ENDIF THREADSAFE}
  6654. end;
  6655. function TJclWideStrWideStrSortedMap.KeyOfValue(const Value: WideString): WideString;
  6656. var
  6657. Index: Integer;
  6658. Found: Boolean;
  6659. begin
  6660. {$IFDEF THREADSAFE}
  6661. if FThreadSafe then
  6662. SyncReaderWriter.BeginRead;
  6663. try
  6664. {$ENDIF THREADSAFE}
  6665. Found := False;
  6666. Result := '';
  6667. for Index := 0 to FSize - 1 do
  6668. if ValuesCompare(FEntries[Index].Value, Value) = 0 then
  6669. begin
  6670. Result := FEntries[Index].Key;
  6671. Found := True;
  6672. Break;
  6673. end;
  6674. if (not Found) and (not FReturnDefaultElements) then
  6675. raise EJclNoSuchElementError.Create('');
  6676. {$IFDEF THREADSAFE}
  6677. finally
  6678. if FThreadSafe then
  6679. SyncReaderWriter.EndRead;
  6680. end;
  6681. {$ENDIF THREADSAFE}
  6682. end;
  6683. function TJclWideStrWideStrSortedMap.KeySet: IJclWideStrSet;
  6684. var
  6685. Index: Integer;
  6686. begin
  6687. {$IFDEF THREADSAFE}
  6688. if FThreadSafe then
  6689. SyncReaderWriter.BeginRead;
  6690. try
  6691. {$ENDIF THREADSAFE}
  6692. Result := TJclWideStrArraySet.Create(FSize);
  6693. for Index := 0 to FSize - 1 do
  6694. Result.Add(FEntries[Index].Key);
  6695. {$IFDEF THREADSAFE}
  6696. finally
  6697. if FThreadSafe then
  6698. SyncReaderWriter.EndRead;
  6699. end;
  6700. {$ENDIF THREADSAFE}
  6701. end;
  6702. function TJclWideStrWideStrSortedMap.LastKey: WideString;
  6703. begin
  6704. {$IFDEF THREADSAFE}
  6705. if FThreadSafe then
  6706. SyncReaderWriter.BeginRead;
  6707. try
  6708. {$ENDIF THREADSAFE}
  6709. Result := '';
  6710. if FSize > 0 then
  6711. Result := FEntries[FSize - 1].Key
  6712. else
  6713. if not FReturnDefaultElements then
  6714. raise EJclNoSuchElementError.Create('');
  6715. {$IFDEF THREADSAFE}
  6716. finally
  6717. if FThreadSafe then
  6718. SyncReaderWriter.EndRead;
  6719. end;
  6720. {$ENDIF THREADSAFE}
  6721. end;
  6722. function TJclWideStrWideStrSortedMap.MapEquals(const AMap: IJclWideStrWideStrMap): Boolean;
  6723. var
  6724. It: IJclWideStrIterator;
  6725. Index: Integer;
  6726. AKey: WideString;
  6727. begin
  6728. {$IFDEF THREADSAFE}
  6729. if FThreadSafe then
  6730. SyncReaderWriter.BeginRead;
  6731. try
  6732. {$ENDIF THREADSAFE}
  6733. Result := False;
  6734. if AMap = nil then
  6735. Exit;
  6736. if FSize <> AMap.Size then
  6737. Exit;
  6738. It := AMap.KeySet.First;
  6739. Index := 0;
  6740. while It.HasNext do
  6741. begin
  6742. if Index >= FSize then
  6743. Exit;
  6744. AKey := It.Next;
  6745. if ValuesCompare(AMap.GetValue(AKey), FEntries[Index].Value) <> 0 then
  6746. Exit;
  6747. Inc(Index);
  6748. end;
  6749. Result := True;
  6750. {$IFDEF THREADSAFE}
  6751. finally
  6752. if FThreadSafe then
  6753. SyncReaderWriter.EndRead;
  6754. end;
  6755. {$ENDIF THREADSAFE}
  6756. end;
  6757. procedure TJclWideStrWideStrSortedMap.FinalizeArrayBeforeMove(var List: TJclWideStrWideStrSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  6758. begin
  6759. Assert(Count > 0);
  6760. if FromIndex < ToIndex then
  6761. begin
  6762. if Count > (ToIndex - FromIndex) then
  6763. Finalize(List[FromIndex + Count], ToIndex - FromIndex)
  6764. else
  6765. Finalize(List[ToIndex], Count);
  6766. end
  6767. else
  6768. if FromIndex > ToIndex then
  6769. begin
  6770. if Count > (FromIndex - ToIndex) then
  6771. Count := FromIndex - ToIndex;
  6772. Finalize(List[ToIndex], Count)
  6773. end;
  6774. end;
  6775. procedure TJclWideStrWideStrSortedMap.InitializeArray(var List: TJclWideStrWideStrSortedMapEntryArray; FromIndex, Count: SizeInt);
  6776. begin
  6777. {$IFDEF FPC}
  6778. while Count > 0 do
  6779. begin
  6780. Initialize(List[FromIndex]);
  6781. Inc(FromIndex);
  6782. Dec(Count);
  6783. end;
  6784. {$ELSE ~FPC}
  6785. Initialize(List[FromIndex], Count);
  6786. {$ENDIF ~FPC}
  6787. end;
  6788. procedure TJclWideStrWideStrSortedMap.InitializeArrayAfterMove(var List: TJclWideStrWideStrSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  6789. begin
  6790. { Keep reference counting working }
  6791. if FromIndex < ToIndex then
  6792. begin
  6793. if (ToIndex - FromIndex) < Count then
  6794. Count := ToIndex - FromIndex;
  6795. InitializeArray(List, FromIndex, Count);
  6796. end
  6797. else
  6798. if FromIndex > ToIndex then
  6799. begin
  6800. if (FromIndex - ToIndex) < Count then
  6801. InitializeArray(List, ToIndex + Count, FromIndex - ToIndex)
  6802. else
  6803. InitializeArray(List, FromIndex, Count);
  6804. end;
  6805. end;
  6806. procedure TJclWideStrWideStrSortedMap.MoveArray(var List: TJclWideStrWideStrSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  6807. begin
  6808. if Count > 0 then
  6809. begin
  6810. FinalizeArrayBeforeMove(List, FromIndex, ToIndex, Count);
  6811. Move(List[FromIndex], List[ToIndex], Count * SizeOf(List[0]));
  6812. InitializeArrayAfterMove(List, FromIndex, ToIndex, Count);
  6813. end;
  6814. end;
  6815. procedure TJclWideStrWideStrSortedMap.PutAll(const AMap: IJclWideStrWideStrMap);
  6816. var
  6817. It: IJclWideStrIterator;
  6818. Key: WideString;
  6819. begin
  6820. if ReadOnly then
  6821. raise EJclReadOnlyError.Create;
  6822. {$IFDEF THREADSAFE}
  6823. if FThreadSafe then
  6824. SyncReaderWriter.BeginWrite;
  6825. try
  6826. {$ENDIF THREADSAFE}
  6827. if AMap = nil then
  6828. Exit;
  6829. It := AMap.KeySet.First;
  6830. while It.HasNext do
  6831. begin
  6832. Key := It.Next;
  6833. PutValue(Key, AMap.GetValue(Key));
  6834. end;
  6835. {$IFDEF THREADSAFE}
  6836. finally
  6837. if FThreadSafe then
  6838. SyncReaderWriter.EndWrite;
  6839. end;
  6840. {$ENDIF THREADSAFE}
  6841. end;
  6842. procedure TJclWideStrWideStrSortedMap.PutValue(const Key: WideString; const Value: WideString);
  6843. var
  6844. Index: Integer;
  6845. begin
  6846. if ReadOnly then
  6847. raise EJclReadOnlyError.Create;
  6848. {$IFDEF THREADSAFE}
  6849. if FThreadSafe then
  6850. SyncReaderWriter.BeginWrite;
  6851. try
  6852. {$ENDIF THREADSAFE}
  6853. if FAllowDefaultElements or ((KeysCompare(Key, '') <> 0) and (ValuesCompare(Value, '') <> 0)) then
  6854. begin
  6855. Index := BinarySearch(Key);
  6856. if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then
  6857. begin
  6858. FreeValue(FEntries[Index].Value);
  6859. FEntries[Index].Value := Value;
  6860. end
  6861. else
  6862. begin
  6863. if FSize = FCapacity then
  6864. AutoGrow;
  6865. if FSize < FCapacity then
  6866. begin
  6867. Inc(Index);
  6868. if (Index < FSize) and (KeysCompare(FEntries[Index].Key, Key) <> 0) then
  6869. MoveArray(FEntries, Index, Index + 1, FSize - Index);
  6870. FEntries[Index].Key := Key;
  6871. FEntries[Index].Value := Value;
  6872. Inc(FSize);
  6873. end;
  6874. end;
  6875. end;
  6876. {$IFDEF THREADSAFE}
  6877. finally
  6878. if FThreadSafe then
  6879. SyncReaderWriter.EndWrite;
  6880. end;
  6881. {$ENDIF THREADSAFE}
  6882. end;
  6883. function TJclWideStrWideStrSortedMap.Remove(const Key: WideString): WideString;
  6884. begin
  6885. if ReadOnly then
  6886. raise EJclReadOnlyError.Create;
  6887. {$IFDEF THREADSAFE}
  6888. if FThreadSafe then
  6889. SyncReaderWriter.BeginWrite;
  6890. try
  6891. {$ENDIF THREADSAFE}
  6892. Result := Extract(Key);
  6893. Result := FreeValue(Result);
  6894. {$IFDEF THREADSAFE}
  6895. finally
  6896. if FThreadSafe then
  6897. SyncReaderWriter.EndWrite;
  6898. end;
  6899. {$ENDIF THREADSAFE}
  6900. end;
  6901. procedure TJclWideStrWideStrSortedMap.SetCapacity(Value: Integer);
  6902. begin
  6903. if ReadOnly then
  6904. raise EJclReadOnlyError.Create;
  6905. {$IFDEF THREADSAFE}
  6906. if FThreadSafe then
  6907. SyncReaderWriter.BeginWrite;
  6908. try
  6909. {$ENDIF THREADSAFE}
  6910. if FSize <= Value then
  6911. begin
  6912. SetLength(FEntries, Value);
  6913. inherited SetCapacity(Value);
  6914. end
  6915. else
  6916. raise EJclOperationNotSupportedError.Create;
  6917. {$IFDEF THREADSAFE}
  6918. finally
  6919. if FThreadSafe then
  6920. SyncReaderWriter.EndWrite;
  6921. end;
  6922. {$ENDIF THREADSAFE}
  6923. end;
  6924. function TJclWideStrWideStrSortedMap.Size: Integer;
  6925. begin
  6926. Result := FSize;
  6927. end;
  6928. function TJclWideStrWideStrSortedMap.SubMap(const FromKey, ToKey: WideString): IJclWideStrWideStrSortedMap;
  6929. var
  6930. FromIndex, ToIndex: Integer;
  6931. NewMap: TJclWideStrWideStrSortedMap;
  6932. begin
  6933. {$IFDEF THREADSAFE}
  6934. if FThreadSafe then
  6935. SyncReaderWriter.BeginRead;
  6936. try
  6937. {$ENDIF THREADSAFE}
  6938. NewMap := CreateEmptyContainer as TJclWideStrWideStrSortedMap;
  6939. FromIndex := BinarySearch(FromKey);
  6940. if (FromIndex = -1) or (KeysCompare(FEntries[FromIndex].Key, FromKey) < 0) then
  6941. Inc(FromIndex);
  6942. ToIndex := BinarySearch(ToKey);
  6943. if (FromIndex >= 0) and (FromIndex <= ToIndex) then
  6944. begin
  6945. NewMap.SetCapacity(ToIndex - FromIndex + 1);
  6946. NewMap.FSize := ToIndex - FromIndex + 1;
  6947. while ToIndex >= FromIndex do
  6948. begin
  6949. NewMap.FEntries[ToIndex - FromIndex] := FEntries[ToIndex];
  6950. Dec(ToIndex);
  6951. end;
  6952. end;
  6953. Result := NewMap;
  6954. {$IFDEF THREADSAFE}
  6955. finally
  6956. if FThreadSafe then
  6957. SyncReaderWriter.EndRead;
  6958. end;
  6959. {$ENDIF THREADSAFE}
  6960. end;
  6961. function TJclWideStrWideStrSortedMap.TailMap(const FromKey: WideString): IJclWideStrWideStrSortedMap;
  6962. var
  6963. FromIndex, Index: Integer;
  6964. NewMap: TJclWideStrWideStrSortedMap;
  6965. begin
  6966. {$IFDEF THREADSAFE}
  6967. if FThreadSafe then
  6968. SyncReaderWriter.BeginRead;
  6969. try
  6970. {$ENDIF THREADSAFE}
  6971. NewMap := CreateEmptyContainer as TJclWideStrWideStrSortedMap;
  6972. FromIndex := BinarySearch(FromKey);
  6973. if (FromIndex = -1) or (KeysCompare(FEntries[FromIndex].Key, FromKey) < 0) then
  6974. Inc(FromIndex);
  6975. if (FromIndex >= 0) and (FromIndex < FSize) then
  6976. begin
  6977. NewMap.SetCapacity(FSize - FromIndex);
  6978. NewMap.FSize := FSize - FromIndex;
  6979. Index := FromIndex;
  6980. while Index < FSize do
  6981. begin
  6982. NewMap.FEntries[Index - FromIndex] := FEntries[Index];
  6983. Inc(Index);
  6984. end;
  6985. end;
  6986. Result := NewMap;
  6987. {$IFDEF THREADSAFE}
  6988. finally
  6989. if FThreadSafe then
  6990. SyncReaderWriter.EndRead;
  6991. end;
  6992. {$ENDIF THREADSAFE}
  6993. end;
  6994. function TJclWideStrWideStrSortedMap.Values: IJclWideStrCollection;
  6995. var
  6996. Index: Integer;
  6997. begin
  6998. {$IFDEF THREADSAFE}
  6999. if FThreadSafe then
  7000. SyncReaderWriter.BeginRead;
  7001. try
  7002. {$ENDIF THREADSAFE}
  7003. Result := TJclWideStrArrayList.Create(FSize);
  7004. for Index := 0 to FSize - 1 do
  7005. Result.Add(FEntries[Index].Value);
  7006. {$IFDEF THREADSAFE}
  7007. finally
  7008. if FThreadSafe then
  7009. SyncReaderWriter.EndRead;
  7010. end;
  7011. {$ENDIF THREADSAFE}
  7012. end;
  7013. function TJclWideStrWideStrSortedMap.CreateEmptyContainer: TJclAbstractContainerBase;
  7014. begin
  7015. Result := TJclWideStrWideStrSortedMap.Create(FSize);
  7016. AssignPropertiesTo(Result);
  7017. end;
  7018. function TJclWideStrWideStrSortedMap.FreeKey(var Key: WideString): WideString;
  7019. begin
  7020. Result := Key;
  7021. Key := '';
  7022. end;
  7023. function TJclWideStrWideStrSortedMap.FreeValue(var Value: WideString): WideString;
  7024. begin
  7025. Result := Value;
  7026. Value := '';
  7027. end;
  7028. function TJclWideStrWideStrSortedMap.KeysCompare(const A, B: WideString): Integer;
  7029. begin
  7030. Result := ItemsCompare(A, B);
  7031. end;
  7032. function TJclWideStrWideStrSortedMap.ValuesCompare(const A, B: WideString): Integer;
  7033. begin
  7034. Result := ItemsCompare(A, B);
  7035. end;
  7036. {$IFDEF SUPPORTS_UNICODE_STRING}
  7037. //=== { TJclUnicodeStrIntfSortedMap } ==============================================
  7038. constructor TJclUnicodeStrIntfSortedMap.Create(ACapacity: Integer);
  7039. begin
  7040. inherited Create();
  7041. SetCapacity(ACapacity);
  7042. end;
  7043. destructor TJclUnicodeStrIntfSortedMap.Destroy;
  7044. begin
  7045. FReadOnly := False;
  7046. Clear;
  7047. inherited Destroy;
  7048. end;
  7049. procedure TJclUnicodeStrIntfSortedMap.AssignDataTo(Dest: TJclAbstractContainerBase);
  7050. var
  7051. MyDest: TJclUnicodeStrIntfSortedMap;
  7052. begin
  7053. inherited AssignDataTo(Dest);
  7054. if Dest is TJclUnicodeStrIntfSortedMap then
  7055. begin
  7056. MyDest := TJclUnicodeStrIntfSortedMap(Dest);
  7057. MyDest.SetCapacity(FSize);
  7058. MyDest.FEntries := FEntries;
  7059. MyDest.FSize := FSize;
  7060. end;
  7061. end;
  7062. function TJclUnicodeStrIntfSortedMap.BinarySearch(const Key: UnicodeString): Integer;
  7063. var
  7064. HiPos, LoPos, CompPos: Integer;
  7065. Comp: Integer;
  7066. begin
  7067. {$IFDEF THREADSAFE}
  7068. if FThreadSafe then
  7069. SyncReaderWriter.BeginRead;
  7070. try
  7071. {$ENDIF THREADSAFE}
  7072. LoPos := 0;
  7073. HiPos := FSize - 1;
  7074. CompPos := (HiPos + LoPos) div 2;
  7075. while HiPos >= LoPos do
  7076. begin
  7077. Comp := KeysCompare(FEntries[CompPos].Key, Key);
  7078. if Comp < 0 then
  7079. LoPos := CompPos + 1
  7080. else
  7081. if Comp > 0 then
  7082. HiPos := CompPos - 1
  7083. else
  7084. begin
  7085. HiPos := CompPos;
  7086. LoPos := CompPos + 1;
  7087. end;
  7088. CompPos := (HiPos + LoPos) div 2;
  7089. end;
  7090. Result := HiPos;
  7091. {$IFDEF THREADSAFE}
  7092. finally
  7093. if FThreadSafe then
  7094. SyncReaderWriter.EndRead;
  7095. end;
  7096. {$ENDIF THREADSAFE}
  7097. end;
  7098. procedure TJclUnicodeStrIntfSortedMap.Clear;
  7099. var
  7100. Index: Integer;
  7101. begin
  7102. if ReadOnly then
  7103. raise EJclReadOnlyError.Create;
  7104. {$IFDEF THREADSAFE}
  7105. if FThreadSafe then
  7106. SyncReaderWriter.BeginWrite;
  7107. try
  7108. {$ENDIF THREADSAFE}
  7109. for Index := 0 to FSize - 1 do
  7110. begin
  7111. FreeKey(FEntries[Index].Key);
  7112. FreeValue(FEntries[Index].Value);
  7113. end;
  7114. FSize := 0;
  7115. AutoPack;
  7116. {$IFDEF THREADSAFE}
  7117. finally
  7118. if FThreadSafe then
  7119. SyncReaderWriter.EndWrite;
  7120. end;
  7121. {$ENDIF THREADSAFE}
  7122. end;
  7123. function TJclUnicodeStrIntfSortedMap.ContainsKey(const Key: UnicodeString): Boolean;
  7124. var
  7125. Index: Integer;
  7126. begin
  7127. {$IFDEF THREADSAFE}
  7128. if FThreadSafe then
  7129. SyncReaderWriter.BeginRead;
  7130. try
  7131. {$ENDIF THREADSAFE}
  7132. Index := BinarySearch(Key);
  7133. Result := (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0);
  7134. {$IFDEF THREADSAFE}
  7135. finally
  7136. if FThreadSafe then
  7137. SyncReaderWriter.EndRead;
  7138. end;
  7139. {$ENDIF THREADSAFE}
  7140. end;
  7141. function TJclUnicodeStrIntfSortedMap.ContainsValue(const Value: IInterface): Boolean;
  7142. var
  7143. Index: Integer;
  7144. begin
  7145. {$IFDEF THREADSAFE}
  7146. if FThreadSafe then
  7147. SyncReaderWriter.BeginRead;
  7148. try
  7149. {$ENDIF THREADSAFE}
  7150. Result := False;
  7151. for Index := 0 to FSize - 1 do
  7152. if ValuesCompare(FEntries[Index].Value, Value) = 0 then
  7153. begin
  7154. Result := True;
  7155. Break;
  7156. end;
  7157. {$IFDEF THREADSAFE}
  7158. finally
  7159. if FThreadSafe then
  7160. SyncReaderWriter.EndRead;
  7161. end;
  7162. {$ENDIF THREADSAFE}
  7163. end;
  7164. function TJclUnicodeStrIntfSortedMap.FirstKey: UnicodeString;
  7165. begin
  7166. {$IFDEF THREADSAFE}
  7167. if FThreadSafe then
  7168. SyncReaderWriter.BeginRead;
  7169. try
  7170. {$ENDIF THREADSAFE}
  7171. Result := '';
  7172. if FSize > 0 then
  7173. Result := FEntries[0].Key
  7174. else
  7175. if not FReturnDefaultElements then
  7176. raise EJclNoSuchElementError.Create('');
  7177. {$IFDEF THREADSAFE}
  7178. finally
  7179. if FThreadSafe then
  7180. SyncReaderWriter.EndRead;
  7181. end;
  7182. {$ENDIF THREADSAFE}
  7183. end;
  7184. function TJclUnicodeStrIntfSortedMap.Extract(const Key: UnicodeString): IInterface;
  7185. var
  7186. Index: Integer;
  7187. begin
  7188. if ReadOnly then
  7189. raise EJclReadOnlyError.Create;
  7190. {$IFDEF THREADSAFE}
  7191. if FThreadSafe then
  7192. SyncReaderWriter.BeginWrite;
  7193. try
  7194. {$ENDIF THREADSAFE}
  7195. Index := BinarySearch(Key);
  7196. if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then
  7197. begin
  7198. Result := FEntries[Index].Value;
  7199. FEntries[Index].Value := nil;
  7200. FreeKey(FEntries[Index].Key);
  7201. if Index < (FSize - 1) then
  7202. MoveArray(FEntries, Index + 1, Index, FSize - Index - 1);
  7203. Dec(FSize);
  7204. AutoPack;
  7205. end
  7206. else
  7207. Result := nil;
  7208. {$IFDEF THREADSAFE}
  7209. finally
  7210. if FThreadSafe then
  7211. SyncReaderWriter.EndWrite;
  7212. end;
  7213. {$ENDIF THREADSAFE}
  7214. end;
  7215. function TJclUnicodeStrIntfSortedMap.GetValue(const Key: UnicodeString): IInterface;
  7216. var
  7217. Index: Integer;
  7218. begin
  7219. {$IFDEF THREADSAFE}
  7220. if FThreadSafe then
  7221. SyncReaderWriter.BeginRead;
  7222. try
  7223. {$ENDIF THREADSAFE}
  7224. Index := BinarySearch(Key);
  7225. Result := nil;
  7226. if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then
  7227. Result := FEntries[Index].Value
  7228. else if not FReturnDefaultElements then
  7229. raise EJclNoSuchElementError.Create('');
  7230. {$IFDEF THREADSAFE}
  7231. finally
  7232. if FThreadSafe then
  7233. SyncReaderWriter.EndRead;
  7234. end;
  7235. {$ENDIF THREADSAFE}
  7236. end;
  7237. function TJclUnicodeStrIntfSortedMap.HeadMap(const ToKey: UnicodeString): IJclUnicodeStrIntfSortedMap;
  7238. var
  7239. ToIndex: Integer;
  7240. NewMap: TJclUnicodeStrIntfSortedMap;
  7241. begin
  7242. {$IFDEF THREADSAFE}
  7243. if FThreadSafe then
  7244. SyncReaderWriter.BeginRead;
  7245. try
  7246. {$ENDIF THREADSAFE}
  7247. NewMap := CreateEmptyContainer as TJclUnicodeStrIntfSortedMap;
  7248. ToIndex := BinarySearch(ToKey);
  7249. if ToIndex >= 0 then
  7250. begin
  7251. NewMap.SetCapacity(ToIndex + 1);
  7252. NewMap.FSize := ToIndex + 1;
  7253. while ToIndex >= 0 do
  7254. begin
  7255. NewMap.FEntries[ToIndex] := FEntries[ToIndex];
  7256. Dec(ToIndex);
  7257. end;
  7258. end;
  7259. Result := NewMap;
  7260. {$IFDEF THREADSAFE}
  7261. finally
  7262. if FThreadSafe then
  7263. SyncReaderWriter.EndRead;
  7264. end;
  7265. {$ENDIF THREADSAFE}
  7266. end;
  7267. function TJclUnicodeStrIntfSortedMap.IsEmpty: Boolean;
  7268. begin
  7269. {$IFDEF THREADSAFE}
  7270. if FThreadSafe then
  7271. SyncReaderWriter.BeginRead;
  7272. try
  7273. {$ENDIF THREADSAFE}
  7274. Result := FSize = 0;
  7275. {$IFDEF THREADSAFE}
  7276. finally
  7277. if FThreadSafe then
  7278. SyncReaderWriter.EndRead;
  7279. end;
  7280. {$ENDIF THREADSAFE}
  7281. end;
  7282. function TJclUnicodeStrIntfSortedMap.KeyOfValue(const Value: IInterface): UnicodeString;
  7283. var
  7284. Index: Integer;
  7285. Found: Boolean;
  7286. begin
  7287. {$IFDEF THREADSAFE}
  7288. if FThreadSafe then
  7289. SyncReaderWriter.BeginRead;
  7290. try
  7291. {$ENDIF THREADSAFE}
  7292. Found := False;
  7293. Result := '';
  7294. for Index := 0 to FSize - 1 do
  7295. if ValuesCompare(FEntries[Index].Value, Value) = 0 then
  7296. begin
  7297. Result := FEntries[Index].Key;
  7298. Found := True;
  7299. Break;
  7300. end;
  7301. if (not Found) and (not FReturnDefaultElements) then
  7302. raise EJclNoSuchElementError.Create('');
  7303. {$IFDEF THREADSAFE}
  7304. finally
  7305. if FThreadSafe then
  7306. SyncReaderWriter.EndRead;
  7307. end;
  7308. {$ENDIF THREADSAFE}
  7309. end;
  7310. function TJclUnicodeStrIntfSortedMap.KeySet: IJclUnicodeStrSet;
  7311. var
  7312. Index: Integer;
  7313. begin
  7314. {$IFDEF THREADSAFE}
  7315. if FThreadSafe then
  7316. SyncReaderWriter.BeginRead;
  7317. try
  7318. {$ENDIF THREADSAFE}
  7319. Result := TJclUnicodeStrArraySet.Create(FSize);
  7320. for Index := 0 to FSize - 1 do
  7321. Result.Add(FEntries[Index].Key);
  7322. {$IFDEF THREADSAFE}
  7323. finally
  7324. if FThreadSafe then
  7325. SyncReaderWriter.EndRead;
  7326. end;
  7327. {$ENDIF THREADSAFE}
  7328. end;
  7329. function TJclUnicodeStrIntfSortedMap.LastKey: UnicodeString;
  7330. begin
  7331. {$IFDEF THREADSAFE}
  7332. if FThreadSafe then
  7333. SyncReaderWriter.BeginRead;
  7334. try
  7335. {$ENDIF THREADSAFE}
  7336. Result := '';
  7337. if FSize > 0 then
  7338. Result := FEntries[FSize - 1].Key
  7339. else
  7340. if not FReturnDefaultElements then
  7341. raise EJclNoSuchElementError.Create('');
  7342. {$IFDEF THREADSAFE}
  7343. finally
  7344. if FThreadSafe then
  7345. SyncReaderWriter.EndRead;
  7346. end;
  7347. {$ENDIF THREADSAFE}
  7348. end;
  7349. function TJclUnicodeStrIntfSortedMap.MapEquals(const AMap: IJclUnicodeStrIntfMap): Boolean;
  7350. var
  7351. It: IJclUnicodeStrIterator;
  7352. Index: Integer;
  7353. AKey: UnicodeString;
  7354. begin
  7355. {$IFDEF THREADSAFE}
  7356. if FThreadSafe then
  7357. SyncReaderWriter.BeginRead;
  7358. try
  7359. {$ENDIF THREADSAFE}
  7360. Result := False;
  7361. if AMap = nil then
  7362. Exit;
  7363. if FSize <> AMap.Size then
  7364. Exit;
  7365. It := AMap.KeySet.First;
  7366. Index := 0;
  7367. while It.HasNext do
  7368. begin
  7369. if Index >= FSize then
  7370. Exit;
  7371. AKey := It.Next;
  7372. if ValuesCompare(AMap.GetValue(AKey), FEntries[Index].Value) <> 0 then
  7373. Exit;
  7374. Inc(Index);
  7375. end;
  7376. Result := True;
  7377. {$IFDEF THREADSAFE}
  7378. finally
  7379. if FThreadSafe then
  7380. SyncReaderWriter.EndRead;
  7381. end;
  7382. {$ENDIF THREADSAFE}
  7383. end;
  7384. procedure TJclUnicodeStrIntfSortedMap.FinalizeArrayBeforeMove(var List: TJclUnicodeStrIntfSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  7385. begin
  7386. Assert(Count > 0);
  7387. if FromIndex < ToIndex then
  7388. begin
  7389. if Count > (ToIndex - FromIndex) then
  7390. Finalize(List[FromIndex + Count], ToIndex - FromIndex)
  7391. else
  7392. Finalize(List[ToIndex], Count);
  7393. end
  7394. else
  7395. if FromIndex > ToIndex then
  7396. begin
  7397. if Count > (FromIndex - ToIndex) then
  7398. Count := FromIndex - ToIndex;
  7399. Finalize(List[ToIndex], Count)
  7400. end;
  7401. end;
  7402. procedure TJclUnicodeStrIntfSortedMap.InitializeArray(var List: TJclUnicodeStrIntfSortedMapEntryArray; FromIndex, Count: SizeInt);
  7403. begin
  7404. {$IFDEF FPC}
  7405. while Count > 0 do
  7406. begin
  7407. Initialize(List[FromIndex]);
  7408. Inc(FromIndex);
  7409. Dec(Count);
  7410. end;
  7411. {$ELSE ~FPC}
  7412. Initialize(List[FromIndex], Count);
  7413. {$ENDIF ~FPC}
  7414. end;
  7415. procedure TJclUnicodeStrIntfSortedMap.InitializeArrayAfterMove(var List: TJclUnicodeStrIntfSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  7416. begin
  7417. { Keep reference counting working }
  7418. if FromIndex < ToIndex then
  7419. begin
  7420. if (ToIndex - FromIndex) < Count then
  7421. Count := ToIndex - FromIndex;
  7422. InitializeArray(List, FromIndex, Count);
  7423. end
  7424. else
  7425. if FromIndex > ToIndex then
  7426. begin
  7427. if (FromIndex - ToIndex) < Count then
  7428. InitializeArray(List, ToIndex + Count, FromIndex - ToIndex)
  7429. else
  7430. InitializeArray(List, FromIndex, Count);
  7431. end;
  7432. end;
  7433. procedure TJclUnicodeStrIntfSortedMap.MoveArray(var List: TJclUnicodeStrIntfSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  7434. begin
  7435. if Count > 0 then
  7436. begin
  7437. FinalizeArrayBeforeMove(List, FromIndex, ToIndex, Count);
  7438. Move(List[FromIndex], List[ToIndex], Count * SizeOf(List[0]));
  7439. InitializeArrayAfterMove(List, FromIndex, ToIndex, Count);
  7440. end;
  7441. end;
  7442. procedure TJclUnicodeStrIntfSortedMap.PutAll(const AMap: IJclUnicodeStrIntfMap);
  7443. var
  7444. It: IJclUnicodeStrIterator;
  7445. Key: UnicodeString;
  7446. begin
  7447. if ReadOnly then
  7448. raise EJclReadOnlyError.Create;
  7449. {$IFDEF THREADSAFE}
  7450. if FThreadSafe then
  7451. SyncReaderWriter.BeginWrite;
  7452. try
  7453. {$ENDIF THREADSAFE}
  7454. if AMap = nil then
  7455. Exit;
  7456. It := AMap.KeySet.First;
  7457. while It.HasNext do
  7458. begin
  7459. Key := It.Next;
  7460. PutValue(Key, AMap.GetValue(Key));
  7461. end;
  7462. {$IFDEF THREADSAFE}
  7463. finally
  7464. if FThreadSafe then
  7465. SyncReaderWriter.EndWrite;
  7466. end;
  7467. {$ENDIF THREADSAFE}
  7468. end;
  7469. procedure TJclUnicodeStrIntfSortedMap.PutValue(const Key: UnicodeString; const Value: IInterface);
  7470. var
  7471. Index: Integer;
  7472. begin
  7473. if ReadOnly then
  7474. raise EJclReadOnlyError.Create;
  7475. {$IFDEF THREADSAFE}
  7476. if FThreadSafe then
  7477. SyncReaderWriter.BeginWrite;
  7478. try
  7479. {$ENDIF THREADSAFE}
  7480. if FAllowDefaultElements or ((KeysCompare(Key, '') <> 0) and (ValuesCompare(Value, nil) <> 0)) then
  7481. begin
  7482. Index := BinarySearch(Key);
  7483. if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then
  7484. begin
  7485. FreeValue(FEntries[Index].Value);
  7486. FEntries[Index].Value := Value;
  7487. end
  7488. else
  7489. begin
  7490. if FSize = FCapacity then
  7491. AutoGrow;
  7492. if FSize < FCapacity then
  7493. begin
  7494. Inc(Index);
  7495. if (Index < FSize) and (KeysCompare(FEntries[Index].Key, Key) <> 0) then
  7496. MoveArray(FEntries, Index, Index + 1, FSize - Index);
  7497. FEntries[Index].Key := Key;
  7498. FEntries[Index].Value := Value;
  7499. Inc(FSize);
  7500. end;
  7501. end;
  7502. end;
  7503. {$IFDEF THREADSAFE}
  7504. finally
  7505. if FThreadSafe then
  7506. SyncReaderWriter.EndWrite;
  7507. end;
  7508. {$ENDIF THREADSAFE}
  7509. end;
  7510. function TJclUnicodeStrIntfSortedMap.Remove(const Key: UnicodeString): IInterface;
  7511. begin
  7512. if ReadOnly then
  7513. raise EJclReadOnlyError.Create;
  7514. {$IFDEF THREADSAFE}
  7515. if FThreadSafe then
  7516. SyncReaderWriter.BeginWrite;
  7517. try
  7518. {$ENDIF THREADSAFE}
  7519. Result := Extract(Key);
  7520. Result := FreeValue(Result);
  7521. {$IFDEF THREADSAFE}
  7522. finally
  7523. if FThreadSafe then
  7524. SyncReaderWriter.EndWrite;
  7525. end;
  7526. {$ENDIF THREADSAFE}
  7527. end;
  7528. procedure TJclUnicodeStrIntfSortedMap.SetCapacity(Value: Integer);
  7529. begin
  7530. if ReadOnly then
  7531. raise EJclReadOnlyError.Create;
  7532. {$IFDEF THREADSAFE}
  7533. if FThreadSafe then
  7534. SyncReaderWriter.BeginWrite;
  7535. try
  7536. {$ENDIF THREADSAFE}
  7537. if FSize <= Value then
  7538. begin
  7539. SetLength(FEntries, Value);
  7540. inherited SetCapacity(Value);
  7541. end
  7542. else
  7543. raise EJclOperationNotSupportedError.Create;
  7544. {$IFDEF THREADSAFE}
  7545. finally
  7546. if FThreadSafe then
  7547. SyncReaderWriter.EndWrite;
  7548. end;
  7549. {$ENDIF THREADSAFE}
  7550. end;
  7551. function TJclUnicodeStrIntfSortedMap.Size: Integer;
  7552. begin
  7553. Result := FSize;
  7554. end;
  7555. function TJclUnicodeStrIntfSortedMap.SubMap(const FromKey, ToKey: UnicodeString): IJclUnicodeStrIntfSortedMap;
  7556. var
  7557. FromIndex, ToIndex: Integer;
  7558. NewMap: TJclUnicodeStrIntfSortedMap;
  7559. begin
  7560. {$IFDEF THREADSAFE}
  7561. if FThreadSafe then
  7562. SyncReaderWriter.BeginRead;
  7563. try
  7564. {$ENDIF THREADSAFE}
  7565. NewMap := CreateEmptyContainer as TJclUnicodeStrIntfSortedMap;
  7566. FromIndex := BinarySearch(FromKey);
  7567. if (FromIndex = -1) or (KeysCompare(FEntries[FromIndex].Key, FromKey) < 0) then
  7568. Inc(FromIndex);
  7569. ToIndex := BinarySearch(ToKey);
  7570. if (FromIndex >= 0) and (FromIndex <= ToIndex) then
  7571. begin
  7572. NewMap.SetCapacity(ToIndex - FromIndex + 1);
  7573. NewMap.FSize := ToIndex - FromIndex + 1;
  7574. while ToIndex >= FromIndex do
  7575. begin
  7576. NewMap.FEntries[ToIndex - FromIndex] := FEntries[ToIndex];
  7577. Dec(ToIndex);
  7578. end;
  7579. end;
  7580. Result := NewMap;
  7581. {$IFDEF THREADSAFE}
  7582. finally
  7583. if FThreadSafe then
  7584. SyncReaderWriter.EndRead;
  7585. end;
  7586. {$ENDIF THREADSAFE}
  7587. end;
  7588. function TJclUnicodeStrIntfSortedMap.TailMap(const FromKey: UnicodeString): IJclUnicodeStrIntfSortedMap;
  7589. var
  7590. FromIndex, Index: Integer;
  7591. NewMap: TJclUnicodeStrIntfSortedMap;
  7592. begin
  7593. {$IFDEF THREADSAFE}
  7594. if FThreadSafe then
  7595. SyncReaderWriter.BeginRead;
  7596. try
  7597. {$ENDIF THREADSAFE}
  7598. NewMap := CreateEmptyContainer as TJclUnicodeStrIntfSortedMap;
  7599. FromIndex := BinarySearch(FromKey);
  7600. if (FromIndex = -1) or (KeysCompare(FEntries[FromIndex].Key, FromKey) < 0) then
  7601. Inc(FromIndex);
  7602. if (FromIndex >= 0) and (FromIndex < FSize) then
  7603. begin
  7604. NewMap.SetCapacity(FSize - FromIndex);
  7605. NewMap.FSize := FSize - FromIndex;
  7606. Index := FromIndex;
  7607. while Index < FSize do
  7608. begin
  7609. NewMap.FEntries[Index - FromIndex] := FEntries[Index];
  7610. Inc(Index);
  7611. end;
  7612. end;
  7613. Result := NewMap;
  7614. {$IFDEF THREADSAFE}
  7615. finally
  7616. if FThreadSafe then
  7617. SyncReaderWriter.EndRead;
  7618. end;
  7619. {$ENDIF THREADSAFE}
  7620. end;
  7621. function TJclUnicodeStrIntfSortedMap.Values: IJclIntfCollection;
  7622. var
  7623. Index: Integer;
  7624. begin
  7625. {$IFDEF THREADSAFE}
  7626. if FThreadSafe then
  7627. SyncReaderWriter.BeginRead;
  7628. try
  7629. {$ENDIF THREADSAFE}
  7630. Result := TJclIntfArrayList.Create(FSize);
  7631. for Index := 0 to FSize - 1 do
  7632. Result.Add(FEntries[Index].Value);
  7633. {$IFDEF THREADSAFE}
  7634. finally
  7635. if FThreadSafe then
  7636. SyncReaderWriter.EndRead;
  7637. end;
  7638. {$ENDIF THREADSAFE}
  7639. end;
  7640. function TJclUnicodeStrIntfSortedMap.CreateEmptyContainer: TJclAbstractContainerBase;
  7641. begin
  7642. Result := TJclUnicodeStrIntfSortedMap.Create(FSize);
  7643. AssignPropertiesTo(Result);
  7644. end;
  7645. function TJclUnicodeStrIntfSortedMap.FreeKey(var Key: UnicodeString): UnicodeString;
  7646. begin
  7647. Result := Key;
  7648. Key := '';
  7649. end;
  7650. function TJclUnicodeStrIntfSortedMap.FreeValue(var Value: IInterface): IInterface;
  7651. begin
  7652. Result := Value;
  7653. Value := nil;
  7654. end;
  7655. function TJclUnicodeStrIntfSortedMap.KeysCompare(const A, B: UnicodeString): Integer;
  7656. begin
  7657. Result := ItemsCompare(A, B);
  7658. end;
  7659. function TJclUnicodeStrIntfSortedMap.ValuesCompare(const A, B: IInterface): Integer;
  7660. begin
  7661. Result := IntfSimpleCompare(A, B);
  7662. end;
  7663. {$ENDIF SUPPORTS_UNICODE_STRING}
  7664. {$IFDEF SUPPORTS_UNICODE_STRING}
  7665. //=== { TJclIntfUnicodeStrSortedMap } ==============================================
  7666. constructor TJclIntfUnicodeStrSortedMap.Create(ACapacity: Integer);
  7667. begin
  7668. inherited Create();
  7669. SetCapacity(ACapacity);
  7670. end;
  7671. destructor TJclIntfUnicodeStrSortedMap.Destroy;
  7672. begin
  7673. FReadOnly := False;
  7674. Clear;
  7675. inherited Destroy;
  7676. end;
  7677. procedure TJclIntfUnicodeStrSortedMap.AssignDataTo(Dest: TJclAbstractContainerBase);
  7678. var
  7679. MyDest: TJclIntfUnicodeStrSortedMap;
  7680. begin
  7681. inherited AssignDataTo(Dest);
  7682. if Dest is TJclIntfUnicodeStrSortedMap then
  7683. begin
  7684. MyDest := TJclIntfUnicodeStrSortedMap(Dest);
  7685. MyDest.SetCapacity(FSize);
  7686. MyDest.FEntries := FEntries;
  7687. MyDest.FSize := FSize;
  7688. end;
  7689. end;
  7690. function TJclIntfUnicodeStrSortedMap.BinarySearch(const Key: IInterface): Integer;
  7691. var
  7692. HiPos, LoPos, CompPos: Integer;
  7693. Comp: Integer;
  7694. begin
  7695. {$IFDEF THREADSAFE}
  7696. if FThreadSafe then
  7697. SyncReaderWriter.BeginRead;
  7698. try
  7699. {$ENDIF THREADSAFE}
  7700. LoPos := 0;
  7701. HiPos := FSize - 1;
  7702. CompPos := (HiPos + LoPos) div 2;
  7703. while HiPos >= LoPos do
  7704. begin
  7705. Comp := KeysCompare(FEntries[CompPos].Key, Key);
  7706. if Comp < 0 then
  7707. LoPos := CompPos + 1
  7708. else
  7709. if Comp > 0 then
  7710. HiPos := CompPos - 1
  7711. else
  7712. begin
  7713. HiPos := CompPos;
  7714. LoPos := CompPos + 1;
  7715. end;
  7716. CompPos := (HiPos + LoPos) div 2;
  7717. end;
  7718. Result := HiPos;
  7719. {$IFDEF THREADSAFE}
  7720. finally
  7721. if FThreadSafe then
  7722. SyncReaderWriter.EndRead;
  7723. end;
  7724. {$ENDIF THREADSAFE}
  7725. end;
  7726. procedure TJclIntfUnicodeStrSortedMap.Clear;
  7727. var
  7728. Index: Integer;
  7729. begin
  7730. if ReadOnly then
  7731. raise EJclReadOnlyError.Create;
  7732. {$IFDEF THREADSAFE}
  7733. if FThreadSafe then
  7734. SyncReaderWriter.BeginWrite;
  7735. try
  7736. {$ENDIF THREADSAFE}
  7737. for Index := 0 to FSize - 1 do
  7738. begin
  7739. FreeKey(FEntries[Index].Key);
  7740. FreeValue(FEntries[Index].Value);
  7741. end;
  7742. FSize := 0;
  7743. AutoPack;
  7744. {$IFDEF THREADSAFE}
  7745. finally
  7746. if FThreadSafe then
  7747. SyncReaderWriter.EndWrite;
  7748. end;
  7749. {$ENDIF THREADSAFE}
  7750. end;
  7751. function TJclIntfUnicodeStrSortedMap.ContainsKey(const Key: IInterface): Boolean;
  7752. var
  7753. Index: Integer;
  7754. begin
  7755. {$IFDEF THREADSAFE}
  7756. if FThreadSafe then
  7757. SyncReaderWriter.BeginRead;
  7758. try
  7759. {$ENDIF THREADSAFE}
  7760. Index := BinarySearch(Key);
  7761. Result := (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0);
  7762. {$IFDEF THREADSAFE}
  7763. finally
  7764. if FThreadSafe then
  7765. SyncReaderWriter.EndRead;
  7766. end;
  7767. {$ENDIF THREADSAFE}
  7768. end;
  7769. function TJclIntfUnicodeStrSortedMap.ContainsValue(const Value: UnicodeString): Boolean;
  7770. var
  7771. Index: Integer;
  7772. begin
  7773. {$IFDEF THREADSAFE}
  7774. if FThreadSafe then
  7775. SyncReaderWriter.BeginRead;
  7776. try
  7777. {$ENDIF THREADSAFE}
  7778. Result := False;
  7779. for Index := 0 to FSize - 1 do
  7780. if ValuesCompare(FEntries[Index].Value, Value) = 0 then
  7781. begin
  7782. Result := True;
  7783. Break;
  7784. end;
  7785. {$IFDEF THREADSAFE}
  7786. finally
  7787. if FThreadSafe then
  7788. SyncReaderWriter.EndRead;
  7789. end;
  7790. {$ENDIF THREADSAFE}
  7791. end;
  7792. function TJclIntfUnicodeStrSortedMap.FirstKey: IInterface;
  7793. begin
  7794. {$IFDEF THREADSAFE}
  7795. if FThreadSafe then
  7796. SyncReaderWriter.BeginRead;
  7797. try
  7798. {$ENDIF THREADSAFE}
  7799. Result := nil;
  7800. if FSize > 0 then
  7801. Result := FEntries[0].Key
  7802. else
  7803. if not FReturnDefaultElements then
  7804. raise EJclNoSuchElementError.Create('');
  7805. {$IFDEF THREADSAFE}
  7806. finally
  7807. if FThreadSafe then
  7808. SyncReaderWriter.EndRead;
  7809. end;
  7810. {$ENDIF THREADSAFE}
  7811. end;
  7812. function TJclIntfUnicodeStrSortedMap.Extract(const Key: IInterface): UnicodeString;
  7813. var
  7814. Index: Integer;
  7815. begin
  7816. if ReadOnly then
  7817. raise EJclReadOnlyError.Create;
  7818. {$IFDEF THREADSAFE}
  7819. if FThreadSafe then
  7820. SyncReaderWriter.BeginWrite;
  7821. try
  7822. {$ENDIF THREADSAFE}
  7823. Index := BinarySearch(Key);
  7824. if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then
  7825. begin
  7826. Result := FEntries[Index].Value;
  7827. FEntries[Index].Value := '';
  7828. FreeKey(FEntries[Index].Key);
  7829. if Index < (FSize - 1) then
  7830. MoveArray(FEntries, Index + 1, Index, FSize - Index - 1);
  7831. Dec(FSize);
  7832. AutoPack;
  7833. end
  7834. else
  7835. Result := '';
  7836. {$IFDEF THREADSAFE}
  7837. finally
  7838. if FThreadSafe then
  7839. SyncReaderWriter.EndWrite;
  7840. end;
  7841. {$ENDIF THREADSAFE}
  7842. end;
  7843. function TJclIntfUnicodeStrSortedMap.GetValue(const Key: IInterface): UnicodeString;
  7844. var
  7845. Index: Integer;
  7846. begin
  7847. {$IFDEF THREADSAFE}
  7848. if FThreadSafe then
  7849. SyncReaderWriter.BeginRead;
  7850. try
  7851. {$ENDIF THREADSAFE}
  7852. Index := BinarySearch(Key);
  7853. Result := '';
  7854. if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then
  7855. Result := FEntries[Index].Value
  7856. else if not FReturnDefaultElements then
  7857. raise EJclNoSuchElementError.Create('');
  7858. {$IFDEF THREADSAFE}
  7859. finally
  7860. if FThreadSafe then
  7861. SyncReaderWriter.EndRead;
  7862. end;
  7863. {$ENDIF THREADSAFE}
  7864. end;
  7865. function TJclIntfUnicodeStrSortedMap.HeadMap(const ToKey: IInterface): IJclIntfUnicodeStrSortedMap;
  7866. var
  7867. ToIndex: Integer;
  7868. NewMap: TJclIntfUnicodeStrSortedMap;
  7869. begin
  7870. {$IFDEF THREADSAFE}
  7871. if FThreadSafe then
  7872. SyncReaderWriter.BeginRead;
  7873. try
  7874. {$ENDIF THREADSAFE}
  7875. NewMap := CreateEmptyContainer as TJclIntfUnicodeStrSortedMap;
  7876. ToIndex := BinarySearch(ToKey);
  7877. if ToIndex >= 0 then
  7878. begin
  7879. NewMap.SetCapacity(ToIndex + 1);
  7880. NewMap.FSize := ToIndex + 1;
  7881. while ToIndex >= 0 do
  7882. begin
  7883. NewMap.FEntries[ToIndex] := FEntries[ToIndex];
  7884. Dec(ToIndex);
  7885. end;
  7886. end;
  7887. Result := NewMap;
  7888. {$IFDEF THREADSAFE}
  7889. finally
  7890. if FThreadSafe then
  7891. SyncReaderWriter.EndRead;
  7892. end;
  7893. {$ENDIF THREADSAFE}
  7894. end;
  7895. function TJclIntfUnicodeStrSortedMap.IsEmpty: Boolean;
  7896. begin
  7897. {$IFDEF THREADSAFE}
  7898. if FThreadSafe then
  7899. SyncReaderWriter.BeginRead;
  7900. try
  7901. {$ENDIF THREADSAFE}
  7902. Result := FSize = 0;
  7903. {$IFDEF THREADSAFE}
  7904. finally
  7905. if FThreadSafe then
  7906. SyncReaderWriter.EndRead;
  7907. end;
  7908. {$ENDIF THREADSAFE}
  7909. end;
  7910. function TJclIntfUnicodeStrSortedMap.KeyOfValue(const Value: UnicodeString): IInterface;
  7911. var
  7912. Index: Integer;
  7913. Found: Boolean;
  7914. begin
  7915. {$IFDEF THREADSAFE}
  7916. if FThreadSafe then
  7917. SyncReaderWriter.BeginRead;
  7918. try
  7919. {$ENDIF THREADSAFE}
  7920. Found := False;
  7921. Result := nil;
  7922. for Index := 0 to FSize - 1 do
  7923. if ValuesCompare(FEntries[Index].Value, Value) = 0 then
  7924. begin
  7925. Result := FEntries[Index].Key;
  7926. Found := True;
  7927. Break;
  7928. end;
  7929. if (not Found) and (not FReturnDefaultElements) then
  7930. raise EJclNoSuchElementError.Create('');
  7931. {$IFDEF THREADSAFE}
  7932. finally
  7933. if FThreadSafe then
  7934. SyncReaderWriter.EndRead;
  7935. end;
  7936. {$ENDIF THREADSAFE}
  7937. end;
  7938. function TJclIntfUnicodeStrSortedMap.KeySet: IJclIntfSet;
  7939. var
  7940. Index: Integer;
  7941. begin
  7942. {$IFDEF THREADSAFE}
  7943. if FThreadSafe then
  7944. SyncReaderWriter.BeginRead;
  7945. try
  7946. {$ENDIF THREADSAFE}
  7947. Result := TJclIntfArraySet.Create(FSize);
  7948. for Index := 0 to FSize - 1 do
  7949. Result.Add(FEntries[Index].Key);
  7950. {$IFDEF THREADSAFE}
  7951. finally
  7952. if FThreadSafe then
  7953. SyncReaderWriter.EndRead;
  7954. end;
  7955. {$ENDIF THREADSAFE}
  7956. end;
  7957. function TJclIntfUnicodeStrSortedMap.LastKey: IInterface;
  7958. begin
  7959. {$IFDEF THREADSAFE}
  7960. if FThreadSafe then
  7961. SyncReaderWriter.BeginRead;
  7962. try
  7963. {$ENDIF THREADSAFE}
  7964. Result := nil;
  7965. if FSize > 0 then
  7966. Result := FEntries[FSize - 1].Key
  7967. else
  7968. if not FReturnDefaultElements then
  7969. raise EJclNoSuchElementError.Create('');
  7970. {$IFDEF THREADSAFE}
  7971. finally
  7972. if FThreadSafe then
  7973. SyncReaderWriter.EndRead;
  7974. end;
  7975. {$ENDIF THREADSAFE}
  7976. end;
  7977. function TJclIntfUnicodeStrSortedMap.MapEquals(const AMap: IJclIntfUnicodeStrMap): Boolean;
  7978. var
  7979. It: IJclIntfIterator;
  7980. Index: Integer;
  7981. AKey: IInterface;
  7982. begin
  7983. {$IFDEF THREADSAFE}
  7984. if FThreadSafe then
  7985. SyncReaderWriter.BeginRead;
  7986. try
  7987. {$ENDIF THREADSAFE}
  7988. Result := False;
  7989. if AMap = nil then
  7990. Exit;
  7991. if FSize <> AMap.Size then
  7992. Exit;
  7993. It := AMap.KeySet.First;
  7994. Index := 0;
  7995. while It.HasNext do
  7996. begin
  7997. if Index >= FSize then
  7998. Exit;
  7999. AKey := It.Next;
  8000. if ValuesCompare(AMap.GetValue(AKey), FEntries[Index].Value) <> 0 then
  8001. Exit;
  8002. Inc(Index);
  8003. end;
  8004. Result := True;
  8005. {$IFDEF THREADSAFE}
  8006. finally
  8007. if FThreadSafe then
  8008. SyncReaderWriter.EndRead;
  8009. end;
  8010. {$ENDIF THREADSAFE}
  8011. end;
  8012. procedure TJclIntfUnicodeStrSortedMap.FinalizeArrayBeforeMove(var List: TJclIntfUnicodeStrSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  8013. begin
  8014. Assert(Count > 0);
  8015. if FromIndex < ToIndex then
  8016. begin
  8017. if Count > (ToIndex - FromIndex) then
  8018. Finalize(List[FromIndex + Count], ToIndex - FromIndex)
  8019. else
  8020. Finalize(List[ToIndex], Count);
  8021. end
  8022. else
  8023. if FromIndex > ToIndex then
  8024. begin
  8025. if Count > (FromIndex - ToIndex) then
  8026. Count := FromIndex - ToIndex;
  8027. Finalize(List[ToIndex], Count)
  8028. end;
  8029. end;
  8030. procedure TJclIntfUnicodeStrSortedMap.InitializeArray(var List: TJclIntfUnicodeStrSortedMapEntryArray; FromIndex, Count: SizeInt);
  8031. begin
  8032. {$IFDEF FPC}
  8033. while Count > 0 do
  8034. begin
  8035. Initialize(List[FromIndex]);
  8036. Inc(FromIndex);
  8037. Dec(Count);
  8038. end;
  8039. {$ELSE ~FPC}
  8040. Initialize(List[FromIndex], Count);
  8041. {$ENDIF ~FPC}
  8042. end;
  8043. procedure TJclIntfUnicodeStrSortedMap.InitializeArrayAfterMove(var List: TJclIntfUnicodeStrSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  8044. begin
  8045. { Keep reference counting working }
  8046. if FromIndex < ToIndex then
  8047. begin
  8048. if (ToIndex - FromIndex) < Count then
  8049. Count := ToIndex - FromIndex;
  8050. InitializeArray(List, FromIndex, Count);
  8051. end
  8052. else
  8053. if FromIndex > ToIndex then
  8054. begin
  8055. if (FromIndex - ToIndex) < Count then
  8056. InitializeArray(List, ToIndex + Count, FromIndex - ToIndex)
  8057. else
  8058. InitializeArray(List, FromIndex, Count);
  8059. end;
  8060. end;
  8061. procedure TJclIntfUnicodeStrSortedMap.MoveArray(var List: TJclIntfUnicodeStrSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  8062. begin
  8063. if Count > 0 then
  8064. begin
  8065. FinalizeArrayBeforeMove(List, FromIndex, ToIndex, Count);
  8066. Move(List[FromIndex], List[ToIndex], Count * SizeOf(List[0]));
  8067. InitializeArrayAfterMove(List, FromIndex, ToIndex, Count);
  8068. end;
  8069. end;
  8070. procedure TJclIntfUnicodeStrSortedMap.PutAll(const AMap: IJclIntfUnicodeStrMap);
  8071. var
  8072. It: IJclIntfIterator;
  8073. Key: IInterface;
  8074. begin
  8075. if ReadOnly then
  8076. raise EJclReadOnlyError.Create;
  8077. {$IFDEF THREADSAFE}
  8078. if FThreadSafe then
  8079. SyncReaderWriter.BeginWrite;
  8080. try
  8081. {$ENDIF THREADSAFE}
  8082. if AMap = nil then
  8083. Exit;
  8084. It := AMap.KeySet.First;
  8085. while It.HasNext do
  8086. begin
  8087. Key := It.Next;
  8088. PutValue(Key, AMap.GetValue(Key));
  8089. end;
  8090. {$IFDEF THREADSAFE}
  8091. finally
  8092. if FThreadSafe then
  8093. SyncReaderWriter.EndWrite;
  8094. end;
  8095. {$ENDIF THREADSAFE}
  8096. end;
  8097. procedure TJclIntfUnicodeStrSortedMap.PutValue(const Key: IInterface; const Value: UnicodeString);
  8098. var
  8099. Index: Integer;
  8100. begin
  8101. if ReadOnly then
  8102. raise EJclReadOnlyError.Create;
  8103. {$IFDEF THREADSAFE}
  8104. if FThreadSafe then
  8105. SyncReaderWriter.BeginWrite;
  8106. try
  8107. {$ENDIF THREADSAFE}
  8108. if FAllowDefaultElements or ((KeysCompare(Key, nil) <> 0) and (ValuesCompare(Value, '') <> 0)) then
  8109. begin
  8110. Index := BinarySearch(Key);
  8111. if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then
  8112. begin
  8113. FreeValue(FEntries[Index].Value);
  8114. FEntries[Index].Value := Value;
  8115. end
  8116. else
  8117. begin
  8118. if FSize = FCapacity then
  8119. AutoGrow;
  8120. if FSize < FCapacity then
  8121. begin
  8122. Inc(Index);
  8123. if (Index < FSize) and (KeysCompare(FEntries[Index].Key, Key) <> 0) then
  8124. MoveArray(FEntries, Index, Index + 1, FSize - Index);
  8125. FEntries[Index].Key := Key;
  8126. FEntries[Index].Value := Value;
  8127. Inc(FSize);
  8128. end;
  8129. end;
  8130. end;
  8131. {$IFDEF THREADSAFE}
  8132. finally
  8133. if FThreadSafe then
  8134. SyncReaderWriter.EndWrite;
  8135. end;
  8136. {$ENDIF THREADSAFE}
  8137. end;
  8138. function TJclIntfUnicodeStrSortedMap.Remove(const Key: IInterface): UnicodeString;
  8139. begin
  8140. if ReadOnly then
  8141. raise EJclReadOnlyError.Create;
  8142. {$IFDEF THREADSAFE}
  8143. if FThreadSafe then
  8144. SyncReaderWriter.BeginWrite;
  8145. try
  8146. {$ENDIF THREADSAFE}
  8147. Result := Extract(Key);
  8148. Result := FreeValue(Result);
  8149. {$IFDEF THREADSAFE}
  8150. finally
  8151. if FThreadSafe then
  8152. SyncReaderWriter.EndWrite;
  8153. end;
  8154. {$ENDIF THREADSAFE}
  8155. end;
  8156. procedure TJclIntfUnicodeStrSortedMap.SetCapacity(Value: Integer);
  8157. begin
  8158. if ReadOnly then
  8159. raise EJclReadOnlyError.Create;
  8160. {$IFDEF THREADSAFE}
  8161. if FThreadSafe then
  8162. SyncReaderWriter.BeginWrite;
  8163. try
  8164. {$ENDIF THREADSAFE}
  8165. if FSize <= Value then
  8166. begin
  8167. SetLength(FEntries, Value);
  8168. inherited SetCapacity(Value);
  8169. end
  8170. else
  8171. raise EJclOperationNotSupportedError.Create;
  8172. {$IFDEF THREADSAFE}
  8173. finally
  8174. if FThreadSafe then
  8175. SyncReaderWriter.EndWrite;
  8176. end;
  8177. {$ENDIF THREADSAFE}
  8178. end;
  8179. function TJclIntfUnicodeStrSortedMap.Size: Integer;
  8180. begin
  8181. Result := FSize;
  8182. end;
  8183. function TJclIntfUnicodeStrSortedMap.SubMap(const FromKey, ToKey: IInterface): IJclIntfUnicodeStrSortedMap;
  8184. var
  8185. FromIndex, ToIndex: Integer;
  8186. NewMap: TJclIntfUnicodeStrSortedMap;
  8187. begin
  8188. {$IFDEF THREADSAFE}
  8189. if FThreadSafe then
  8190. SyncReaderWriter.BeginRead;
  8191. try
  8192. {$ENDIF THREADSAFE}
  8193. NewMap := CreateEmptyContainer as TJclIntfUnicodeStrSortedMap;
  8194. FromIndex := BinarySearch(FromKey);
  8195. if (FromIndex = -1) or (KeysCompare(FEntries[FromIndex].Key, FromKey) < 0) then
  8196. Inc(FromIndex);
  8197. ToIndex := BinarySearch(ToKey);
  8198. if (FromIndex >= 0) and (FromIndex <= ToIndex) then
  8199. begin
  8200. NewMap.SetCapacity(ToIndex - FromIndex + 1);
  8201. NewMap.FSize := ToIndex - FromIndex + 1;
  8202. while ToIndex >= FromIndex do
  8203. begin
  8204. NewMap.FEntries[ToIndex - FromIndex] := FEntries[ToIndex];
  8205. Dec(ToIndex);
  8206. end;
  8207. end;
  8208. Result := NewMap;
  8209. {$IFDEF THREADSAFE}
  8210. finally
  8211. if FThreadSafe then
  8212. SyncReaderWriter.EndRead;
  8213. end;
  8214. {$ENDIF THREADSAFE}
  8215. end;
  8216. function TJclIntfUnicodeStrSortedMap.TailMap(const FromKey: IInterface): IJclIntfUnicodeStrSortedMap;
  8217. var
  8218. FromIndex, Index: Integer;
  8219. NewMap: TJclIntfUnicodeStrSortedMap;
  8220. begin
  8221. {$IFDEF THREADSAFE}
  8222. if FThreadSafe then
  8223. SyncReaderWriter.BeginRead;
  8224. try
  8225. {$ENDIF THREADSAFE}
  8226. NewMap := CreateEmptyContainer as TJclIntfUnicodeStrSortedMap;
  8227. FromIndex := BinarySearch(FromKey);
  8228. if (FromIndex = -1) or (KeysCompare(FEntries[FromIndex].Key, FromKey) < 0) then
  8229. Inc(FromIndex);
  8230. if (FromIndex >= 0) and (FromIndex < FSize) then
  8231. begin
  8232. NewMap.SetCapacity(FSize - FromIndex);
  8233. NewMap.FSize := FSize - FromIndex;
  8234. Index := FromIndex;
  8235. while Index < FSize do
  8236. begin
  8237. NewMap.FEntries[Index - FromIndex] := FEntries[Index];
  8238. Inc(Index);
  8239. end;
  8240. end;
  8241. Result := NewMap;
  8242. {$IFDEF THREADSAFE}
  8243. finally
  8244. if FThreadSafe then
  8245. SyncReaderWriter.EndRead;
  8246. end;
  8247. {$ENDIF THREADSAFE}
  8248. end;
  8249. function TJclIntfUnicodeStrSortedMap.Values: IJclUnicodeStrCollection;
  8250. var
  8251. Index: Integer;
  8252. begin
  8253. {$IFDEF THREADSAFE}
  8254. if FThreadSafe then
  8255. SyncReaderWriter.BeginRead;
  8256. try
  8257. {$ENDIF THREADSAFE}
  8258. Result := TJclUnicodeStrArrayList.Create(FSize);
  8259. for Index := 0 to FSize - 1 do
  8260. Result.Add(FEntries[Index].Value);
  8261. {$IFDEF THREADSAFE}
  8262. finally
  8263. if FThreadSafe then
  8264. SyncReaderWriter.EndRead;
  8265. end;
  8266. {$ENDIF THREADSAFE}
  8267. end;
  8268. function TJclIntfUnicodeStrSortedMap.CreateEmptyContainer: TJclAbstractContainerBase;
  8269. begin
  8270. Result := TJclIntfUnicodeStrSortedMap.Create(FSize);
  8271. AssignPropertiesTo(Result);
  8272. end;
  8273. function TJclIntfUnicodeStrSortedMap.FreeKey(var Key: IInterface): IInterface;
  8274. begin
  8275. Result := Key;
  8276. Key := nil;
  8277. end;
  8278. function TJclIntfUnicodeStrSortedMap.FreeValue(var Value: UnicodeString): UnicodeString;
  8279. begin
  8280. Result := Value;
  8281. Value := '';
  8282. end;
  8283. function TJclIntfUnicodeStrSortedMap.KeysCompare(const A, B: IInterface): Integer;
  8284. begin
  8285. Result := IntfSimpleCompare(A, B);
  8286. end;
  8287. function TJclIntfUnicodeStrSortedMap.ValuesCompare(const A, B: UnicodeString): Integer;
  8288. begin
  8289. Result := ItemsCompare(A, B);
  8290. end;
  8291. {$ENDIF SUPPORTS_UNICODE_STRING}
  8292. {$IFDEF SUPPORTS_UNICODE_STRING}
  8293. //=== { TJclUnicodeStrUnicodeStrSortedMap } ==============================================
  8294. constructor TJclUnicodeStrUnicodeStrSortedMap.Create(ACapacity: Integer);
  8295. begin
  8296. inherited Create();
  8297. SetCapacity(ACapacity);
  8298. end;
  8299. destructor TJclUnicodeStrUnicodeStrSortedMap.Destroy;
  8300. begin
  8301. FReadOnly := False;
  8302. Clear;
  8303. inherited Destroy;
  8304. end;
  8305. procedure TJclUnicodeStrUnicodeStrSortedMap.AssignDataTo(Dest: TJclAbstractContainerBase);
  8306. var
  8307. MyDest: TJclUnicodeStrUnicodeStrSortedMap;
  8308. begin
  8309. inherited AssignDataTo(Dest);
  8310. if Dest is TJclUnicodeStrUnicodeStrSortedMap then
  8311. begin
  8312. MyDest := TJclUnicodeStrUnicodeStrSortedMap(Dest);
  8313. MyDest.SetCapacity(FSize);
  8314. MyDest.FEntries := FEntries;
  8315. MyDest.FSize := FSize;
  8316. end;
  8317. end;
  8318. function TJclUnicodeStrUnicodeStrSortedMap.BinarySearch(const Key: UnicodeString): Integer;
  8319. var
  8320. HiPos, LoPos, CompPos: Integer;
  8321. Comp: Integer;
  8322. begin
  8323. {$IFDEF THREADSAFE}
  8324. if FThreadSafe then
  8325. SyncReaderWriter.BeginRead;
  8326. try
  8327. {$ENDIF THREADSAFE}
  8328. LoPos := 0;
  8329. HiPos := FSize - 1;
  8330. CompPos := (HiPos + LoPos) div 2;
  8331. while HiPos >= LoPos do
  8332. begin
  8333. Comp := KeysCompare(FEntries[CompPos].Key, Key);
  8334. if Comp < 0 then
  8335. LoPos := CompPos + 1
  8336. else
  8337. if Comp > 0 then
  8338. HiPos := CompPos - 1
  8339. else
  8340. begin
  8341. HiPos := CompPos;
  8342. LoPos := CompPos + 1;
  8343. end;
  8344. CompPos := (HiPos + LoPos) div 2;
  8345. end;
  8346. Result := HiPos;
  8347. {$IFDEF THREADSAFE}
  8348. finally
  8349. if FThreadSafe then
  8350. SyncReaderWriter.EndRead;
  8351. end;
  8352. {$ENDIF THREADSAFE}
  8353. end;
  8354. procedure TJclUnicodeStrUnicodeStrSortedMap.Clear;
  8355. var
  8356. Index: Integer;
  8357. begin
  8358. if ReadOnly then
  8359. raise EJclReadOnlyError.Create;
  8360. {$IFDEF THREADSAFE}
  8361. if FThreadSafe then
  8362. SyncReaderWriter.BeginWrite;
  8363. try
  8364. {$ENDIF THREADSAFE}
  8365. for Index := 0 to FSize - 1 do
  8366. begin
  8367. FreeKey(FEntries[Index].Key);
  8368. FreeValue(FEntries[Index].Value);
  8369. end;
  8370. FSize := 0;
  8371. AutoPack;
  8372. {$IFDEF THREADSAFE}
  8373. finally
  8374. if FThreadSafe then
  8375. SyncReaderWriter.EndWrite;
  8376. end;
  8377. {$ENDIF THREADSAFE}
  8378. end;
  8379. function TJclUnicodeStrUnicodeStrSortedMap.ContainsKey(const Key: UnicodeString): Boolean;
  8380. var
  8381. Index: Integer;
  8382. begin
  8383. {$IFDEF THREADSAFE}
  8384. if FThreadSafe then
  8385. SyncReaderWriter.BeginRead;
  8386. try
  8387. {$ENDIF THREADSAFE}
  8388. Index := BinarySearch(Key);
  8389. Result := (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0);
  8390. {$IFDEF THREADSAFE}
  8391. finally
  8392. if FThreadSafe then
  8393. SyncReaderWriter.EndRead;
  8394. end;
  8395. {$ENDIF THREADSAFE}
  8396. end;
  8397. function TJclUnicodeStrUnicodeStrSortedMap.ContainsValue(const Value: UnicodeString): Boolean;
  8398. var
  8399. Index: Integer;
  8400. begin
  8401. {$IFDEF THREADSAFE}
  8402. if FThreadSafe then
  8403. SyncReaderWriter.BeginRead;
  8404. try
  8405. {$ENDIF THREADSAFE}
  8406. Result := False;
  8407. for Index := 0 to FSize - 1 do
  8408. if ValuesCompare(FEntries[Index].Value, Value) = 0 then
  8409. begin
  8410. Result := True;
  8411. Break;
  8412. end;
  8413. {$IFDEF THREADSAFE}
  8414. finally
  8415. if FThreadSafe then
  8416. SyncReaderWriter.EndRead;
  8417. end;
  8418. {$ENDIF THREADSAFE}
  8419. end;
  8420. function TJclUnicodeStrUnicodeStrSortedMap.FirstKey: UnicodeString;
  8421. begin
  8422. {$IFDEF THREADSAFE}
  8423. if FThreadSafe then
  8424. SyncReaderWriter.BeginRead;
  8425. try
  8426. {$ENDIF THREADSAFE}
  8427. Result := '';
  8428. if FSize > 0 then
  8429. Result := FEntries[0].Key
  8430. else
  8431. if not FReturnDefaultElements then
  8432. raise EJclNoSuchElementError.Create('');
  8433. {$IFDEF THREADSAFE}
  8434. finally
  8435. if FThreadSafe then
  8436. SyncReaderWriter.EndRead;
  8437. end;
  8438. {$ENDIF THREADSAFE}
  8439. end;
  8440. function TJclUnicodeStrUnicodeStrSortedMap.Extract(const Key: UnicodeString): UnicodeString;
  8441. var
  8442. Index: Integer;
  8443. begin
  8444. if ReadOnly then
  8445. raise EJclReadOnlyError.Create;
  8446. {$IFDEF THREADSAFE}
  8447. if FThreadSafe then
  8448. SyncReaderWriter.BeginWrite;
  8449. try
  8450. {$ENDIF THREADSAFE}
  8451. Index := BinarySearch(Key);
  8452. if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then
  8453. begin
  8454. Result := FEntries[Index].Value;
  8455. FEntries[Index].Value := '';
  8456. FreeKey(FEntries[Index].Key);
  8457. if Index < (FSize - 1) then
  8458. MoveArray(FEntries, Index + 1, Index, FSize - Index - 1);
  8459. Dec(FSize);
  8460. AutoPack;
  8461. end
  8462. else
  8463. Result := '';
  8464. {$IFDEF THREADSAFE}
  8465. finally
  8466. if FThreadSafe then
  8467. SyncReaderWriter.EndWrite;
  8468. end;
  8469. {$ENDIF THREADSAFE}
  8470. end;
  8471. function TJclUnicodeStrUnicodeStrSortedMap.GetValue(const Key: UnicodeString): UnicodeString;
  8472. var
  8473. Index: Integer;
  8474. begin
  8475. {$IFDEF THREADSAFE}
  8476. if FThreadSafe then
  8477. SyncReaderWriter.BeginRead;
  8478. try
  8479. {$ENDIF THREADSAFE}
  8480. Index := BinarySearch(Key);
  8481. Result := '';
  8482. if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then
  8483. Result := FEntries[Index].Value
  8484. else if not FReturnDefaultElements then
  8485. raise EJclNoSuchElementError.Create('');
  8486. {$IFDEF THREADSAFE}
  8487. finally
  8488. if FThreadSafe then
  8489. SyncReaderWriter.EndRead;
  8490. end;
  8491. {$ENDIF THREADSAFE}
  8492. end;
  8493. function TJclUnicodeStrUnicodeStrSortedMap.HeadMap(const ToKey: UnicodeString): IJclUnicodeStrUnicodeStrSortedMap;
  8494. var
  8495. ToIndex: Integer;
  8496. NewMap: TJclUnicodeStrUnicodeStrSortedMap;
  8497. begin
  8498. {$IFDEF THREADSAFE}
  8499. if FThreadSafe then
  8500. SyncReaderWriter.BeginRead;
  8501. try
  8502. {$ENDIF THREADSAFE}
  8503. NewMap := CreateEmptyContainer as TJclUnicodeStrUnicodeStrSortedMap;
  8504. ToIndex := BinarySearch(ToKey);
  8505. if ToIndex >= 0 then
  8506. begin
  8507. NewMap.SetCapacity(ToIndex + 1);
  8508. NewMap.FSize := ToIndex + 1;
  8509. while ToIndex >= 0 do
  8510. begin
  8511. NewMap.FEntries[ToIndex] := FEntries[ToIndex];
  8512. Dec(ToIndex);
  8513. end;
  8514. end;
  8515. Result := NewMap;
  8516. {$IFDEF THREADSAFE}
  8517. finally
  8518. if FThreadSafe then
  8519. SyncReaderWriter.EndRead;
  8520. end;
  8521. {$ENDIF THREADSAFE}
  8522. end;
  8523. function TJclUnicodeStrUnicodeStrSortedMap.IsEmpty: Boolean;
  8524. begin
  8525. {$IFDEF THREADSAFE}
  8526. if FThreadSafe then
  8527. SyncReaderWriter.BeginRead;
  8528. try
  8529. {$ENDIF THREADSAFE}
  8530. Result := FSize = 0;
  8531. {$IFDEF THREADSAFE}
  8532. finally
  8533. if FThreadSafe then
  8534. SyncReaderWriter.EndRead;
  8535. end;
  8536. {$ENDIF THREADSAFE}
  8537. end;
  8538. function TJclUnicodeStrUnicodeStrSortedMap.KeyOfValue(const Value: UnicodeString): UnicodeString;
  8539. var
  8540. Index: Integer;
  8541. Found: Boolean;
  8542. begin
  8543. {$IFDEF THREADSAFE}
  8544. if FThreadSafe then
  8545. SyncReaderWriter.BeginRead;
  8546. try
  8547. {$ENDIF THREADSAFE}
  8548. Found := False;
  8549. Result := '';
  8550. for Index := 0 to FSize - 1 do
  8551. if ValuesCompare(FEntries[Index].Value, Value) = 0 then
  8552. begin
  8553. Result := FEntries[Index].Key;
  8554. Found := True;
  8555. Break;
  8556. end;
  8557. if (not Found) and (not FReturnDefaultElements) then
  8558. raise EJclNoSuchElementError.Create('');
  8559. {$IFDEF THREADSAFE}
  8560. finally
  8561. if FThreadSafe then
  8562. SyncReaderWriter.EndRead;
  8563. end;
  8564. {$ENDIF THREADSAFE}
  8565. end;
  8566. function TJclUnicodeStrUnicodeStrSortedMap.KeySet: IJclUnicodeStrSet;
  8567. var
  8568. Index: Integer;
  8569. begin
  8570. {$IFDEF THREADSAFE}
  8571. if FThreadSafe then
  8572. SyncReaderWriter.BeginRead;
  8573. try
  8574. {$ENDIF THREADSAFE}
  8575. Result := TJclUnicodeStrArraySet.Create(FSize);
  8576. for Index := 0 to FSize - 1 do
  8577. Result.Add(FEntries[Index].Key);
  8578. {$IFDEF THREADSAFE}
  8579. finally
  8580. if FThreadSafe then
  8581. SyncReaderWriter.EndRead;
  8582. end;
  8583. {$ENDIF THREADSAFE}
  8584. end;
  8585. function TJclUnicodeStrUnicodeStrSortedMap.LastKey: UnicodeString;
  8586. begin
  8587. {$IFDEF THREADSAFE}
  8588. if FThreadSafe then
  8589. SyncReaderWriter.BeginRead;
  8590. try
  8591. {$ENDIF THREADSAFE}
  8592. Result := '';
  8593. if FSize > 0 then
  8594. Result := FEntries[FSize - 1].Key
  8595. else
  8596. if not FReturnDefaultElements then
  8597. raise EJclNoSuchElementError.Create('');
  8598. {$IFDEF THREADSAFE}
  8599. finally
  8600. if FThreadSafe then
  8601. SyncReaderWriter.EndRead;
  8602. end;
  8603. {$ENDIF THREADSAFE}
  8604. end;
  8605. function TJclUnicodeStrUnicodeStrSortedMap.MapEquals(const AMap: IJclUnicodeStrUnicodeStrMap): Boolean;
  8606. var
  8607. It: IJclUnicodeStrIterator;
  8608. Index: Integer;
  8609. AKey: UnicodeString;
  8610. begin
  8611. {$IFDEF THREADSAFE}
  8612. if FThreadSafe then
  8613. SyncReaderWriter.BeginRead;
  8614. try
  8615. {$ENDIF THREADSAFE}
  8616. Result := False;
  8617. if AMap = nil then
  8618. Exit;
  8619. if FSize <> AMap.Size then
  8620. Exit;
  8621. It := AMap.KeySet.First;
  8622. Index := 0;
  8623. while It.HasNext do
  8624. begin
  8625. if Index >= FSize then
  8626. Exit;
  8627. AKey := It.Next;
  8628. if ValuesCompare(AMap.GetValue(AKey), FEntries[Index].Value) <> 0 then
  8629. Exit;
  8630. Inc(Index);
  8631. end;
  8632. Result := True;
  8633. {$IFDEF THREADSAFE}
  8634. finally
  8635. if FThreadSafe then
  8636. SyncReaderWriter.EndRead;
  8637. end;
  8638. {$ENDIF THREADSAFE}
  8639. end;
  8640. procedure TJclUnicodeStrUnicodeStrSortedMap.FinalizeArrayBeforeMove(var List: TJclUnicodeStrUnicodeStrSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  8641. begin
  8642. Assert(Count > 0);
  8643. if FromIndex < ToIndex then
  8644. begin
  8645. if Count > (ToIndex - FromIndex) then
  8646. Finalize(List[FromIndex + Count], ToIndex - FromIndex)
  8647. else
  8648. Finalize(List[ToIndex], Count);
  8649. end
  8650. else
  8651. if FromIndex > ToIndex then
  8652. begin
  8653. if Count > (FromIndex - ToIndex) then
  8654. Count := FromIndex - ToIndex;
  8655. Finalize(List[ToIndex], Count)
  8656. end;
  8657. end;
  8658. procedure TJclUnicodeStrUnicodeStrSortedMap.InitializeArray(var List: TJclUnicodeStrUnicodeStrSortedMapEntryArray; FromIndex, Count: SizeInt);
  8659. begin
  8660. {$IFDEF FPC}
  8661. while Count > 0 do
  8662. begin
  8663. Initialize(List[FromIndex]);
  8664. Inc(FromIndex);
  8665. Dec(Count);
  8666. end;
  8667. {$ELSE ~FPC}
  8668. Initialize(List[FromIndex], Count);
  8669. {$ENDIF ~FPC}
  8670. end;
  8671. procedure TJclUnicodeStrUnicodeStrSortedMap.InitializeArrayAfterMove(var List: TJclUnicodeStrUnicodeStrSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  8672. begin
  8673. { Keep reference counting working }
  8674. if FromIndex < ToIndex then
  8675. begin
  8676. if (ToIndex - FromIndex) < Count then
  8677. Count := ToIndex - FromIndex;
  8678. InitializeArray(List, FromIndex, Count);
  8679. end
  8680. else
  8681. if FromIndex > ToIndex then
  8682. begin
  8683. if (FromIndex - ToIndex) < Count then
  8684. InitializeArray(List, ToIndex + Count, FromIndex - ToIndex)
  8685. else
  8686. InitializeArray(List, FromIndex, Count);
  8687. end;
  8688. end;
  8689. procedure TJclUnicodeStrUnicodeStrSortedMap.MoveArray(var List: TJclUnicodeStrUnicodeStrSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  8690. begin
  8691. if Count > 0 then
  8692. begin
  8693. FinalizeArrayBeforeMove(List, FromIndex, ToIndex, Count);
  8694. Move(List[FromIndex], List[ToIndex], Count * SizeOf(List[0]));
  8695. InitializeArrayAfterMove(List, FromIndex, ToIndex, Count);
  8696. end;
  8697. end;
  8698. procedure TJclUnicodeStrUnicodeStrSortedMap.PutAll(const AMap: IJclUnicodeStrUnicodeStrMap);
  8699. var
  8700. It: IJclUnicodeStrIterator;
  8701. Key: UnicodeString;
  8702. begin
  8703. if ReadOnly then
  8704. raise EJclReadOnlyError.Create;
  8705. {$IFDEF THREADSAFE}
  8706. if FThreadSafe then
  8707. SyncReaderWriter.BeginWrite;
  8708. try
  8709. {$ENDIF THREADSAFE}
  8710. if AMap = nil then
  8711. Exit;
  8712. It := AMap.KeySet.First;
  8713. while It.HasNext do
  8714. begin
  8715. Key := It.Next;
  8716. PutValue(Key, AMap.GetValue(Key));
  8717. end;
  8718. {$IFDEF THREADSAFE}
  8719. finally
  8720. if FThreadSafe then
  8721. SyncReaderWriter.EndWrite;
  8722. end;
  8723. {$ENDIF THREADSAFE}
  8724. end;
  8725. procedure TJclUnicodeStrUnicodeStrSortedMap.PutValue(const Key: UnicodeString; const Value: UnicodeString);
  8726. var
  8727. Index: Integer;
  8728. begin
  8729. if ReadOnly then
  8730. raise EJclReadOnlyError.Create;
  8731. {$IFDEF THREADSAFE}
  8732. if FThreadSafe then
  8733. SyncReaderWriter.BeginWrite;
  8734. try
  8735. {$ENDIF THREADSAFE}
  8736. if FAllowDefaultElements or ((KeysCompare(Key, '') <> 0) and (ValuesCompare(Value, '') <> 0)) then
  8737. begin
  8738. Index := BinarySearch(Key);
  8739. if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then
  8740. begin
  8741. FreeValue(FEntries[Index].Value);
  8742. FEntries[Index].Value := Value;
  8743. end
  8744. else
  8745. begin
  8746. if FSize = FCapacity then
  8747. AutoGrow;
  8748. if FSize < FCapacity then
  8749. begin
  8750. Inc(Index);
  8751. if (Index < FSize) and (KeysCompare(FEntries[Index].Key, Key) <> 0) then
  8752. MoveArray(FEntries, Index, Index + 1, FSize - Index);
  8753. FEntries[Index].Key := Key;
  8754. FEntries[Index].Value := Value;
  8755. Inc(FSize);
  8756. end;
  8757. end;
  8758. end;
  8759. {$IFDEF THREADSAFE}
  8760. finally
  8761. if FThreadSafe then
  8762. SyncReaderWriter.EndWrite;
  8763. end;
  8764. {$ENDIF THREADSAFE}
  8765. end;
  8766. function TJclUnicodeStrUnicodeStrSortedMap.Remove(const Key: UnicodeString): UnicodeString;
  8767. begin
  8768. if ReadOnly then
  8769. raise EJclReadOnlyError.Create;
  8770. {$IFDEF THREADSAFE}
  8771. if FThreadSafe then
  8772. SyncReaderWriter.BeginWrite;
  8773. try
  8774. {$ENDIF THREADSAFE}
  8775. Result := Extract(Key);
  8776. Result := FreeValue(Result);
  8777. {$IFDEF THREADSAFE}
  8778. finally
  8779. if FThreadSafe then
  8780. SyncReaderWriter.EndWrite;
  8781. end;
  8782. {$ENDIF THREADSAFE}
  8783. end;
  8784. procedure TJclUnicodeStrUnicodeStrSortedMap.SetCapacity(Value: Integer);
  8785. begin
  8786. if ReadOnly then
  8787. raise EJclReadOnlyError.Create;
  8788. {$IFDEF THREADSAFE}
  8789. if FThreadSafe then
  8790. SyncReaderWriter.BeginWrite;
  8791. try
  8792. {$ENDIF THREADSAFE}
  8793. if FSize <= Value then
  8794. begin
  8795. SetLength(FEntries, Value);
  8796. inherited SetCapacity(Value);
  8797. end
  8798. else
  8799. raise EJclOperationNotSupportedError.Create;
  8800. {$IFDEF THREADSAFE}
  8801. finally
  8802. if FThreadSafe then
  8803. SyncReaderWriter.EndWrite;
  8804. end;
  8805. {$ENDIF THREADSAFE}
  8806. end;
  8807. function TJclUnicodeStrUnicodeStrSortedMap.Size: Integer;
  8808. begin
  8809. Result := FSize;
  8810. end;
  8811. function TJclUnicodeStrUnicodeStrSortedMap.SubMap(const FromKey, ToKey: UnicodeString): IJclUnicodeStrUnicodeStrSortedMap;
  8812. var
  8813. FromIndex, ToIndex: Integer;
  8814. NewMap: TJclUnicodeStrUnicodeStrSortedMap;
  8815. begin
  8816. {$IFDEF THREADSAFE}
  8817. if FThreadSafe then
  8818. SyncReaderWriter.BeginRead;
  8819. try
  8820. {$ENDIF THREADSAFE}
  8821. NewMap := CreateEmptyContainer as TJclUnicodeStrUnicodeStrSortedMap;
  8822. FromIndex := BinarySearch(FromKey);
  8823. if (FromIndex = -1) or (KeysCompare(FEntries[FromIndex].Key, FromKey) < 0) then
  8824. Inc(FromIndex);
  8825. ToIndex := BinarySearch(ToKey);
  8826. if (FromIndex >= 0) and (FromIndex <= ToIndex) then
  8827. begin
  8828. NewMap.SetCapacity(ToIndex - FromIndex + 1);
  8829. NewMap.FSize := ToIndex - FromIndex + 1;
  8830. while ToIndex >= FromIndex do
  8831. begin
  8832. NewMap.FEntries[ToIndex - FromIndex] := FEntries[ToIndex];
  8833. Dec(ToIndex);
  8834. end;
  8835. end;
  8836. Result := NewMap;
  8837. {$IFDEF THREADSAFE}
  8838. finally
  8839. if FThreadSafe then
  8840. SyncReaderWriter.EndRead;
  8841. end;
  8842. {$ENDIF THREADSAFE}
  8843. end;
  8844. function TJclUnicodeStrUnicodeStrSortedMap.TailMap(const FromKey: UnicodeString): IJclUnicodeStrUnicodeStrSortedMap;
  8845. var
  8846. FromIndex, Index: Integer;
  8847. NewMap: TJclUnicodeStrUnicodeStrSortedMap;
  8848. begin
  8849. {$IFDEF THREADSAFE}
  8850. if FThreadSafe then
  8851. SyncReaderWriter.BeginRead;
  8852. try
  8853. {$ENDIF THREADSAFE}
  8854. NewMap := CreateEmptyContainer as TJclUnicodeStrUnicodeStrSortedMap;
  8855. FromIndex := BinarySearch(FromKey);
  8856. if (FromIndex = -1) or (KeysCompare(FEntries[FromIndex].Key, FromKey) < 0) then
  8857. Inc(FromIndex);
  8858. if (FromIndex >= 0) and (FromIndex < FSize) then
  8859. begin
  8860. NewMap.SetCapacity(FSize - FromIndex);
  8861. NewMap.FSize := FSize - FromIndex;
  8862. Index := FromIndex;
  8863. while Index < FSize do
  8864. begin
  8865. NewMap.FEntries[Index - FromIndex] := FEntries[Index];
  8866. Inc(Index);
  8867. end;
  8868. end;
  8869. Result := NewMap;
  8870. {$IFDEF THREADSAFE}
  8871. finally
  8872. if FThreadSafe then
  8873. SyncReaderWriter.EndRead;
  8874. end;
  8875. {$ENDIF THREADSAFE}
  8876. end;
  8877. function TJclUnicodeStrUnicodeStrSortedMap.Values: IJclUnicodeStrCollection;
  8878. var
  8879. Index: Integer;
  8880. begin
  8881. {$IFDEF THREADSAFE}
  8882. if FThreadSafe then
  8883. SyncReaderWriter.BeginRead;
  8884. try
  8885. {$ENDIF THREADSAFE}
  8886. Result := TJclUnicodeStrArrayList.Create(FSize);
  8887. for Index := 0 to FSize - 1 do
  8888. Result.Add(FEntries[Index].Value);
  8889. {$IFDEF THREADSAFE}
  8890. finally
  8891. if FThreadSafe then
  8892. SyncReaderWriter.EndRead;
  8893. end;
  8894. {$ENDIF THREADSAFE}
  8895. end;
  8896. function TJclUnicodeStrUnicodeStrSortedMap.CreateEmptyContainer: TJclAbstractContainerBase;
  8897. begin
  8898. Result := TJclUnicodeStrUnicodeStrSortedMap.Create(FSize);
  8899. AssignPropertiesTo(Result);
  8900. end;
  8901. function TJclUnicodeStrUnicodeStrSortedMap.FreeKey(var Key: UnicodeString): UnicodeString;
  8902. begin
  8903. Result := Key;
  8904. Key := '';
  8905. end;
  8906. function TJclUnicodeStrUnicodeStrSortedMap.FreeValue(var Value: UnicodeString): UnicodeString;
  8907. begin
  8908. Result := Value;
  8909. Value := '';
  8910. end;
  8911. function TJclUnicodeStrUnicodeStrSortedMap.KeysCompare(const A, B: UnicodeString): Integer;
  8912. begin
  8913. Result := ItemsCompare(A, B);
  8914. end;
  8915. function TJclUnicodeStrUnicodeStrSortedMap.ValuesCompare(const A, B: UnicodeString): Integer;
  8916. begin
  8917. Result := ItemsCompare(A, B);
  8918. end;
  8919. {$ENDIF SUPPORTS_UNICODE_STRING}
  8920. //=== { TJclSingleIntfSortedMap } ==============================================
  8921. constructor TJclSingleIntfSortedMap.Create(ACapacity: Integer);
  8922. begin
  8923. inherited Create();
  8924. SetCapacity(ACapacity);
  8925. end;
  8926. destructor TJclSingleIntfSortedMap.Destroy;
  8927. begin
  8928. FReadOnly := False;
  8929. Clear;
  8930. inherited Destroy;
  8931. end;
  8932. procedure TJclSingleIntfSortedMap.AssignDataTo(Dest: TJclAbstractContainerBase);
  8933. var
  8934. MyDest: TJclSingleIntfSortedMap;
  8935. begin
  8936. inherited AssignDataTo(Dest);
  8937. if Dest is TJclSingleIntfSortedMap then
  8938. begin
  8939. MyDest := TJclSingleIntfSortedMap(Dest);
  8940. MyDest.SetCapacity(FSize);
  8941. MyDest.FEntries := FEntries;
  8942. MyDest.FSize := FSize;
  8943. end;
  8944. end;
  8945. function TJclSingleIntfSortedMap.BinarySearch(const Key: Single): Integer;
  8946. var
  8947. HiPos, LoPos, CompPos: Integer;
  8948. Comp: Integer;
  8949. begin
  8950. {$IFDEF THREADSAFE}
  8951. if FThreadSafe then
  8952. SyncReaderWriter.BeginRead;
  8953. try
  8954. {$ENDIF THREADSAFE}
  8955. LoPos := 0;
  8956. HiPos := FSize - 1;
  8957. CompPos := (HiPos + LoPos) div 2;
  8958. while HiPos >= LoPos do
  8959. begin
  8960. Comp := KeysCompare(FEntries[CompPos].Key, Key);
  8961. if Comp < 0 then
  8962. LoPos := CompPos + 1
  8963. else
  8964. if Comp > 0 then
  8965. HiPos := CompPos - 1
  8966. else
  8967. begin
  8968. HiPos := CompPos;
  8969. LoPos := CompPos + 1;
  8970. end;
  8971. CompPos := (HiPos + LoPos) div 2;
  8972. end;
  8973. Result := HiPos;
  8974. {$IFDEF THREADSAFE}
  8975. finally
  8976. if FThreadSafe then
  8977. SyncReaderWriter.EndRead;
  8978. end;
  8979. {$ENDIF THREADSAFE}
  8980. end;
  8981. procedure TJclSingleIntfSortedMap.Clear;
  8982. var
  8983. Index: Integer;
  8984. begin
  8985. if ReadOnly then
  8986. raise EJclReadOnlyError.Create;
  8987. {$IFDEF THREADSAFE}
  8988. if FThreadSafe then
  8989. SyncReaderWriter.BeginWrite;
  8990. try
  8991. {$ENDIF THREADSAFE}
  8992. for Index := 0 to FSize - 1 do
  8993. begin
  8994. FreeKey(FEntries[Index].Key);
  8995. FreeValue(FEntries[Index].Value);
  8996. end;
  8997. FSize := 0;
  8998. AutoPack;
  8999. {$IFDEF THREADSAFE}
  9000. finally
  9001. if FThreadSafe then
  9002. SyncReaderWriter.EndWrite;
  9003. end;
  9004. {$ENDIF THREADSAFE}
  9005. end;
  9006. function TJclSingleIntfSortedMap.ContainsKey(const Key: Single): Boolean;
  9007. var
  9008. Index: Integer;
  9009. begin
  9010. {$IFDEF THREADSAFE}
  9011. if FThreadSafe then
  9012. SyncReaderWriter.BeginRead;
  9013. try
  9014. {$ENDIF THREADSAFE}
  9015. Index := BinarySearch(Key);
  9016. Result := (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0);
  9017. {$IFDEF THREADSAFE}
  9018. finally
  9019. if FThreadSafe then
  9020. SyncReaderWriter.EndRead;
  9021. end;
  9022. {$ENDIF THREADSAFE}
  9023. end;
  9024. function TJclSingleIntfSortedMap.ContainsValue(const Value: IInterface): Boolean;
  9025. var
  9026. Index: Integer;
  9027. begin
  9028. {$IFDEF THREADSAFE}
  9029. if FThreadSafe then
  9030. SyncReaderWriter.BeginRead;
  9031. try
  9032. {$ENDIF THREADSAFE}
  9033. Result := False;
  9034. for Index := 0 to FSize - 1 do
  9035. if ValuesCompare(FEntries[Index].Value, Value) = 0 then
  9036. begin
  9037. Result := True;
  9038. Break;
  9039. end;
  9040. {$IFDEF THREADSAFE}
  9041. finally
  9042. if FThreadSafe then
  9043. SyncReaderWriter.EndRead;
  9044. end;
  9045. {$ENDIF THREADSAFE}
  9046. end;
  9047. function TJclSingleIntfSortedMap.FirstKey: Single;
  9048. begin
  9049. {$IFDEF THREADSAFE}
  9050. if FThreadSafe then
  9051. SyncReaderWriter.BeginRead;
  9052. try
  9053. {$ENDIF THREADSAFE}
  9054. Result := 0.0;
  9055. if FSize > 0 then
  9056. Result := FEntries[0].Key
  9057. else
  9058. if not FReturnDefaultElements then
  9059. raise EJclNoSuchElementError.Create('');
  9060. {$IFDEF THREADSAFE}
  9061. finally
  9062. if FThreadSafe then
  9063. SyncReaderWriter.EndRead;
  9064. end;
  9065. {$ENDIF THREADSAFE}
  9066. end;
  9067. function TJclSingleIntfSortedMap.Extract(const Key: Single): IInterface;
  9068. var
  9069. Index: Integer;
  9070. begin
  9071. if ReadOnly then
  9072. raise EJclReadOnlyError.Create;
  9073. {$IFDEF THREADSAFE}
  9074. if FThreadSafe then
  9075. SyncReaderWriter.BeginWrite;
  9076. try
  9077. {$ENDIF THREADSAFE}
  9078. Index := BinarySearch(Key);
  9079. if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then
  9080. begin
  9081. Result := FEntries[Index].Value;
  9082. FEntries[Index].Value := nil;
  9083. FreeKey(FEntries[Index].Key);
  9084. if Index < (FSize - 1) then
  9085. MoveArray(FEntries, Index + 1, Index, FSize - Index - 1);
  9086. Dec(FSize);
  9087. AutoPack;
  9088. end
  9089. else
  9090. Result := nil;
  9091. {$IFDEF THREADSAFE}
  9092. finally
  9093. if FThreadSafe then
  9094. SyncReaderWriter.EndWrite;
  9095. end;
  9096. {$ENDIF THREADSAFE}
  9097. end;
  9098. function TJclSingleIntfSortedMap.GetValue(const Key: Single): IInterface;
  9099. var
  9100. Index: Integer;
  9101. begin
  9102. {$IFDEF THREADSAFE}
  9103. if FThreadSafe then
  9104. SyncReaderWriter.BeginRead;
  9105. try
  9106. {$ENDIF THREADSAFE}
  9107. Index := BinarySearch(Key);
  9108. Result := nil;
  9109. if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then
  9110. Result := FEntries[Index].Value
  9111. else if not FReturnDefaultElements then
  9112. raise EJclNoSuchElementError.Create('');
  9113. {$IFDEF THREADSAFE}
  9114. finally
  9115. if FThreadSafe then
  9116. SyncReaderWriter.EndRead;
  9117. end;
  9118. {$ENDIF THREADSAFE}
  9119. end;
  9120. function TJclSingleIntfSortedMap.HeadMap(const ToKey: Single): IJclSingleIntfSortedMap;
  9121. var
  9122. ToIndex: Integer;
  9123. NewMap: TJclSingleIntfSortedMap;
  9124. begin
  9125. {$IFDEF THREADSAFE}
  9126. if FThreadSafe then
  9127. SyncReaderWriter.BeginRead;
  9128. try
  9129. {$ENDIF THREADSAFE}
  9130. NewMap := CreateEmptyContainer as TJclSingleIntfSortedMap;
  9131. ToIndex := BinarySearch(ToKey);
  9132. if ToIndex >= 0 then
  9133. begin
  9134. NewMap.SetCapacity(ToIndex + 1);
  9135. NewMap.FSize := ToIndex + 1;
  9136. while ToIndex >= 0 do
  9137. begin
  9138. NewMap.FEntries[ToIndex] := FEntries[ToIndex];
  9139. Dec(ToIndex);
  9140. end;
  9141. end;
  9142. Result := NewMap;
  9143. {$IFDEF THREADSAFE}
  9144. finally
  9145. if FThreadSafe then
  9146. SyncReaderWriter.EndRead;
  9147. end;
  9148. {$ENDIF THREADSAFE}
  9149. end;
  9150. function TJclSingleIntfSortedMap.IsEmpty: Boolean;
  9151. begin
  9152. {$IFDEF THREADSAFE}
  9153. if FThreadSafe then
  9154. SyncReaderWriter.BeginRead;
  9155. try
  9156. {$ENDIF THREADSAFE}
  9157. Result := FSize = 0;
  9158. {$IFDEF THREADSAFE}
  9159. finally
  9160. if FThreadSafe then
  9161. SyncReaderWriter.EndRead;
  9162. end;
  9163. {$ENDIF THREADSAFE}
  9164. end;
  9165. function TJclSingleIntfSortedMap.KeyOfValue(const Value: IInterface): Single;
  9166. var
  9167. Index: Integer;
  9168. Found: Boolean;
  9169. begin
  9170. {$IFDEF THREADSAFE}
  9171. if FThreadSafe then
  9172. SyncReaderWriter.BeginRead;
  9173. try
  9174. {$ENDIF THREADSAFE}
  9175. Found := False;
  9176. Result := 0.0;
  9177. for Index := 0 to FSize - 1 do
  9178. if ValuesCompare(FEntries[Index].Value, Value) = 0 then
  9179. begin
  9180. Result := FEntries[Index].Key;
  9181. Found := True;
  9182. Break;
  9183. end;
  9184. if (not Found) and (not FReturnDefaultElements) then
  9185. raise EJclNoSuchElementError.Create('');
  9186. {$IFDEF THREADSAFE}
  9187. finally
  9188. if FThreadSafe then
  9189. SyncReaderWriter.EndRead;
  9190. end;
  9191. {$ENDIF THREADSAFE}
  9192. end;
  9193. function TJclSingleIntfSortedMap.KeySet: IJclSingleSet;
  9194. var
  9195. Index: Integer;
  9196. begin
  9197. {$IFDEF THREADSAFE}
  9198. if FThreadSafe then
  9199. SyncReaderWriter.BeginRead;
  9200. try
  9201. {$ENDIF THREADSAFE}
  9202. Result := TJclSingleArraySet.Create(FSize);
  9203. for Index := 0 to FSize - 1 do
  9204. Result.Add(FEntries[Index].Key);
  9205. {$IFDEF THREADSAFE}
  9206. finally
  9207. if FThreadSafe then
  9208. SyncReaderWriter.EndRead;
  9209. end;
  9210. {$ENDIF THREADSAFE}
  9211. end;
  9212. function TJclSingleIntfSortedMap.LastKey: Single;
  9213. begin
  9214. {$IFDEF THREADSAFE}
  9215. if FThreadSafe then
  9216. SyncReaderWriter.BeginRead;
  9217. try
  9218. {$ENDIF THREADSAFE}
  9219. Result := 0.0;
  9220. if FSize > 0 then
  9221. Result := FEntries[FSize - 1].Key
  9222. else
  9223. if not FReturnDefaultElements then
  9224. raise EJclNoSuchElementError.Create('');
  9225. {$IFDEF THREADSAFE}
  9226. finally
  9227. if FThreadSafe then
  9228. SyncReaderWriter.EndRead;
  9229. end;
  9230. {$ENDIF THREADSAFE}
  9231. end;
  9232. function TJclSingleIntfSortedMap.MapEquals(const AMap: IJclSingleIntfMap): Boolean;
  9233. var
  9234. It: IJclSingleIterator;
  9235. Index: Integer;
  9236. AKey: Single;
  9237. begin
  9238. {$IFDEF THREADSAFE}
  9239. if FThreadSafe then
  9240. SyncReaderWriter.BeginRead;
  9241. try
  9242. {$ENDIF THREADSAFE}
  9243. Result := False;
  9244. if AMap = nil then
  9245. Exit;
  9246. if FSize <> AMap.Size then
  9247. Exit;
  9248. It := AMap.KeySet.First;
  9249. Index := 0;
  9250. while It.HasNext do
  9251. begin
  9252. if Index >= FSize then
  9253. Exit;
  9254. AKey := It.Next;
  9255. if ValuesCompare(AMap.GetValue(AKey), FEntries[Index].Value) <> 0 then
  9256. Exit;
  9257. Inc(Index);
  9258. end;
  9259. Result := True;
  9260. {$IFDEF THREADSAFE}
  9261. finally
  9262. if FThreadSafe then
  9263. SyncReaderWriter.EndRead;
  9264. end;
  9265. {$ENDIF THREADSAFE}
  9266. end;
  9267. procedure TJclSingleIntfSortedMap.FinalizeArrayBeforeMove(var List: TJclSingleIntfSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  9268. begin
  9269. Assert(Count > 0);
  9270. if FromIndex < ToIndex then
  9271. begin
  9272. if Count > (ToIndex - FromIndex) then
  9273. Finalize(List[FromIndex + Count], ToIndex - FromIndex)
  9274. else
  9275. Finalize(List[ToIndex], Count);
  9276. end
  9277. else
  9278. if FromIndex > ToIndex then
  9279. begin
  9280. if Count > (FromIndex - ToIndex) then
  9281. Count := FromIndex - ToIndex;
  9282. Finalize(List[ToIndex], Count)
  9283. end;
  9284. end;
  9285. procedure TJclSingleIntfSortedMap.InitializeArray(var List: TJclSingleIntfSortedMapEntryArray; FromIndex, Count: SizeInt);
  9286. begin
  9287. {$IFDEF FPC}
  9288. while Count > 0 do
  9289. begin
  9290. Initialize(List[FromIndex]);
  9291. Inc(FromIndex);
  9292. Dec(Count);
  9293. end;
  9294. {$ELSE ~FPC}
  9295. Initialize(List[FromIndex], Count);
  9296. {$ENDIF ~FPC}
  9297. end;
  9298. procedure TJclSingleIntfSortedMap.InitializeArrayAfterMove(var List: TJclSingleIntfSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  9299. begin
  9300. { Keep reference counting working }
  9301. if FromIndex < ToIndex then
  9302. begin
  9303. if (ToIndex - FromIndex) < Count then
  9304. Count := ToIndex - FromIndex;
  9305. InitializeArray(List, FromIndex, Count);
  9306. end
  9307. else
  9308. if FromIndex > ToIndex then
  9309. begin
  9310. if (FromIndex - ToIndex) < Count then
  9311. InitializeArray(List, ToIndex + Count, FromIndex - ToIndex)
  9312. else
  9313. InitializeArray(List, FromIndex, Count);
  9314. end;
  9315. end;
  9316. procedure TJclSingleIntfSortedMap.MoveArray(var List: TJclSingleIntfSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  9317. begin
  9318. if Count > 0 then
  9319. begin
  9320. FinalizeArrayBeforeMove(List, FromIndex, ToIndex, Count);
  9321. Move(List[FromIndex], List[ToIndex], Count * SizeOf(List[0]));
  9322. InitializeArrayAfterMove(List, FromIndex, ToIndex, Count);
  9323. end;
  9324. end;
  9325. procedure TJclSingleIntfSortedMap.PutAll(const AMap: IJclSingleIntfMap);
  9326. var
  9327. It: IJclSingleIterator;
  9328. Key: Single;
  9329. begin
  9330. if ReadOnly then
  9331. raise EJclReadOnlyError.Create;
  9332. {$IFDEF THREADSAFE}
  9333. if FThreadSafe then
  9334. SyncReaderWriter.BeginWrite;
  9335. try
  9336. {$ENDIF THREADSAFE}
  9337. if AMap = nil then
  9338. Exit;
  9339. It := AMap.KeySet.First;
  9340. while It.HasNext do
  9341. begin
  9342. Key := It.Next;
  9343. PutValue(Key, AMap.GetValue(Key));
  9344. end;
  9345. {$IFDEF THREADSAFE}
  9346. finally
  9347. if FThreadSafe then
  9348. SyncReaderWriter.EndWrite;
  9349. end;
  9350. {$ENDIF THREADSAFE}
  9351. end;
  9352. procedure TJclSingleIntfSortedMap.PutValue(const Key: Single; const Value: IInterface);
  9353. var
  9354. Index: Integer;
  9355. begin
  9356. if ReadOnly then
  9357. raise EJclReadOnlyError.Create;
  9358. {$IFDEF THREADSAFE}
  9359. if FThreadSafe then
  9360. SyncReaderWriter.BeginWrite;
  9361. try
  9362. {$ENDIF THREADSAFE}
  9363. if FAllowDefaultElements or ((KeysCompare(Key, 0.0) <> 0) and (ValuesCompare(Value, nil) <> 0)) then
  9364. begin
  9365. Index := BinarySearch(Key);
  9366. if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then
  9367. begin
  9368. FreeValue(FEntries[Index].Value);
  9369. FEntries[Index].Value := Value;
  9370. end
  9371. else
  9372. begin
  9373. if FSize = FCapacity then
  9374. AutoGrow;
  9375. if FSize < FCapacity then
  9376. begin
  9377. Inc(Index);
  9378. if (Index < FSize) and (KeysCompare(FEntries[Index].Key, Key) <> 0) then
  9379. MoveArray(FEntries, Index, Index + 1, FSize - Index);
  9380. FEntries[Index].Key := Key;
  9381. FEntries[Index].Value := Value;
  9382. Inc(FSize);
  9383. end;
  9384. end;
  9385. end;
  9386. {$IFDEF THREADSAFE}
  9387. finally
  9388. if FThreadSafe then
  9389. SyncReaderWriter.EndWrite;
  9390. end;
  9391. {$ENDIF THREADSAFE}
  9392. end;
  9393. function TJclSingleIntfSortedMap.Remove(const Key: Single): IInterface;
  9394. begin
  9395. if ReadOnly then
  9396. raise EJclReadOnlyError.Create;
  9397. {$IFDEF THREADSAFE}
  9398. if FThreadSafe then
  9399. SyncReaderWriter.BeginWrite;
  9400. try
  9401. {$ENDIF THREADSAFE}
  9402. Result := Extract(Key);
  9403. Result := FreeValue(Result);
  9404. {$IFDEF THREADSAFE}
  9405. finally
  9406. if FThreadSafe then
  9407. SyncReaderWriter.EndWrite;
  9408. end;
  9409. {$ENDIF THREADSAFE}
  9410. end;
  9411. procedure TJclSingleIntfSortedMap.SetCapacity(Value: Integer);
  9412. begin
  9413. if ReadOnly then
  9414. raise EJclReadOnlyError.Create;
  9415. {$IFDEF THREADSAFE}
  9416. if FThreadSafe then
  9417. SyncReaderWriter.BeginWrite;
  9418. try
  9419. {$ENDIF THREADSAFE}
  9420. if FSize <= Value then
  9421. begin
  9422. SetLength(FEntries, Value);
  9423. inherited SetCapacity(Value);
  9424. end
  9425. else
  9426. raise EJclOperationNotSupportedError.Create;
  9427. {$IFDEF THREADSAFE}
  9428. finally
  9429. if FThreadSafe then
  9430. SyncReaderWriter.EndWrite;
  9431. end;
  9432. {$ENDIF THREADSAFE}
  9433. end;
  9434. function TJclSingleIntfSortedMap.Size: Integer;
  9435. begin
  9436. Result := FSize;
  9437. end;
  9438. function TJclSingleIntfSortedMap.SubMap(const FromKey, ToKey: Single): IJclSingleIntfSortedMap;
  9439. var
  9440. FromIndex, ToIndex: Integer;
  9441. NewMap: TJclSingleIntfSortedMap;
  9442. begin
  9443. {$IFDEF THREADSAFE}
  9444. if FThreadSafe then
  9445. SyncReaderWriter.BeginRead;
  9446. try
  9447. {$ENDIF THREADSAFE}
  9448. NewMap := CreateEmptyContainer as TJclSingleIntfSortedMap;
  9449. FromIndex := BinarySearch(FromKey);
  9450. if (FromIndex = -1) or (KeysCompare(FEntries[FromIndex].Key, FromKey) < 0) then
  9451. Inc(FromIndex);
  9452. ToIndex := BinarySearch(ToKey);
  9453. if (FromIndex >= 0) and (FromIndex <= ToIndex) then
  9454. begin
  9455. NewMap.SetCapacity(ToIndex - FromIndex + 1);
  9456. NewMap.FSize := ToIndex - FromIndex + 1;
  9457. while ToIndex >= FromIndex do
  9458. begin
  9459. NewMap.FEntries[ToIndex - FromIndex] := FEntries[ToIndex];
  9460. Dec(ToIndex);
  9461. end;
  9462. end;
  9463. Result := NewMap;
  9464. {$IFDEF THREADSAFE}
  9465. finally
  9466. if FThreadSafe then
  9467. SyncReaderWriter.EndRead;
  9468. end;
  9469. {$ENDIF THREADSAFE}
  9470. end;
  9471. function TJclSingleIntfSortedMap.TailMap(const FromKey: Single): IJclSingleIntfSortedMap;
  9472. var
  9473. FromIndex, Index: Integer;
  9474. NewMap: TJclSingleIntfSortedMap;
  9475. begin
  9476. {$IFDEF THREADSAFE}
  9477. if FThreadSafe then
  9478. SyncReaderWriter.BeginRead;
  9479. try
  9480. {$ENDIF THREADSAFE}
  9481. NewMap := CreateEmptyContainer as TJclSingleIntfSortedMap;
  9482. FromIndex := BinarySearch(FromKey);
  9483. if (FromIndex = -1) or (KeysCompare(FEntries[FromIndex].Key, FromKey) < 0) then
  9484. Inc(FromIndex);
  9485. if (FromIndex >= 0) and (FromIndex < FSize) then
  9486. begin
  9487. NewMap.SetCapacity(FSize - FromIndex);
  9488. NewMap.FSize := FSize - FromIndex;
  9489. Index := FromIndex;
  9490. while Index < FSize do
  9491. begin
  9492. NewMap.FEntries[Index - FromIndex] := FEntries[Index];
  9493. Inc(Index);
  9494. end;
  9495. end;
  9496. Result := NewMap;
  9497. {$IFDEF THREADSAFE}
  9498. finally
  9499. if FThreadSafe then
  9500. SyncReaderWriter.EndRead;
  9501. end;
  9502. {$ENDIF THREADSAFE}
  9503. end;
  9504. function TJclSingleIntfSortedMap.Values: IJclIntfCollection;
  9505. var
  9506. Index: Integer;
  9507. begin
  9508. {$IFDEF THREADSAFE}
  9509. if FThreadSafe then
  9510. SyncReaderWriter.BeginRead;
  9511. try
  9512. {$ENDIF THREADSAFE}
  9513. Result := TJclIntfArrayList.Create(FSize);
  9514. for Index := 0 to FSize - 1 do
  9515. Result.Add(FEntries[Index].Value);
  9516. {$IFDEF THREADSAFE}
  9517. finally
  9518. if FThreadSafe then
  9519. SyncReaderWriter.EndRead;
  9520. end;
  9521. {$ENDIF THREADSAFE}
  9522. end;
  9523. function TJclSingleIntfSortedMap.CreateEmptyContainer: TJclAbstractContainerBase;
  9524. begin
  9525. Result := TJclSingleIntfSortedMap.Create(FSize);
  9526. AssignPropertiesTo(Result);
  9527. end;
  9528. function TJclSingleIntfSortedMap.FreeKey(var Key: Single): Single;
  9529. begin
  9530. Result := Key;
  9531. Key := 0.0;
  9532. end;
  9533. function TJclSingleIntfSortedMap.FreeValue(var Value: IInterface): IInterface;
  9534. begin
  9535. Result := Value;
  9536. Value := nil;
  9537. end;
  9538. function TJclSingleIntfSortedMap.KeysCompare(const A, B: Single): Integer;
  9539. begin
  9540. Result := ItemsCompare(A, B);
  9541. end;
  9542. function TJclSingleIntfSortedMap.ValuesCompare(const A, B: IInterface): Integer;
  9543. begin
  9544. Result := IntfSimpleCompare(A, B);
  9545. end;
  9546. //=== { TJclIntfSingleSortedMap } ==============================================
  9547. constructor TJclIntfSingleSortedMap.Create(ACapacity: Integer);
  9548. begin
  9549. inherited Create();
  9550. SetCapacity(ACapacity);
  9551. end;
  9552. destructor TJclIntfSingleSortedMap.Destroy;
  9553. begin
  9554. FReadOnly := False;
  9555. Clear;
  9556. inherited Destroy;
  9557. end;
  9558. procedure TJclIntfSingleSortedMap.AssignDataTo(Dest: TJclAbstractContainerBase);
  9559. var
  9560. MyDest: TJclIntfSingleSortedMap;
  9561. begin
  9562. inherited AssignDataTo(Dest);
  9563. if Dest is TJclIntfSingleSortedMap then
  9564. begin
  9565. MyDest := TJclIntfSingleSortedMap(Dest);
  9566. MyDest.SetCapacity(FSize);
  9567. MyDest.FEntries := FEntries;
  9568. MyDest.FSize := FSize;
  9569. end;
  9570. end;
  9571. function TJclIntfSingleSortedMap.BinarySearch(const Key: IInterface): Integer;
  9572. var
  9573. HiPos, LoPos, CompPos: Integer;
  9574. Comp: Integer;
  9575. begin
  9576. {$IFDEF THREADSAFE}
  9577. if FThreadSafe then
  9578. SyncReaderWriter.BeginRead;
  9579. try
  9580. {$ENDIF THREADSAFE}
  9581. LoPos := 0;
  9582. HiPos := FSize - 1;
  9583. CompPos := (HiPos + LoPos) div 2;
  9584. while HiPos >= LoPos do
  9585. begin
  9586. Comp := KeysCompare(FEntries[CompPos].Key, Key);
  9587. if Comp < 0 then
  9588. LoPos := CompPos + 1
  9589. else
  9590. if Comp > 0 then
  9591. HiPos := CompPos - 1
  9592. else
  9593. begin
  9594. HiPos := CompPos;
  9595. LoPos := CompPos + 1;
  9596. end;
  9597. CompPos := (HiPos + LoPos) div 2;
  9598. end;
  9599. Result := HiPos;
  9600. {$IFDEF THREADSAFE}
  9601. finally
  9602. if FThreadSafe then
  9603. SyncReaderWriter.EndRead;
  9604. end;
  9605. {$ENDIF THREADSAFE}
  9606. end;
  9607. procedure TJclIntfSingleSortedMap.Clear;
  9608. var
  9609. Index: Integer;
  9610. begin
  9611. if ReadOnly then
  9612. raise EJclReadOnlyError.Create;
  9613. {$IFDEF THREADSAFE}
  9614. if FThreadSafe then
  9615. SyncReaderWriter.BeginWrite;
  9616. try
  9617. {$ENDIF THREADSAFE}
  9618. for Index := 0 to FSize - 1 do
  9619. begin
  9620. FreeKey(FEntries[Index].Key);
  9621. FreeValue(FEntries[Index].Value);
  9622. end;
  9623. FSize := 0;
  9624. AutoPack;
  9625. {$IFDEF THREADSAFE}
  9626. finally
  9627. if FThreadSafe then
  9628. SyncReaderWriter.EndWrite;
  9629. end;
  9630. {$ENDIF THREADSAFE}
  9631. end;
  9632. function TJclIntfSingleSortedMap.ContainsKey(const Key: IInterface): Boolean;
  9633. var
  9634. Index: Integer;
  9635. begin
  9636. {$IFDEF THREADSAFE}
  9637. if FThreadSafe then
  9638. SyncReaderWriter.BeginRead;
  9639. try
  9640. {$ENDIF THREADSAFE}
  9641. Index := BinarySearch(Key);
  9642. Result := (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0);
  9643. {$IFDEF THREADSAFE}
  9644. finally
  9645. if FThreadSafe then
  9646. SyncReaderWriter.EndRead;
  9647. end;
  9648. {$ENDIF THREADSAFE}
  9649. end;
  9650. function TJclIntfSingleSortedMap.ContainsValue(const Value: Single): Boolean;
  9651. var
  9652. Index: Integer;
  9653. begin
  9654. {$IFDEF THREADSAFE}
  9655. if FThreadSafe then
  9656. SyncReaderWriter.BeginRead;
  9657. try
  9658. {$ENDIF THREADSAFE}
  9659. Result := False;
  9660. for Index := 0 to FSize - 1 do
  9661. if ValuesCompare(FEntries[Index].Value, Value) = 0 then
  9662. begin
  9663. Result := True;
  9664. Break;
  9665. end;
  9666. {$IFDEF THREADSAFE}
  9667. finally
  9668. if FThreadSafe then
  9669. SyncReaderWriter.EndRead;
  9670. end;
  9671. {$ENDIF THREADSAFE}
  9672. end;
  9673. function TJclIntfSingleSortedMap.FirstKey: IInterface;
  9674. begin
  9675. {$IFDEF THREADSAFE}
  9676. if FThreadSafe then
  9677. SyncReaderWriter.BeginRead;
  9678. try
  9679. {$ENDIF THREADSAFE}
  9680. Result := nil;
  9681. if FSize > 0 then
  9682. Result := FEntries[0].Key
  9683. else
  9684. if not FReturnDefaultElements then
  9685. raise EJclNoSuchElementError.Create('');
  9686. {$IFDEF THREADSAFE}
  9687. finally
  9688. if FThreadSafe then
  9689. SyncReaderWriter.EndRead;
  9690. end;
  9691. {$ENDIF THREADSAFE}
  9692. end;
  9693. function TJclIntfSingleSortedMap.Extract(const Key: IInterface): Single;
  9694. var
  9695. Index: Integer;
  9696. begin
  9697. if ReadOnly then
  9698. raise EJclReadOnlyError.Create;
  9699. {$IFDEF THREADSAFE}
  9700. if FThreadSafe then
  9701. SyncReaderWriter.BeginWrite;
  9702. try
  9703. {$ENDIF THREADSAFE}
  9704. Index := BinarySearch(Key);
  9705. if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then
  9706. begin
  9707. Result := FEntries[Index].Value;
  9708. FEntries[Index].Value := 0.0;
  9709. FreeKey(FEntries[Index].Key);
  9710. if Index < (FSize - 1) then
  9711. MoveArray(FEntries, Index + 1, Index, FSize - Index - 1);
  9712. Dec(FSize);
  9713. AutoPack;
  9714. end
  9715. else
  9716. Result := 0.0;
  9717. {$IFDEF THREADSAFE}
  9718. finally
  9719. if FThreadSafe then
  9720. SyncReaderWriter.EndWrite;
  9721. end;
  9722. {$ENDIF THREADSAFE}
  9723. end;
  9724. function TJclIntfSingleSortedMap.GetValue(const Key: IInterface): Single;
  9725. var
  9726. Index: Integer;
  9727. begin
  9728. {$IFDEF THREADSAFE}
  9729. if FThreadSafe then
  9730. SyncReaderWriter.BeginRead;
  9731. try
  9732. {$ENDIF THREADSAFE}
  9733. Index := BinarySearch(Key);
  9734. Result := 0.0;
  9735. if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then
  9736. Result := FEntries[Index].Value
  9737. else if not FReturnDefaultElements then
  9738. raise EJclNoSuchElementError.Create('');
  9739. {$IFDEF THREADSAFE}
  9740. finally
  9741. if FThreadSafe then
  9742. SyncReaderWriter.EndRead;
  9743. end;
  9744. {$ENDIF THREADSAFE}
  9745. end;
  9746. function TJclIntfSingleSortedMap.HeadMap(const ToKey: IInterface): IJclIntfSingleSortedMap;
  9747. var
  9748. ToIndex: Integer;
  9749. NewMap: TJclIntfSingleSortedMap;
  9750. begin
  9751. {$IFDEF THREADSAFE}
  9752. if FThreadSafe then
  9753. SyncReaderWriter.BeginRead;
  9754. try
  9755. {$ENDIF THREADSAFE}
  9756. NewMap := CreateEmptyContainer as TJclIntfSingleSortedMap;
  9757. ToIndex := BinarySearch(ToKey);
  9758. if ToIndex >= 0 then
  9759. begin
  9760. NewMap.SetCapacity(ToIndex + 1);
  9761. NewMap.FSize := ToIndex + 1;
  9762. while ToIndex >= 0 do
  9763. begin
  9764. NewMap.FEntries[ToIndex] := FEntries[ToIndex];
  9765. Dec(ToIndex);
  9766. end;
  9767. end;
  9768. Result := NewMap;
  9769. {$IFDEF THREADSAFE}
  9770. finally
  9771. if FThreadSafe then
  9772. SyncReaderWriter.EndRead;
  9773. end;
  9774. {$ENDIF THREADSAFE}
  9775. end;
  9776. function TJclIntfSingleSortedMap.IsEmpty: Boolean;
  9777. begin
  9778. {$IFDEF THREADSAFE}
  9779. if FThreadSafe then
  9780. SyncReaderWriter.BeginRead;
  9781. try
  9782. {$ENDIF THREADSAFE}
  9783. Result := FSize = 0;
  9784. {$IFDEF THREADSAFE}
  9785. finally
  9786. if FThreadSafe then
  9787. SyncReaderWriter.EndRead;
  9788. end;
  9789. {$ENDIF THREADSAFE}
  9790. end;
  9791. function TJclIntfSingleSortedMap.KeyOfValue(const Value: Single): IInterface;
  9792. var
  9793. Index: Integer;
  9794. Found: Boolean;
  9795. begin
  9796. {$IFDEF THREADSAFE}
  9797. if FThreadSafe then
  9798. SyncReaderWriter.BeginRead;
  9799. try
  9800. {$ENDIF THREADSAFE}
  9801. Found := False;
  9802. Result := nil;
  9803. for Index := 0 to FSize - 1 do
  9804. if ValuesCompare(FEntries[Index].Value, Value) = 0 then
  9805. begin
  9806. Result := FEntries[Index].Key;
  9807. Found := True;
  9808. Break;
  9809. end;
  9810. if (not Found) and (not FReturnDefaultElements) then
  9811. raise EJclNoSuchElementError.Create('');
  9812. {$IFDEF THREADSAFE}
  9813. finally
  9814. if FThreadSafe then
  9815. SyncReaderWriter.EndRead;
  9816. end;
  9817. {$ENDIF THREADSAFE}
  9818. end;
  9819. function TJclIntfSingleSortedMap.KeySet: IJclIntfSet;
  9820. var
  9821. Index: Integer;
  9822. begin
  9823. {$IFDEF THREADSAFE}
  9824. if FThreadSafe then
  9825. SyncReaderWriter.BeginRead;
  9826. try
  9827. {$ENDIF THREADSAFE}
  9828. Result := TJclIntfArraySet.Create(FSize);
  9829. for Index := 0 to FSize - 1 do
  9830. Result.Add(FEntries[Index].Key);
  9831. {$IFDEF THREADSAFE}
  9832. finally
  9833. if FThreadSafe then
  9834. SyncReaderWriter.EndRead;
  9835. end;
  9836. {$ENDIF THREADSAFE}
  9837. end;
  9838. function TJclIntfSingleSortedMap.LastKey: IInterface;
  9839. begin
  9840. {$IFDEF THREADSAFE}
  9841. if FThreadSafe then
  9842. SyncReaderWriter.BeginRead;
  9843. try
  9844. {$ENDIF THREADSAFE}
  9845. Result := nil;
  9846. if FSize > 0 then
  9847. Result := FEntries[FSize - 1].Key
  9848. else
  9849. if not FReturnDefaultElements then
  9850. raise EJclNoSuchElementError.Create('');
  9851. {$IFDEF THREADSAFE}
  9852. finally
  9853. if FThreadSafe then
  9854. SyncReaderWriter.EndRead;
  9855. end;
  9856. {$ENDIF THREADSAFE}
  9857. end;
  9858. function TJclIntfSingleSortedMap.MapEquals(const AMap: IJclIntfSingleMap): Boolean;
  9859. var
  9860. It: IJclIntfIterator;
  9861. Index: Integer;
  9862. AKey: IInterface;
  9863. begin
  9864. {$IFDEF THREADSAFE}
  9865. if FThreadSafe then
  9866. SyncReaderWriter.BeginRead;
  9867. try
  9868. {$ENDIF THREADSAFE}
  9869. Result := False;
  9870. if AMap = nil then
  9871. Exit;
  9872. if FSize <> AMap.Size then
  9873. Exit;
  9874. It := AMap.KeySet.First;
  9875. Index := 0;
  9876. while It.HasNext do
  9877. begin
  9878. if Index >= FSize then
  9879. Exit;
  9880. AKey := It.Next;
  9881. if ValuesCompare(AMap.GetValue(AKey), FEntries[Index].Value) <> 0 then
  9882. Exit;
  9883. Inc(Index);
  9884. end;
  9885. Result := True;
  9886. {$IFDEF THREADSAFE}
  9887. finally
  9888. if FThreadSafe then
  9889. SyncReaderWriter.EndRead;
  9890. end;
  9891. {$ENDIF THREADSAFE}
  9892. end;
  9893. procedure TJclIntfSingleSortedMap.FinalizeArrayBeforeMove(var List: TJclIntfSingleSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  9894. begin
  9895. Assert(Count > 0);
  9896. if FromIndex < ToIndex then
  9897. begin
  9898. if Count > (ToIndex - FromIndex) then
  9899. Finalize(List[FromIndex + Count], ToIndex - FromIndex)
  9900. else
  9901. Finalize(List[ToIndex], Count);
  9902. end
  9903. else
  9904. if FromIndex > ToIndex then
  9905. begin
  9906. if Count > (FromIndex - ToIndex) then
  9907. Count := FromIndex - ToIndex;
  9908. Finalize(List[ToIndex], Count)
  9909. end;
  9910. end;
  9911. procedure TJclIntfSingleSortedMap.InitializeArray(var List: TJclIntfSingleSortedMapEntryArray; FromIndex, Count: SizeInt);
  9912. begin
  9913. {$IFDEF FPC}
  9914. while Count > 0 do
  9915. begin
  9916. Initialize(List[FromIndex]);
  9917. Inc(FromIndex);
  9918. Dec(Count);
  9919. end;
  9920. {$ELSE ~FPC}
  9921. Initialize(List[FromIndex], Count);
  9922. {$ENDIF ~FPC}
  9923. end;
  9924. procedure TJclIntfSingleSortedMap.InitializeArrayAfterMove(var List: TJclIntfSingleSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  9925. begin
  9926. { Keep reference counting working }
  9927. if FromIndex < ToIndex then
  9928. begin
  9929. if (ToIndex - FromIndex) < Count then
  9930. Count := ToIndex - FromIndex;
  9931. InitializeArray(List, FromIndex, Count);
  9932. end
  9933. else
  9934. if FromIndex > ToIndex then
  9935. begin
  9936. if (FromIndex - ToIndex) < Count then
  9937. InitializeArray(List, ToIndex + Count, FromIndex - ToIndex)
  9938. else
  9939. InitializeArray(List, FromIndex, Count);
  9940. end;
  9941. end;
  9942. procedure TJclIntfSingleSortedMap.MoveArray(var List: TJclIntfSingleSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  9943. begin
  9944. if Count > 0 then
  9945. begin
  9946. FinalizeArrayBeforeMove(List, FromIndex, ToIndex, Count);
  9947. Move(List[FromIndex], List[ToIndex], Count * SizeOf(List[0]));
  9948. InitializeArrayAfterMove(List, FromIndex, ToIndex, Count);
  9949. end;
  9950. end;
  9951. procedure TJclIntfSingleSortedMap.PutAll(const AMap: IJclIntfSingleMap);
  9952. var
  9953. It: IJclIntfIterator;
  9954. Key: IInterface;
  9955. begin
  9956. if ReadOnly then
  9957. raise EJclReadOnlyError.Create;
  9958. {$IFDEF THREADSAFE}
  9959. if FThreadSafe then
  9960. SyncReaderWriter.BeginWrite;
  9961. try
  9962. {$ENDIF THREADSAFE}
  9963. if AMap = nil then
  9964. Exit;
  9965. It := AMap.KeySet.First;
  9966. while It.HasNext do
  9967. begin
  9968. Key := It.Next;
  9969. PutValue(Key, AMap.GetValue(Key));
  9970. end;
  9971. {$IFDEF THREADSAFE}
  9972. finally
  9973. if FThreadSafe then
  9974. SyncReaderWriter.EndWrite;
  9975. end;
  9976. {$ENDIF THREADSAFE}
  9977. end;
  9978. procedure TJclIntfSingleSortedMap.PutValue(const Key: IInterface; const Value: Single);
  9979. var
  9980. Index: Integer;
  9981. begin
  9982. if ReadOnly then
  9983. raise EJclReadOnlyError.Create;
  9984. {$IFDEF THREADSAFE}
  9985. if FThreadSafe then
  9986. SyncReaderWriter.BeginWrite;
  9987. try
  9988. {$ENDIF THREADSAFE}
  9989. if FAllowDefaultElements or ((KeysCompare(Key, nil) <> 0) and (ValuesCompare(Value, 0.0) <> 0)) then
  9990. begin
  9991. Index := BinarySearch(Key);
  9992. if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then
  9993. begin
  9994. FreeValue(FEntries[Index].Value);
  9995. FEntries[Index].Value := Value;
  9996. end
  9997. else
  9998. begin
  9999. if FSize = FCapacity then
  10000. AutoGrow;
  10001. if FSize < FCapacity then
  10002. begin
  10003. Inc(Index);
  10004. if (Index < FSize) and (KeysCompare(FEntries[Index].Key, Key) <> 0) then
  10005. MoveArray(FEntries, Index, Index + 1, FSize - Index);
  10006. FEntries[Index].Key := Key;
  10007. FEntries[Index].Value := Value;
  10008. Inc(FSize);
  10009. end;
  10010. end;
  10011. end;
  10012. {$IFDEF THREADSAFE}
  10013. finally
  10014. if FThreadSafe then
  10015. SyncReaderWriter.EndWrite;
  10016. end;
  10017. {$ENDIF THREADSAFE}
  10018. end;
  10019. function TJclIntfSingleSortedMap.Remove(const Key: IInterface): Single;
  10020. begin
  10021. if ReadOnly then
  10022. raise EJclReadOnlyError.Create;
  10023. {$IFDEF THREADSAFE}
  10024. if FThreadSafe then
  10025. SyncReaderWriter.BeginWrite;
  10026. try
  10027. {$ENDIF THREADSAFE}
  10028. Result := Extract(Key);
  10029. Result := FreeValue(Result);
  10030. {$IFDEF THREADSAFE}
  10031. finally
  10032. if FThreadSafe then
  10033. SyncReaderWriter.EndWrite;
  10034. end;
  10035. {$ENDIF THREADSAFE}
  10036. end;
  10037. procedure TJclIntfSingleSortedMap.SetCapacity(Value: Integer);
  10038. begin
  10039. if ReadOnly then
  10040. raise EJclReadOnlyError.Create;
  10041. {$IFDEF THREADSAFE}
  10042. if FThreadSafe then
  10043. SyncReaderWriter.BeginWrite;
  10044. try
  10045. {$ENDIF THREADSAFE}
  10046. if FSize <= Value then
  10047. begin
  10048. SetLength(FEntries, Value);
  10049. inherited SetCapacity(Value);
  10050. end
  10051. else
  10052. raise EJclOperationNotSupportedError.Create;
  10053. {$IFDEF THREADSAFE}
  10054. finally
  10055. if FThreadSafe then
  10056. SyncReaderWriter.EndWrite;
  10057. end;
  10058. {$ENDIF THREADSAFE}
  10059. end;
  10060. function TJclIntfSingleSortedMap.Size: Integer;
  10061. begin
  10062. Result := FSize;
  10063. end;
  10064. function TJclIntfSingleSortedMap.SubMap(const FromKey, ToKey: IInterface): IJclIntfSingleSortedMap;
  10065. var
  10066. FromIndex, ToIndex: Integer;
  10067. NewMap: TJclIntfSingleSortedMap;
  10068. begin
  10069. {$IFDEF THREADSAFE}
  10070. if FThreadSafe then
  10071. SyncReaderWriter.BeginRead;
  10072. try
  10073. {$ENDIF THREADSAFE}
  10074. NewMap := CreateEmptyContainer as TJclIntfSingleSortedMap;
  10075. FromIndex := BinarySearch(FromKey);
  10076. if (FromIndex = -1) or (KeysCompare(FEntries[FromIndex].Key, FromKey) < 0) then
  10077. Inc(FromIndex);
  10078. ToIndex := BinarySearch(ToKey);
  10079. if (FromIndex >= 0) and (FromIndex <= ToIndex) then
  10080. begin
  10081. NewMap.SetCapacity(ToIndex - FromIndex + 1);
  10082. NewMap.FSize := ToIndex - FromIndex + 1;
  10083. while ToIndex >= FromIndex do
  10084. begin
  10085. NewMap.FEntries[ToIndex - FromIndex] := FEntries[ToIndex];
  10086. Dec(ToIndex);
  10087. end;
  10088. end;
  10089. Result := NewMap;
  10090. {$IFDEF THREADSAFE}
  10091. finally
  10092. if FThreadSafe then
  10093. SyncReaderWriter.EndRead;
  10094. end;
  10095. {$ENDIF THREADSAFE}
  10096. end;
  10097. function TJclIntfSingleSortedMap.TailMap(const FromKey: IInterface): IJclIntfSingleSortedMap;
  10098. var
  10099. FromIndex, Index: Integer;
  10100. NewMap: TJclIntfSingleSortedMap;
  10101. begin
  10102. {$IFDEF THREADSAFE}
  10103. if FThreadSafe then
  10104. SyncReaderWriter.BeginRead;
  10105. try
  10106. {$ENDIF THREADSAFE}
  10107. NewMap := CreateEmptyContainer as TJclIntfSingleSortedMap;
  10108. FromIndex := BinarySearch(FromKey);
  10109. if (FromIndex = -1) or (KeysCompare(FEntries[FromIndex].Key, FromKey) < 0) then
  10110. Inc(FromIndex);
  10111. if (FromIndex >= 0) and (FromIndex < FSize) then
  10112. begin
  10113. NewMap.SetCapacity(FSize - FromIndex);
  10114. NewMap.FSize := FSize - FromIndex;
  10115. Index := FromIndex;
  10116. while Index < FSize do
  10117. begin
  10118. NewMap.FEntries[Index - FromIndex] := FEntries[Index];
  10119. Inc(Index);
  10120. end;
  10121. end;
  10122. Result := NewMap;
  10123. {$IFDEF THREADSAFE}
  10124. finally
  10125. if FThreadSafe then
  10126. SyncReaderWriter.EndRead;
  10127. end;
  10128. {$ENDIF THREADSAFE}
  10129. end;
  10130. function TJclIntfSingleSortedMap.Values: IJclSingleCollection;
  10131. var
  10132. Index: Integer;
  10133. begin
  10134. {$IFDEF THREADSAFE}
  10135. if FThreadSafe then
  10136. SyncReaderWriter.BeginRead;
  10137. try
  10138. {$ENDIF THREADSAFE}
  10139. Result := TJclSingleArrayList.Create(FSize);
  10140. for Index := 0 to FSize - 1 do
  10141. Result.Add(FEntries[Index].Value);
  10142. {$IFDEF THREADSAFE}
  10143. finally
  10144. if FThreadSafe then
  10145. SyncReaderWriter.EndRead;
  10146. end;
  10147. {$ENDIF THREADSAFE}
  10148. end;
  10149. function TJclIntfSingleSortedMap.CreateEmptyContainer: TJclAbstractContainerBase;
  10150. begin
  10151. Result := TJclIntfSingleSortedMap.Create(FSize);
  10152. AssignPropertiesTo(Result);
  10153. end;
  10154. function TJclIntfSingleSortedMap.FreeKey(var Key: IInterface): IInterface;
  10155. begin
  10156. Result := Key;
  10157. Key := nil;
  10158. end;
  10159. function TJclIntfSingleSortedMap.FreeValue(var Value: Single): Single;
  10160. begin
  10161. Result := Value;
  10162. Value := 0.0;
  10163. end;
  10164. function TJclIntfSingleSortedMap.KeysCompare(const A, B: IInterface): Integer;
  10165. begin
  10166. Result := IntfSimpleCompare(A, B);
  10167. end;
  10168. function TJclIntfSingleSortedMap.ValuesCompare(const A, B: Single): Integer;
  10169. begin
  10170. Result := ItemsCompare(A, B);
  10171. end;
  10172. //=== { TJclSingleSingleSortedMap } ==============================================
  10173. constructor TJclSingleSingleSortedMap.Create(ACapacity: Integer);
  10174. begin
  10175. inherited Create();
  10176. SetCapacity(ACapacity);
  10177. end;
  10178. destructor TJclSingleSingleSortedMap.Destroy;
  10179. begin
  10180. FReadOnly := False;
  10181. Clear;
  10182. inherited Destroy;
  10183. end;
  10184. procedure TJclSingleSingleSortedMap.AssignDataTo(Dest: TJclAbstractContainerBase);
  10185. var
  10186. MyDest: TJclSingleSingleSortedMap;
  10187. begin
  10188. inherited AssignDataTo(Dest);
  10189. if Dest is TJclSingleSingleSortedMap then
  10190. begin
  10191. MyDest := TJclSingleSingleSortedMap(Dest);
  10192. MyDest.SetCapacity(FSize);
  10193. MyDest.FEntries := FEntries;
  10194. MyDest.FSize := FSize;
  10195. end;
  10196. end;
  10197. function TJclSingleSingleSortedMap.BinarySearch(const Key: Single): Integer;
  10198. var
  10199. HiPos, LoPos, CompPos: Integer;
  10200. Comp: Integer;
  10201. begin
  10202. {$IFDEF THREADSAFE}
  10203. if FThreadSafe then
  10204. SyncReaderWriter.BeginRead;
  10205. try
  10206. {$ENDIF THREADSAFE}
  10207. LoPos := 0;
  10208. HiPos := FSize - 1;
  10209. CompPos := (HiPos + LoPos) div 2;
  10210. while HiPos >= LoPos do
  10211. begin
  10212. Comp := KeysCompare(FEntries[CompPos].Key, Key);
  10213. if Comp < 0 then
  10214. LoPos := CompPos + 1
  10215. else
  10216. if Comp > 0 then
  10217. HiPos := CompPos - 1
  10218. else
  10219. begin
  10220. HiPos := CompPos;
  10221. LoPos := CompPos + 1;
  10222. end;
  10223. CompPos := (HiPos + LoPos) div 2;
  10224. end;
  10225. Result := HiPos;
  10226. {$IFDEF THREADSAFE}
  10227. finally
  10228. if FThreadSafe then
  10229. SyncReaderWriter.EndRead;
  10230. end;
  10231. {$ENDIF THREADSAFE}
  10232. end;
  10233. procedure TJclSingleSingleSortedMap.Clear;
  10234. var
  10235. Index: Integer;
  10236. begin
  10237. if ReadOnly then
  10238. raise EJclReadOnlyError.Create;
  10239. {$IFDEF THREADSAFE}
  10240. if FThreadSafe then
  10241. SyncReaderWriter.BeginWrite;
  10242. try
  10243. {$ENDIF THREADSAFE}
  10244. for Index := 0 to FSize - 1 do
  10245. begin
  10246. FreeKey(FEntries[Index].Key);
  10247. FreeValue(FEntries[Index].Value);
  10248. end;
  10249. FSize := 0;
  10250. AutoPack;
  10251. {$IFDEF THREADSAFE}
  10252. finally
  10253. if FThreadSafe then
  10254. SyncReaderWriter.EndWrite;
  10255. end;
  10256. {$ENDIF THREADSAFE}
  10257. end;
  10258. function TJclSingleSingleSortedMap.ContainsKey(const Key: Single): Boolean;
  10259. var
  10260. Index: Integer;
  10261. begin
  10262. {$IFDEF THREADSAFE}
  10263. if FThreadSafe then
  10264. SyncReaderWriter.BeginRead;
  10265. try
  10266. {$ENDIF THREADSAFE}
  10267. Index := BinarySearch(Key);
  10268. Result := (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0);
  10269. {$IFDEF THREADSAFE}
  10270. finally
  10271. if FThreadSafe then
  10272. SyncReaderWriter.EndRead;
  10273. end;
  10274. {$ENDIF THREADSAFE}
  10275. end;
  10276. function TJclSingleSingleSortedMap.ContainsValue(const Value: Single): Boolean;
  10277. var
  10278. Index: Integer;
  10279. begin
  10280. {$IFDEF THREADSAFE}
  10281. if FThreadSafe then
  10282. SyncReaderWriter.BeginRead;
  10283. try
  10284. {$ENDIF THREADSAFE}
  10285. Result := False;
  10286. for Index := 0 to FSize - 1 do
  10287. if ValuesCompare(FEntries[Index].Value, Value) = 0 then
  10288. begin
  10289. Result := True;
  10290. Break;
  10291. end;
  10292. {$IFDEF THREADSAFE}
  10293. finally
  10294. if FThreadSafe then
  10295. SyncReaderWriter.EndRead;
  10296. end;
  10297. {$ENDIF THREADSAFE}
  10298. end;
  10299. function TJclSingleSingleSortedMap.FirstKey: Single;
  10300. begin
  10301. {$IFDEF THREADSAFE}
  10302. if FThreadSafe then
  10303. SyncReaderWriter.BeginRead;
  10304. try
  10305. {$ENDIF THREADSAFE}
  10306. Result := 0.0;
  10307. if FSize > 0 then
  10308. Result := FEntries[0].Key
  10309. else
  10310. if not FReturnDefaultElements then
  10311. raise EJclNoSuchElementError.Create('');
  10312. {$IFDEF THREADSAFE}
  10313. finally
  10314. if FThreadSafe then
  10315. SyncReaderWriter.EndRead;
  10316. end;
  10317. {$ENDIF THREADSAFE}
  10318. end;
  10319. function TJclSingleSingleSortedMap.Extract(const Key: Single): Single;
  10320. var
  10321. Index: Integer;
  10322. begin
  10323. if ReadOnly then
  10324. raise EJclReadOnlyError.Create;
  10325. {$IFDEF THREADSAFE}
  10326. if FThreadSafe then
  10327. SyncReaderWriter.BeginWrite;
  10328. try
  10329. {$ENDIF THREADSAFE}
  10330. Index := BinarySearch(Key);
  10331. if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then
  10332. begin
  10333. Result := FEntries[Index].Value;
  10334. FEntries[Index].Value := 0.0;
  10335. FreeKey(FEntries[Index].Key);
  10336. if Index < (FSize - 1) then
  10337. MoveArray(FEntries, Index + 1, Index, FSize - Index - 1);
  10338. Dec(FSize);
  10339. AutoPack;
  10340. end
  10341. else
  10342. Result := 0.0;
  10343. {$IFDEF THREADSAFE}
  10344. finally
  10345. if FThreadSafe then
  10346. SyncReaderWriter.EndWrite;
  10347. end;
  10348. {$ENDIF THREADSAFE}
  10349. end;
  10350. function TJclSingleSingleSortedMap.GetValue(const Key: Single): Single;
  10351. var
  10352. Index: Integer;
  10353. begin
  10354. {$IFDEF THREADSAFE}
  10355. if FThreadSafe then
  10356. SyncReaderWriter.BeginRead;
  10357. try
  10358. {$ENDIF THREADSAFE}
  10359. Index := BinarySearch(Key);
  10360. Result := 0.0;
  10361. if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then
  10362. Result := FEntries[Index].Value
  10363. else if not FReturnDefaultElements then
  10364. raise EJclNoSuchElementError.Create('');
  10365. {$IFDEF THREADSAFE}
  10366. finally
  10367. if FThreadSafe then
  10368. SyncReaderWriter.EndRead;
  10369. end;
  10370. {$ENDIF THREADSAFE}
  10371. end;
  10372. function TJclSingleSingleSortedMap.HeadMap(const ToKey: Single): IJclSingleSingleSortedMap;
  10373. var
  10374. ToIndex: Integer;
  10375. NewMap: TJclSingleSingleSortedMap;
  10376. begin
  10377. {$IFDEF THREADSAFE}
  10378. if FThreadSafe then
  10379. SyncReaderWriter.BeginRead;
  10380. try
  10381. {$ENDIF THREADSAFE}
  10382. NewMap := CreateEmptyContainer as TJclSingleSingleSortedMap;
  10383. ToIndex := BinarySearch(ToKey);
  10384. if ToIndex >= 0 then
  10385. begin
  10386. NewMap.SetCapacity(ToIndex + 1);
  10387. NewMap.FSize := ToIndex + 1;
  10388. while ToIndex >= 0 do
  10389. begin
  10390. NewMap.FEntries[ToIndex] := FEntries[ToIndex];
  10391. Dec(ToIndex);
  10392. end;
  10393. end;
  10394. Result := NewMap;
  10395. {$IFDEF THREADSAFE}
  10396. finally
  10397. if FThreadSafe then
  10398. SyncReaderWriter.EndRead;
  10399. end;
  10400. {$ENDIF THREADSAFE}
  10401. end;
  10402. function TJclSingleSingleSortedMap.IsEmpty: Boolean;
  10403. begin
  10404. {$IFDEF THREADSAFE}
  10405. if FThreadSafe then
  10406. SyncReaderWriter.BeginRead;
  10407. try
  10408. {$ENDIF THREADSAFE}
  10409. Result := FSize = 0;
  10410. {$IFDEF THREADSAFE}
  10411. finally
  10412. if FThreadSafe then
  10413. SyncReaderWriter.EndRead;
  10414. end;
  10415. {$ENDIF THREADSAFE}
  10416. end;
  10417. function TJclSingleSingleSortedMap.KeyOfValue(const Value: Single): Single;
  10418. var
  10419. Index: Integer;
  10420. Found: Boolean;
  10421. begin
  10422. {$IFDEF THREADSAFE}
  10423. if FThreadSafe then
  10424. SyncReaderWriter.BeginRead;
  10425. try
  10426. {$ENDIF THREADSAFE}
  10427. Found := False;
  10428. Result := 0.0;
  10429. for Index := 0 to FSize - 1 do
  10430. if ValuesCompare(FEntries[Index].Value, Value) = 0 then
  10431. begin
  10432. Result := FEntries[Index].Key;
  10433. Found := True;
  10434. Break;
  10435. end;
  10436. if (not Found) and (not FReturnDefaultElements) then
  10437. raise EJclNoSuchElementError.Create('');
  10438. {$IFDEF THREADSAFE}
  10439. finally
  10440. if FThreadSafe then
  10441. SyncReaderWriter.EndRead;
  10442. end;
  10443. {$ENDIF THREADSAFE}
  10444. end;
  10445. function TJclSingleSingleSortedMap.KeySet: IJclSingleSet;
  10446. var
  10447. Index: Integer;
  10448. begin
  10449. {$IFDEF THREADSAFE}
  10450. if FThreadSafe then
  10451. SyncReaderWriter.BeginRead;
  10452. try
  10453. {$ENDIF THREADSAFE}
  10454. Result := TJclSingleArraySet.Create(FSize);
  10455. for Index := 0 to FSize - 1 do
  10456. Result.Add(FEntries[Index].Key);
  10457. {$IFDEF THREADSAFE}
  10458. finally
  10459. if FThreadSafe then
  10460. SyncReaderWriter.EndRead;
  10461. end;
  10462. {$ENDIF THREADSAFE}
  10463. end;
  10464. function TJclSingleSingleSortedMap.LastKey: Single;
  10465. begin
  10466. {$IFDEF THREADSAFE}
  10467. if FThreadSafe then
  10468. SyncReaderWriter.BeginRead;
  10469. try
  10470. {$ENDIF THREADSAFE}
  10471. Result := 0.0;
  10472. if FSize > 0 then
  10473. Result := FEntries[FSize - 1].Key
  10474. else
  10475. if not FReturnDefaultElements then
  10476. raise EJclNoSuchElementError.Create('');
  10477. {$IFDEF THREADSAFE}
  10478. finally
  10479. if FThreadSafe then
  10480. SyncReaderWriter.EndRead;
  10481. end;
  10482. {$ENDIF THREADSAFE}
  10483. end;
  10484. function TJclSingleSingleSortedMap.MapEquals(const AMap: IJclSingleSingleMap): Boolean;
  10485. var
  10486. It: IJclSingleIterator;
  10487. Index: Integer;
  10488. AKey: Single;
  10489. begin
  10490. {$IFDEF THREADSAFE}
  10491. if FThreadSafe then
  10492. SyncReaderWriter.BeginRead;
  10493. try
  10494. {$ENDIF THREADSAFE}
  10495. Result := False;
  10496. if AMap = nil then
  10497. Exit;
  10498. if FSize <> AMap.Size then
  10499. Exit;
  10500. It := AMap.KeySet.First;
  10501. Index := 0;
  10502. while It.HasNext do
  10503. begin
  10504. if Index >= FSize then
  10505. Exit;
  10506. AKey := It.Next;
  10507. if ValuesCompare(AMap.GetValue(AKey), FEntries[Index].Value) <> 0 then
  10508. Exit;
  10509. Inc(Index);
  10510. end;
  10511. Result := True;
  10512. {$IFDEF THREADSAFE}
  10513. finally
  10514. if FThreadSafe then
  10515. SyncReaderWriter.EndRead;
  10516. end;
  10517. {$ENDIF THREADSAFE}
  10518. end;
  10519. procedure TJclSingleSingleSortedMap.InitializeArrayAfterMove(var List: TJclSingleSingleSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  10520. begin
  10521. { Clean array }
  10522. if FromIndex < ToIndex then
  10523. begin
  10524. if (ToIndex - FromIndex) < Count then
  10525. Count := ToIndex - FromIndex;
  10526. FillChar(List[FromIndex], Count * SizeOf(List[0]), 0);
  10527. end
  10528. else
  10529. if FromIndex > ToIndex then
  10530. begin
  10531. if (FromIndex - ToIndex) < Count then
  10532. FillChar(List[ToIndex + Count], (FromIndex - ToIndex) * SizeOf(List[0]), 0)
  10533. else
  10534. FillChar(List[FromIndex], Count * SizeOf(List[0]), 0);
  10535. end;
  10536. end;
  10537. procedure TJclSingleSingleSortedMap.MoveArray(var List: TJclSingleSingleSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  10538. begin
  10539. if Count > 0 then
  10540. begin
  10541. Move(List[FromIndex], List[ToIndex], Count * SizeOf(List[0]));
  10542. InitializeArrayAfterMove(List, FromIndex, ToIndex, Count);
  10543. end;
  10544. end;
  10545. procedure TJclSingleSingleSortedMap.PutAll(const AMap: IJclSingleSingleMap);
  10546. var
  10547. It: IJclSingleIterator;
  10548. Key: Single;
  10549. begin
  10550. if ReadOnly then
  10551. raise EJclReadOnlyError.Create;
  10552. {$IFDEF THREADSAFE}
  10553. if FThreadSafe then
  10554. SyncReaderWriter.BeginWrite;
  10555. try
  10556. {$ENDIF THREADSAFE}
  10557. if AMap = nil then
  10558. Exit;
  10559. It := AMap.KeySet.First;
  10560. while It.HasNext do
  10561. begin
  10562. Key := It.Next;
  10563. PutValue(Key, AMap.GetValue(Key));
  10564. end;
  10565. {$IFDEF THREADSAFE}
  10566. finally
  10567. if FThreadSafe then
  10568. SyncReaderWriter.EndWrite;
  10569. end;
  10570. {$ENDIF THREADSAFE}
  10571. end;
  10572. procedure TJclSingleSingleSortedMap.PutValue(const Key: Single; const Value: Single);
  10573. var
  10574. Index: Integer;
  10575. begin
  10576. if ReadOnly then
  10577. raise EJclReadOnlyError.Create;
  10578. {$IFDEF THREADSAFE}
  10579. if FThreadSafe then
  10580. SyncReaderWriter.BeginWrite;
  10581. try
  10582. {$ENDIF THREADSAFE}
  10583. if FAllowDefaultElements or ((KeysCompare(Key, 0.0) <> 0) and (ValuesCompare(Value, 0.0) <> 0)) then
  10584. begin
  10585. Index := BinarySearch(Key);
  10586. if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then
  10587. begin
  10588. FreeValue(FEntries[Index].Value);
  10589. FEntries[Index].Value := Value;
  10590. end
  10591. else
  10592. begin
  10593. if FSize = FCapacity then
  10594. AutoGrow;
  10595. if FSize < FCapacity then
  10596. begin
  10597. Inc(Index);
  10598. if (Index < FSize) and (KeysCompare(FEntries[Index].Key, Key) <> 0) then
  10599. MoveArray(FEntries, Index, Index + 1, FSize - Index);
  10600. FEntries[Index].Key := Key;
  10601. FEntries[Index].Value := Value;
  10602. Inc(FSize);
  10603. end;
  10604. end;
  10605. end;
  10606. {$IFDEF THREADSAFE}
  10607. finally
  10608. if FThreadSafe then
  10609. SyncReaderWriter.EndWrite;
  10610. end;
  10611. {$ENDIF THREADSAFE}
  10612. end;
  10613. function TJclSingleSingleSortedMap.Remove(const Key: Single): Single;
  10614. begin
  10615. if ReadOnly then
  10616. raise EJclReadOnlyError.Create;
  10617. {$IFDEF THREADSAFE}
  10618. if FThreadSafe then
  10619. SyncReaderWriter.BeginWrite;
  10620. try
  10621. {$ENDIF THREADSAFE}
  10622. Result := Extract(Key);
  10623. Result := FreeValue(Result);
  10624. {$IFDEF THREADSAFE}
  10625. finally
  10626. if FThreadSafe then
  10627. SyncReaderWriter.EndWrite;
  10628. end;
  10629. {$ENDIF THREADSAFE}
  10630. end;
  10631. procedure TJclSingleSingleSortedMap.SetCapacity(Value: Integer);
  10632. begin
  10633. if ReadOnly then
  10634. raise EJclReadOnlyError.Create;
  10635. {$IFDEF THREADSAFE}
  10636. if FThreadSafe then
  10637. SyncReaderWriter.BeginWrite;
  10638. try
  10639. {$ENDIF THREADSAFE}
  10640. if FSize <= Value then
  10641. begin
  10642. SetLength(FEntries, Value);
  10643. inherited SetCapacity(Value);
  10644. end
  10645. else
  10646. raise EJclOperationNotSupportedError.Create;
  10647. {$IFDEF THREADSAFE}
  10648. finally
  10649. if FThreadSafe then
  10650. SyncReaderWriter.EndWrite;
  10651. end;
  10652. {$ENDIF THREADSAFE}
  10653. end;
  10654. function TJclSingleSingleSortedMap.Size: Integer;
  10655. begin
  10656. Result := FSize;
  10657. end;
  10658. function TJclSingleSingleSortedMap.SubMap(const FromKey, ToKey: Single): IJclSingleSingleSortedMap;
  10659. var
  10660. FromIndex, ToIndex: Integer;
  10661. NewMap: TJclSingleSingleSortedMap;
  10662. begin
  10663. {$IFDEF THREADSAFE}
  10664. if FThreadSafe then
  10665. SyncReaderWriter.BeginRead;
  10666. try
  10667. {$ENDIF THREADSAFE}
  10668. NewMap := CreateEmptyContainer as TJclSingleSingleSortedMap;
  10669. FromIndex := BinarySearch(FromKey);
  10670. if (FromIndex = -1) or (KeysCompare(FEntries[FromIndex].Key, FromKey) < 0) then
  10671. Inc(FromIndex);
  10672. ToIndex := BinarySearch(ToKey);
  10673. if (FromIndex >= 0) and (FromIndex <= ToIndex) then
  10674. begin
  10675. NewMap.SetCapacity(ToIndex - FromIndex + 1);
  10676. NewMap.FSize := ToIndex - FromIndex + 1;
  10677. while ToIndex >= FromIndex do
  10678. begin
  10679. NewMap.FEntries[ToIndex - FromIndex] := FEntries[ToIndex];
  10680. Dec(ToIndex);
  10681. end;
  10682. end;
  10683. Result := NewMap;
  10684. {$IFDEF THREADSAFE}
  10685. finally
  10686. if FThreadSafe then
  10687. SyncReaderWriter.EndRead;
  10688. end;
  10689. {$ENDIF THREADSAFE}
  10690. end;
  10691. function TJclSingleSingleSortedMap.TailMap(const FromKey: Single): IJclSingleSingleSortedMap;
  10692. var
  10693. FromIndex, Index: Integer;
  10694. NewMap: TJclSingleSingleSortedMap;
  10695. begin
  10696. {$IFDEF THREADSAFE}
  10697. if FThreadSafe then
  10698. SyncReaderWriter.BeginRead;
  10699. try
  10700. {$ENDIF THREADSAFE}
  10701. NewMap := CreateEmptyContainer as TJclSingleSingleSortedMap;
  10702. FromIndex := BinarySearch(FromKey);
  10703. if (FromIndex = -1) or (KeysCompare(FEntries[FromIndex].Key, FromKey) < 0) then
  10704. Inc(FromIndex);
  10705. if (FromIndex >= 0) and (FromIndex < FSize) then
  10706. begin
  10707. NewMap.SetCapacity(FSize - FromIndex);
  10708. NewMap.FSize := FSize - FromIndex;
  10709. Index := FromIndex;
  10710. while Index < FSize do
  10711. begin
  10712. NewMap.FEntries[Index - FromIndex] := FEntries[Index];
  10713. Inc(Index);
  10714. end;
  10715. end;
  10716. Result := NewMap;
  10717. {$IFDEF THREADSAFE}
  10718. finally
  10719. if FThreadSafe then
  10720. SyncReaderWriter.EndRead;
  10721. end;
  10722. {$ENDIF THREADSAFE}
  10723. end;
  10724. function TJclSingleSingleSortedMap.Values: IJclSingleCollection;
  10725. var
  10726. Index: Integer;
  10727. begin
  10728. {$IFDEF THREADSAFE}
  10729. if FThreadSafe then
  10730. SyncReaderWriter.BeginRead;
  10731. try
  10732. {$ENDIF THREADSAFE}
  10733. Result := TJclSingleArrayList.Create(FSize);
  10734. for Index := 0 to FSize - 1 do
  10735. Result.Add(FEntries[Index].Value);
  10736. {$IFDEF THREADSAFE}
  10737. finally
  10738. if FThreadSafe then
  10739. SyncReaderWriter.EndRead;
  10740. end;
  10741. {$ENDIF THREADSAFE}
  10742. end;
  10743. function TJclSingleSingleSortedMap.CreateEmptyContainer: TJclAbstractContainerBase;
  10744. begin
  10745. Result := TJclSingleSingleSortedMap.Create(FSize);
  10746. AssignPropertiesTo(Result);
  10747. end;
  10748. function TJclSingleSingleSortedMap.FreeKey(var Key: Single): Single;
  10749. begin
  10750. Result := Key;
  10751. Key := 0.0;
  10752. end;
  10753. function TJclSingleSingleSortedMap.FreeValue(var Value: Single): Single;
  10754. begin
  10755. Result := Value;
  10756. Value := 0.0;
  10757. end;
  10758. function TJclSingleSingleSortedMap.KeysCompare(const A, B: Single): Integer;
  10759. begin
  10760. Result := ItemsCompare(A, B);
  10761. end;
  10762. function TJclSingleSingleSortedMap.ValuesCompare(const A, B: Single): Integer;
  10763. begin
  10764. Result := ItemsCompare(A, B);
  10765. end;
  10766. //=== { TJclDoubleIntfSortedMap } ==============================================
  10767. constructor TJclDoubleIntfSortedMap.Create(ACapacity: Integer);
  10768. begin
  10769. inherited Create();
  10770. SetCapacity(ACapacity);
  10771. end;
  10772. destructor TJclDoubleIntfSortedMap.Destroy;
  10773. begin
  10774. FReadOnly := False;
  10775. Clear;
  10776. inherited Destroy;
  10777. end;
  10778. procedure TJclDoubleIntfSortedMap.AssignDataTo(Dest: TJclAbstractContainerBase);
  10779. var
  10780. MyDest: TJclDoubleIntfSortedMap;
  10781. begin
  10782. inherited AssignDataTo(Dest);
  10783. if Dest is TJclDoubleIntfSortedMap then
  10784. begin
  10785. MyDest := TJclDoubleIntfSortedMap(Dest);
  10786. MyDest.SetCapacity(FSize);
  10787. MyDest.FEntries := FEntries;
  10788. MyDest.FSize := FSize;
  10789. end;
  10790. end;
  10791. function TJclDoubleIntfSortedMap.BinarySearch(const Key: Double): Integer;
  10792. var
  10793. HiPos, LoPos, CompPos: Integer;
  10794. Comp: Integer;
  10795. begin
  10796. {$IFDEF THREADSAFE}
  10797. if FThreadSafe then
  10798. SyncReaderWriter.BeginRead;
  10799. try
  10800. {$ENDIF THREADSAFE}
  10801. LoPos := 0;
  10802. HiPos := FSize - 1;
  10803. CompPos := (HiPos + LoPos) div 2;
  10804. while HiPos >= LoPos do
  10805. begin
  10806. Comp := KeysCompare(FEntries[CompPos].Key, Key);
  10807. if Comp < 0 then
  10808. LoPos := CompPos + 1
  10809. else
  10810. if Comp > 0 then
  10811. HiPos := CompPos - 1
  10812. else
  10813. begin
  10814. HiPos := CompPos;
  10815. LoPos := CompPos + 1;
  10816. end;
  10817. CompPos := (HiPos + LoPos) div 2;
  10818. end;
  10819. Result := HiPos;
  10820. {$IFDEF THREADSAFE}
  10821. finally
  10822. if FThreadSafe then
  10823. SyncReaderWriter.EndRead;
  10824. end;
  10825. {$ENDIF THREADSAFE}
  10826. end;
  10827. procedure TJclDoubleIntfSortedMap.Clear;
  10828. var
  10829. Index: Integer;
  10830. begin
  10831. if ReadOnly then
  10832. raise EJclReadOnlyError.Create;
  10833. {$IFDEF THREADSAFE}
  10834. if FThreadSafe then
  10835. SyncReaderWriter.BeginWrite;
  10836. try
  10837. {$ENDIF THREADSAFE}
  10838. for Index := 0 to FSize - 1 do
  10839. begin
  10840. FreeKey(FEntries[Index].Key);
  10841. FreeValue(FEntries[Index].Value);
  10842. end;
  10843. FSize := 0;
  10844. AutoPack;
  10845. {$IFDEF THREADSAFE}
  10846. finally
  10847. if FThreadSafe then
  10848. SyncReaderWriter.EndWrite;
  10849. end;
  10850. {$ENDIF THREADSAFE}
  10851. end;
  10852. function TJclDoubleIntfSortedMap.ContainsKey(const Key: Double): Boolean;
  10853. var
  10854. Index: Integer;
  10855. begin
  10856. {$IFDEF THREADSAFE}
  10857. if FThreadSafe then
  10858. SyncReaderWriter.BeginRead;
  10859. try
  10860. {$ENDIF THREADSAFE}
  10861. Index := BinarySearch(Key);
  10862. Result := (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0);
  10863. {$IFDEF THREADSAFE}
  10864. finally
  10865. if FThreadSafe then
  10866. SyncReaderWriter.EndRead;
  10867. end;
  10868. {$ENDIF THREADSAFE}
  10869. end;
  10870. function TJclDoubleIntfSortedMap.ContainsValue(const Value: IInterface): Boolean;
  10871. var
  10872. Index: Integer;
  10873. begin
  10874. {$IFDEF THREADSAFE}
  10875. if FThreadSafe then
  10876. SyncReaderWriter.BeginRead;
  10877. try
  10878. {$ENDIF THREADSAFE}
  10879. Result := False;
  10880. for Index := 0 to FSize - 1 do
  10881. if ValuesCompare(FEntries[Index].Value, Value) = 0 then
  10882. begin
  10883. Result := True;
  10884. Break;
  10885. end;
  10886. {$IFDEF THREADSAFE}
  10887. finally
  10888. if FThreadSafe then
  10889. SyncReaderWriter.EndRead;
  10890. end;
  10891. {$ENDIF THREADSAFE}
  10892. end;
  10893. function TJclDoubleIntfSortedMap.FirstKey: Double;
  10894. begin
  10895. {$IFDEF THREADSAFE}
  10896. if FThreadSafe then
  10897. SyncReaderWriter.BeginRead;
  10898. try
  10899. {$ENDIF THREADSAFE}
  10900. Result := 0.0;
  10901. if FSize > 0 then
  10902. Result := FEntries[0].Key
  10903. else
  10904. if not FReturnDefaultElements then
  10905. raise EJclNoSuchElementError.Create('');
  10906. {$IFDEF THREADSAFE}
  10907. finally
  10908. if FThreadSafe then
  10909. SyncReaderWriter.EndRead;
  10910. end;
  10911. {$ENDIF THREADSAFE}
  10912. end;
  10913. function TJclDoubleIntfSortedMap.Extract(const Key: Double): IInterface;
  10914. var
  10915. Index: Integer;
  10916. begin
  10917. if ReadOnly then
  10918. raise EJclReadOnlyError.Create;
  10919. {$IFDEF THREADSAFE}
  10920. if FThreadSafe then
  10921. SyncReaderWriter.BeginWrite;
  10922. try
  10923. {$ENDIF THREADSAFE}
  10924. Index := BinarySearch(Key);
  10925. if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then
  10926. begin
  10927. Result := FEntries[Index].Value;
  10928. FEntries[Index].Value := nil;
  10929. FreeKey(FEntries[Index].Key);
  10930. if Index < (FSize - 1) then
  10931. MoveArray(FEntries, Index + 1, Index, FSize - Index - 1);
  10932. Dec(FSize);
  10933. AutoPack;
  10934. end
  10935. else
  10936. Result := nil;
  10937. {$IFDEF THREADSAFE}
  10938. finally
  10939. if FThreadSafe then
  10940. SyncReaderWriter.EndWrite;
  10941. end;
  10942. {$ENDIF THREADSAFE}
  10943. end;
  10944. function TJclDoubleIntfSortedMap.GetValue(const Key: Double): IInterface;
  10945. var
  10946. Index: Integer;
  10947. begin
  10948. {$IFDEF THREADSAFE}
  10949. if FThreadSafe then
  10950. SyncReaderWriter.BeginRead;
  10951. try
  10952. {$ENDIF THREADSAFE}
  10953. Index := BinarySearch(Key);
  10954. Result := nil;
  10955. if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then
  10956. Result := FEntries[Index].Value
  10957. else if not FReturnDefaultElements then
  10958. raise EJclNoSuchElementError.Create('');
  10959. {$IFDEF THREADSAFE}
  10960. finally
  10961. if FThreadSafe then
  10962. SyncReaderWriter.EndRead;
  10963. end;
  10964. {$ENDIF THREADSAFE}
  10965. end;
  10966. function TJclDoubleIntfSortedMap.HeadMap(const ToKey: Double): IJclDoubleIntfSortedMap;
  10967. var
  10968. ToIndex: Integer;
  10969. NewMap: TJclDoubleIntfSortedMap;
  10970. begin
  10971. {$IFDEF THREADSAFE}
  10972. if FThreadSafe then
  10973. SyncReaderWriter.BeginRead;
  10974. try
  10975. {$ENDIF THREADSAFE}
  10976. NewMap := CreateEmptyContainer as TJclDoubleIntfSortedMap;
  10977. ToIndex := BinarySearch(ToKey);
  10978. if ToIndex >= 0 then
  10979. begin
  10980. NewMap.SetCapacity(ToIndex + 1);
  10981. NewMap.FSize := ToIndex + 1;
  10982. while ToIndex >= 0 do
  10983. begin
  10984. NewMap.FEntries[ToIndex] := FEntries[ToIndex];
  10985. Dec(ToIndex);
  10986. end;
  10987. end;
  10988. Result := NewMap;
  10989. {$IFDEF THREADSAFE}
  10990. finally
  10991. if FThreadSafe then
  10992. SyncReaderWriter.EndRead;
  10993. end;
  10994. {$ENDIF THREADSAFE}
  10995. end;
  10996. function TJclDoubleIntfSortedMap.IsEmpty: Boolean;
  10997. begin
  10998. {$IFDEF THREADSAFE}
  10999. if FThreadSafe then
  11000. SyncReaderWriter.BeginRead;
  11001. try
  11002. {$ENDIF THREADSAFE}
  11003. Result := FSize = 0;
  11004. {$IFDEF THREADSAFE}
  11005. finally
  11006. if FThreadSafe then
  11007. SyncReaderWriter.EndRead;
  11008. end;
  11009. {$ENDIF THREADSAFE}
  11010. end;
  11011. function TJclDoubleIntfSortedMap.KeyOfValue(const Value: IInterface): Double;
  11012. var
  11013. Index: Integer;
  11014. Found: Boolean;
  11015. begin
  11016. {$IFDEF THREADSAFE}
  11017. if FThreadSafe then
  11018. SyncReaderWriter.BeginRead;
  11019. try
  11020. {$ENDIF THREADSAFE}
  11021. Found := False;
  11022. Result := 0.0;
  11023. for Index := 0 to FSize - 1 do
  11024. if ValuesCompare(FEntries[Index].Value, Value) = 0 then
  11025. begin
  11026. Result := FEntries[Index].Key;
  11027. Found := True;
  11028. Break;
  11029. end;
  11030. if (not Found) and (not FReturnDefaultElements) then
  11031. raise EJclNoSuchElementError.Create('');
  11032. {$IFDEF THREADSAFE}
  11033. finally
  11034. if FThreadSafe then
  11035. SyncReaderWriter.EndRead;
  11036. end;
  11037. {$ENDIF THREADSAFE}
  11038. end;
  11039. function TJclDoubleIntfSortedMap.KeySet: IJclDoubleSet;
  11040. var
  11041. Index: Integer;
  11042. begin
  11043. {$IFDEF THREADSAFE}
  11044. if FThreadSafe then
  11045. SyncReaderWriter.BeginRead;
  11046. try
  11047. {$ENDIF THREADSAFE}
  11048. Result := TJclDoubleArraySet.Create(FSize);
  11049. for Index := 0 to FSize - 1 do
  11050. Result.Add(FEntries[Index].Key);
  11051. {$IFDEF THREADSAFE}
  11052. finally
  11053. if FThreadSafe then
  11054. SyncReaderWriter.EndRead;
  11055. end;
  11056. {$ENDIF THREADSAFE}
  11057. end;
  11058. function TJclDoubleIntfSortedMap.LastKey: Double;
  11059. begin
  11060. {$IFDEF THREADSAFE}
  11061. if FThreadSafe then
  11062. SyncReaderWriter.BeginRead;
  11063. try
  11064. {$ENDIF THREADSAFE}
  11065. Result := 0.0;
  11066. if FSize > 0 then
  11067. Result := FEntries[FSize - 1].Key
  11068. else
  11069. if not FReturnDefaultElements then
  11070. raise EJclNoSuchElementError.Create('');
  11071. {$IFDEF THREADSAFE}
  11072. finally
  11073. if FThreadSafe then
  11074. SyncReaderWriter.EndRead;
  11075. end;
  11076. {$ENDIF THREADSAFE}
  11077. end;
  11078. function TJclDoubleIntfSortedMap.MapEquals(const AMap: IJclDoubleIntfMap): Boolean;
  11079. var
  11080. It: IJclDoubleIterator;
  11081. Index: Integer;
  11082. AKey: Double;
  11083. begin
  11084. {$IFDEF THREADSAFE}
  11085. if FThreadSafe then
  11086. SyncReaderWriter.BeginRead;
  11087. try
  11088. {$ENDIF THREADSAFE}
  11089. Result := False;
  11090. if AMap = nil then
  11091. Exit;
  11092. if FSize <> AMap.Size then
  11093. Exit;
  11094. It := AMap.KeySet.First;
  11095. Index := 0;
  11096. while It.HasNext do
  11097. begin
  11098. if Index >= FSize then
  11099. Exit;
  11100. AKey := It.Next;
  11101. if ValuesCompare(AMap.GetValue(AKey), FEntries[Index].Value) <> 0 then
  11102. Exit;
  11103. Inc(Index);
  11104. end;
  11105. Result := True;
  11106. {$IFDEF THREADSAFE}
  11107. finally
  11108. if FThreadSafe then
  11109. SyncReaderWriter.EndRead;
  11110. end;
  11111. {$ENDIF THREADSAFE}
  11112. end;
  11113. procedure TJclDoubleIntfSortedMap.FinalizeArrayBeforeMove(var List: TJclDoubleIntfSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  11114. begin
  11115. Assert(Count > 0);
  11116. if FromIndex < ToIndex then
  11117. begin
  11118. if Count > (ToIndex - FromIndex) then
  11119. Finalize(List[FromIndex + Count], ToIndex - FromIndex)
  11120. else
  11121. Finalize(List[ToIndex], Count);
  11122. end
  11123. else
  11124. if FromIndex > ToIndex then
  11125. begin
  11126. if Count > (FromIndex - ToIndex) then
  11127. Count := FromIndex - ToIndex;
  11128. Finalize(List[ToIndex], Count)
  11129. end;
  11130. end;
  11131. procedure TJclDoubleIntfSortedMap.InitializeArray(var List: TJclDoubleIntfSortedMapEntryArray; FromIndex, Count: SizeInt);
  11132. begin
  11133. {$IFDEF FPC}
  11134. while Count > 0 do
  11135. begin
  11136. Initialize(List[FromIndex]);
  11137. Inc(FromIndex);
  11138. Dec(Count);
  11139. end;
  11140. {$ELSE ~FPC}
  11141. Initialize(List[FromIndex], Count);
  11142. {$ENDIF ~FPC}
  11143. end;
  11144. procedure TJclDoubleIntfSortedMap.InitializeArrayAfterMove(var List: TJclDoubleIntfSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  11145. begin
  11146. { Keep reference counting working }
  11147. if FromIndex < ToIndex then
  11148. begin
  11149. if (ToIndex - FromIndex) < Count then
  11150. Count := ToIndex - FromIndex;
  11151. InitializeArray(List, FromIndex, Count);
  11152. end
  11153. else
  11154. if FromIndex > ToIndex then
  11155. begin
  11156. if (FromIndex - ToIndex) < Count then
  11157. InitializeArray(List, ToIndex + Count, FromIndex - ToIndex)
  11158. else
  11159. InitializeArray(List, FromIndex, Count);
  11160. end;
  11161. end;
  11162. procedure TJclDoubleIntfSortedMap.MoveArray(var List: TJclDoubleIntfSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  11163. begin
  11164. if Count > 0 then
  11165. begin
  11166. FinalizeArrayBeforeMove(List, FromIndex, ToIndex, Count);
  11167. Move(List[FromIndex], List[ToIndex], Count * SizeOf(List[0]));
  11168. InitializeArrayAfterMove(List, FromIndex, ToIndex, Count);
  11169. end;
  11170. end;
  11171. procedure TJclDoubleIntfSortedMap.PutAll(const AMap: IJclDoubleIntfMap);
  11172. var
  11173. It: IJclDoubleIterator;
  11174. Key: Double;
  11175. begin
  11176. if ReadOnly then
  11177. raise EJclReadOnlyError.Create;
  11178. {$IFDEF THREADSAFE}
  11179. if FThreadSafe then
  11180. SyncReaderWriter.BeginWrite;
  11181. try
  11182. {$ENDIF THREADSAFE}
  11183. if AMap = nil then
  11184. Exit;
  11185. It := AMap.KeySet.First;
  11186. while It.HasNext do
  11187. begin
  11188. Key := It.Next;
  11189. PutValue(Key, AMap.GetValue(Key));
  11190. end;
  11191. {$IFDEF THREADSAFE}
  11192. finally
  11193. if FThreadSafe then
  11194. SyncReaderWriter.EndWrite;
  11195. end;
  11196. {$ENDIF THREADSAFE}
  11197. end;
  11198. procedure TJclDoubleIntfSortedMap.PutValue(const Key: Double; const Value: IInterface);
  11199. var
  11200. Index: Integer;
  11201. begin
  11202. if ReadOnly then
  11203. raise EJclReadOnlyError.Create;
  11204. {$IFDEF THREADSAFE}
  11205. if FThreadSafe then
  11206. SyncReaderWriter.BeginWrite;
  11207. try
  11208. {$ENDIF THREADSAFE}
  11209. if FAllowDefaultElements or ((KeysCompare(Key, 0.0) <> 0) and (ValuesCompare(Value, nil) <> 0)) then
  11210. begin
  11211. Index := BinarySearch(Key);
  11212. if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then
  11213. begin
  11214. FreeValue(FEntries[Index].Value);
  11215. FEntries[Index].Value := Value;
  11216. end
  11217. else
  11218. begin
  11219. if FSize = FCapacity then
  11220. AutoGrow;
  11221. if FSize < FCapacity then
  11222. begin
  11223. Inc(Index);
  11224. if (Index < FSize) and (KeysCompare(FEntries[Index].Key, Key) <> 0) then
  11225. MoveArray(FEntries, Index, Index + 1, FSize - Index);
  11226. FEntries[Index].Key := Key;
  11227. FEntries[Index].Value := Value;
  11228. Inc(FSize);
  11229. end;
  11230. end;
  11231. end;
  11232. {$IFDEF THREADSAFE}
  11233. finally
  11234. if FThreadSafe then
  11235. SyncReaderWriter.EndWrite;
  11236. end;
  11237. {$ENDIF THREADSAFE}
  11238. end;
  11239. function TJclDoubleIntfSortedMap.Remove(const Key: Double): IInterface;
  11240. begin
  11241. if ReadOnly then
  11242. raise EJclReadOnlyError.Create;
  11243. {$IFDEF THREADSAFE}
  11244. if FThreadSafe then
  11245. SyncReaderWriter.BeginWrite;
  11246. try
  11247. {$ENDIF THREADSAFE}
  11248. Result := Extract(Key);
  11249. Result := FreeValue(Result);
  11250. {$IFDEF THREADSAFE}
  11251. finally
  11252. if FThreadSafe then
  11253. SyncReaderWriter.EndWrite;
  11254. end;
  11255. {$ENDIF THREADSAFE}
  11256. end;
  11257. procedure TJclDoubleIntfSortedMap.SetCapacity(Value: Integer);
  11258. begin
  11259. if ReadOnly then
  11260. raise EJclReadOnlyError.Create;
  11261. {$IFDEF THREADSAFE}
  11262. if FThreadSafe then
  11263. SyncReaderWriter.BeginWrite;
  11264. try
  11265. {$ENDIF THREADSAFE}
  11266. if FSize <= Value then
  11267. begin
  11268. SetLength(FEntries, Value);
  11269. inherited SetCapacity(Value);
  11270. end
  11271. else
  11272. raise EJclOperationNotSupportedError.Create;
  11273. {$IFDEF THREADSAFE}
  11274. finally
  11275. if FThreadSafe then
  11276. SyncReaderWriter.EndWrite;
  11277. end;
  11278. {$ENDIF THREADSAFE}
  11279. end;
  11280. function TJclDoubleIntfSortedMap.Size: Integer;
  11281. begin
  11282. Result := FSize;
  11283. end;
  11284. function TJclDoubleIntfSortedMap.SubMap(const FromKey, ToKey: Double): IJclDoubleIntfSortedMap;
  11285. var
  11286. FromIndex, ToIndex: Integer;
  11287. NewMap: TJclDoubleIntfSortedMap;
  11288. begin
  11289. {$IFDEF THREADSAFE}
  11290. if FThreadSafe then
  11291. SyncReaderWriter.BeginRead;
  11292. try
  11293. {$ENDIF THREADSAFE}
  11294. NewMap := CreateEmptyContainer as TJclDoubleIntfSortedMap;
  11295. FromIndex := BinarySearch(FromKey);
  11296. if (FromIndex = -1) or (KeysCompare(FEntries[FromIndex].Key, FromKey) < 0) then
  11297. Inc(FromIndex);
  11298. ToIndex := BinarySearch(ToKey);
  11299. if (FromIndex >= 0) and (FromIndex <= ToIndex) then
  11300. begin
  11301. NewMap.SetCapacity(ToIndex - FromIndex + 1);
  11302. NewMap.FSize := ToIndex - FromIndex + 1;
  11303. while ToIndex >= FromIndex do
  11304. begin
  11305. NewMap.FEntries[ToIndex - FromIndex] := FEntries[ToIndex];
  11306. Dec(ToIndex);
  11307. end;
  11308. end;
  11309. Result := NewMap;
  11310. {$IFDEF THREADSAFE}
  11311. finally
  11312. if FThreadSafe then
  11313. SyncReaderWriter.EndRead;
  11314. end;
  11315. {$ENDIF THREADSAFE}
  11316. end;
  11317. function TJclDoubleIntfSortedMap.TailMap(const FromKey: Double): IJclDoubleIntfSortedMap;
  11318. var
  11319. FromIndex, Index: Integer;
  11320. NewMap: TJclDoubleIntfSortedMap;
  11321. begin
  11322. {$IFDEF THREADSAFE}
  11323. if FThreadSafe then
  11324. SyncReaderWriter.BeginRead;
  11325. try
  11326. {$ENDIF THREADSAFE}
  11327. NewMap := CreateEmptyContainer as TJclDoubleIntfSortedMap;
  11328. FromIndex := BinarySearch(FromKey);
  11329. if (FromIndex = -1) or (KeysCompare(FEntries[FromIndex].Key, FromKey) < 0) then
  11330. Inc(FromIndex);
  11331. if (FromIndex >= 0) and (FromIndex < FSize) then
  11332. begin
  11333. NewMap.SetCapacity(FSize - FromIndex);
  11334. NewMap.FSize := FSize - FromIndex;
  11335. Index := FromIndex;
  11336. while Index < FSize do
  11337. begin
  11338. NewMap.FEntries[Index - FromIndex] := FEntries[Index];
  11339. Inc(Index);
  11340. end;
  11341. end;
  11342. Result := NewMap;
  11343. {$IFDEF THREADSAFE}
  11344. finally
  11345. if FThreadSafe then
  11346. SyncReaderWriter.EndRead;
  11347. end;
  11348. {$ENDIF THREADSAFE}
  11349. end;
  11350. function TJclDoubleIntfSortedMap.Values: IJclIntfCollection;
  11351. var
  11352. Index: Integer;
  11353. begin
  11354. {$IFDEF THREADSAFE}
  11355. if FThreadSafe then
  11356. SyncReaderWriter.BeginRead;
  11357. try
  11358. {$ENDIF THREADSAFE}
  11359. Result := TJclIntfArrayList.Create(FSize);
  11360. for Index := 0 to FSize - 1 do
  11361. Result.Add(FEntries[Index].Value);
  11362. {$IFDEF THREADSAFE}
  11363. finally
  11364. if FThreadSafe then
  11365. SyncReaderWriter.EndRead;
  11366. end;
  11367. {$ENDIF THREADSAFE}
  11368. end;
  11369. function TJclDoubleIntfSortedMap.CreateEmptyContainer: TJclAbstractContainerBase;
  11370. begin
  11371. Result := TJclDoubleIntfSortedMap.Create(FSize);
  11372. AssignPropertiesTo(Result);
  11373. end;
  11374. function TJclDoubleIntfSortedMap.FreeKey(var Key: Double): Double;
  11375. begin
  11376. Result := Key;
  11377. Key := 0.0;
  11378. end;
  11379. function TJclDoubleIntfSortedMap.FreeValue(var Value: IInterface): IInterface;
  11380. begin
  11381. Result := Value;
  11382. Value := nil;
  11383. end;
  11384. function TJclDoubleIntfSortedMap.KeysCompare(const A, B: Double): Integer;
  11385. begin
  11386. Result := ItemsCompare(A, B);
  11387. end;
  11388. function TJclDoubleIntfSortedMap.ValuesCompare(const A, B: IInterface): Integer;
  11389. begin
  11390. Result := IntfSimpleCompare(A, B);
  11391. end;
  11392. //=== { TJclIntfDoubleSortedMap } ==============================================
  11393. constructor TJclIntfDoubleSortedMap.Create(ACapacity: Integer);
  11394. begin
  11395. inherited Create();
  11396. SetCapacity(ACapacity);
  11397. end;
  11398. destructor TJclIntfDoubleSortedMap.Destroy;
  11399. begin
  11400. FReadOnly := False;
  11401. Clear;
  11402. inherited Destroy;
  11403. end;
  11404. procedure TJclIntfDoubleSortedMap.AssignDataTo(Dest: TJclAbstractContainerBase);
  11405. var
  11406. MyDest: TJclIntfDoubleSortedMap;
  11407. begin
  11408. inherited AssignDataTo(Dest);
  11409. if Dest is TJclIntfDoubleSortedMap then
  11410. begin
  11411. MyDest := TJclIntfDoubleSortedMap(Dest);
  11412. MyDest.SetCapacity(FSize);
  11413. MyDest.FEntries := FEntries;
  11414. MyDest.FSize := FSize;
  11415. end;
  11416. end;
  11417. function TJclIntfDoubleSortedMap.BinarySearch(const Key: IInterface): Integer;
  11418. var
  11419. HiPos, LoPos, CompPos: Integer;
  11420. Comp: Integer;
  11421. begin
  11422. {$IFDEF THREADSAFE}
  11423. if FThreadSafe then
  11424. SyncReaderWriter.BeginRead;
  11425. try
  11426. {$ENDIF THREADSAFE}
  11427. LoPos := 0;
  11428. HiPos := FSize - 1;
  11429. CompPos := (HiPos + LoPos) div 2;
  11430. while HiPos >= LoPos do
  11431. begin
  11432. Comp := KeysCompare(FEntries[CompPos].Key, Key);
  11433. if Comp < 0 then
  11434. LoPos := CompPos + 1
  11435. else
  11436. if Comp > 0 then
  11437. HiPos := CompPos - 1
  11438. else
  11439. begin
  11440. HiPos := CompPos;
  11441. LoPos := CompPos + 1;
  11442. end;
  11443. CompPos := (HiPos + LoPos) div 2;
  11444. end;
  11445. Result := HiPos;
  11446. {$IFDEF THREADSAFE}
  11447. finally
  11448. if FThreadSafe then
  11449. SyncReaderWriter.EndRead;
  11450. end;
  11451. {$ENDIF THREADSAFE}
  11452. end;
  11453. procedure TJclIntfDoubleSortedMap.Clear;
  11454. var
  11455. Index: Integer;
  11456. begin
  11457. if ReadOnly then
  11458. raise EJclReadOnlyError.Create;
  11459. {$IFDEF THREADSAFE}
  11460. if FThreadSafe then
  11461. SyncReaderWriter.BeginWrite;
  11462. try
  11463. {$ENDIF THREADSAFE}
  11464. for Index := 0 to FSize - 1 do
  11465. begin
  11466. FreeKey(FEntries[Index].Key);
  11467. FreeValue(FEntries[Index].Value);
  11468. end;
  11469. FSize := 0;
  11470. AutoPack;
  11471. {$IFDEF THREADSAFE}
  11472. finally
  11473. if FThreadSafe then
  11474. SyncReaderWriter.EndWrite;
  11475. end;
  11476. {$ENDIF THREADSAFE}
  11477. end;
  11478. function TJclIntfDoubleSortedMap.ContainsKey(const Key: IInterface): Boolean;
  11479. var
  11480. Index: Integer;
  11481. begin
  11482. {$IFDEF THREADSAFE}
  11483. if FThreadSafe then
  11484. SyncReaderWriter.BeginRead;
  11485. try
  11486. {$ENDIF THREADSAFE}
  11487. Index := BinarySearch(Key);
  11488. Result := (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0);
  11489. {$IFDEF THREADSAFE}
  11490. finally
  11491. if FThreadSafe then
  11492. SyncReaderWriter.EndRead;
  11493. end;
  11494. {$ENDIF THREADSAFE}
  11495. end;
  11496. function TJclIntfDoubleSortedMap.ContainsValue(const Value: Double): Boolean;
  11497. var
  11498. Index: Integer;
  11499. begin
  11500. {$IFDEF THREADSAFE}
  11501. if FThreadSafe then
  11502. SyncReaderWriter.BeginRead;
  11503. try
  11504. {$ENDIF THREADSAFE}
  11505. Result := False;
  11506. for Index := 0 to FSize - 1 do
  11507. if ValuesCompare(FEntries[Index].Value, Value) = 0 then
  11508. begin
  11509. Result := True;
  11510. Break;
  11511. end;
  11512. {$IFDEF THREADSAFE}
  11513. finally
  11514. if FThreadSafe then
  11515. SyncReaderWriter.EndRead;
  11516. end;
  11517. {$ENDIF THREADSAFE}
  11518. end;
  11519. function TJclIntfDoubleSortedMap.FirstKey: IInterface;
  11520. begin
  11521. {$IFDEF THREADSAFE}
  11522. if FThreadSafe then
  11523. SyncReaderWriter.BeginRead;
  11524. try
  11525. {$ENDIF THREADSAFE}
  11526. Result := nil;
  11527. if FSize > 0 then
  11528. Result := FEntries[0].Key
  11529. else
  11530. if not FReturnDefaultElements then
  11531. raise EJclNoSuchElementError.Create('');
  11532. {$IFDEF THREADSAFE}
  11533. finally
  11534. if FThreadSafe then
  11535. SyncReaderWriter.EndRead;
  11536. end;
  11537. {$ENDIF THREADSAFE}
  11538. end;
  11539. function TJclIntfDoubleSortedMap.Extract(const Key: IInterface): Double;
  11540. var
  11541. Index: Integer;
  11542. begin
  11543. if ReadOnly then
  11544. raise EJclReadOnlyError.Create;
  11545. {$IFDEF THREADSAFE}
  11546. if FThreadSafe then
  11547. SyncReaderWriter.BeginWrite;
  11548. try
  11549. {$ENDIF THREADSAFE}
  11550. Index := BinarySearch(Key);
  11551. if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then
  11552. begin
  11553. Result := FEntries[Index].Value;
  11554. FEntries[Index].Value := 0.0;
  11555. FreeKey(FEntries[Index].Key);
  11556. if Index < (FSize - 1) then
  11557. MoveArray(FEntries, Index + 1, Index, FSize - Index - 1);
  11558. Dec(FSize);
  11559. AutoPack;
  11560. end
  11561. else
  11562. Result := 0.0;
  11563. {$IFDEF THREADSAFE}
  11564. finally
  11565. if FThreadSafe then
  11566. SyncReaderWriter.EndWrite;
  11567. end;
  11568. {$ENDIF THREADSAFE}
  11569. end;
  11570. function TJclIntfDoubleSortedMap.GetValue(const Key: IInterface): Double;
  11571. var
  11572. Index: Integer;
  11573. begin
  11574. {$IFDEF THREADSAFE}
  11575. if FThreadSafe then
  11576. SyncReaderWriter.BeginRead;
  11577. try
  11578. {$ENDIF THREADSAFE}
  11579. Index := BinarySearch(Key);
  11580. Result := 0.0;
  11581. if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then
  11582. Result := FEntries[Index].Value
  11583. else if not FReturnDefaultElements then
  11584. raise EJclNoSuchElementError.Create('');
  11585. {$IFDEF THREADSAFE}
  11586. finally
  11587. if FThreadSafe then
  11588. SyncReaderWriter.EndRead;
  11589. end;
  11590. {$ENDIF THREADSAFE}
  11591. end;
  11592. function TJclIntfDoubleSortedMap.HeadMap(const ToKey: IInterface): IJclIntfDoubleSortedMap;
  11593. var
  11594. ToIndex: Integer;
  11595. NewMap: TJclIntfDoubleSortedMap;
  11596. begin
  11597. {$IFDEF THREADSAFE}
  11598. if FThreadSafe then
  11599. SyncReaderWriter.BeginRead;
  11600. try
  11601. {$ENDIF THREADSAFE}
  11602. NewMap := CreateEmptyContainer as TJclIntfDoubleSortedMap;
  11603. ToIndex := BinarySearch(ToKey);
  11604. if ToIndex >= 0 then
  11605. begin
  11606. NewMap.SetCapacity(ToIndex + 1);
  11607. NewMap.FSize := ToIndex + 1;
  11608. while ToIndex >= 0 do
  11609. begin
  11610. NewMap.FEntries[ToIndex] := FEntries[ToIndex];
  11611. Dec(ToIndex);
  11612. end;
  11613. end;
  11614. Result := NewMap;
  11615. {$IFDEF THREADSAFE}
  11616. finally
  11617. if FThreadSafe then
  11618. SyncReaderWriter.EndRead;
  11619. end;
  11620. {$ENDIF THREADSAFE}
  11621. end;
  11622. function TJclIntfDoubleSortedMap.IsEmpty: Boolean;
  11623. begin
  11624. {$IFDEF THREADSAFE}
  11625. if FThreadSafe then
  11626. SyncReaderWriter.BeginRead;
  11627. try
  11628. {$ENDIF THREADSAFE}
  11629. Result := FSize = 0;
  11630. {$IFDEF THREADSAFE}
  11631. finally
  11632. if FThreadSafe then
  11633. SyncReaderWriter.EndRead;
  11634. end;
  11635. {$ENDIF THREADSAFE}
  11636. end;
  11637. function TJclIntfDoubleSortedMap.KeyOfValue(const Value: Double): IInterface;
  11638. var
  11639. Index: Integer;
  11640. Found: Boolean;
  11641. begin
  11642. {$IFDEF THREADSAFE}
  11643. if FThreadSafe then
  11644. SyncReaderWriter.BeginRead;
  11645. try
  11646. {$ENDIF THREADSAFE}
  11647. Found := False;
  11648. Result := nil;
  11649. for Index := 0 to FSize - 1 do
  11650. if ValuesCompare(FEntries[Index].Value, Value) = 0 then
  11651. begin
  11652. Result := FEntries[Index].Key;
  11653. Found := True;
  11654. Break;
  11655. end;
  11656. if (not Found) and (not FReturnDefaultElements) then
  11657. raise EJclNoSuchElementError.Create('');
  11658. {$IFDEF THREADSAFE}
  11659. finally
  11660. if FThreadSafe then
  11661. SyncReaderWriter.EndRead;
  11662. end;
  11663. {$ENDIF THREADSAFE}
  11664. end;
  11665. function TJclIntfDoubleSortedMap.KeySet: IJclIntfSet;
  11666. var
  11667. Index: Integer;
  11668. begin
  11669. {$IFDEF THREADSAFE}
  11670. if FThreadSafe then
  11671. SyncReaderWriter.BeginRead;
  11672. try
  11673. {$ENDIF THREADSAFE}
  11674. Result := TJclIntfArraySet.Create(FSize);
  11675. for Index := 0 to FSize - 1 do
  11676. Result.Add(FEntries[Index].Key);
  11677. {$IFDEF THREADSAFE}
  11678. finally
  11679. if FThreadSafe then
  11680. SyncReaderWriter.EndRead;
  11681. end;
  11682. {$ENDIF THREADSAFE}
  11683. end;
  11684. function TJclIntfDoubleSortedMap.LastKey: IInterface;
  11685. begin
  11686. {$IFDEF THREADSAFE}
  11687. if FThreadSafe then
  11688. SyncReaderWriter.BeginRead;
  11689. try
  11690. {$ENDIF THREADSAFE}
  11691. Result := nil;
  11692. if FSize > 0 then
  11693. Result := FEntries[FSize - 1].Key
  11694. else
  11695. if not FReturnDefaultElements then
  11696. raise EJclNoSuchElementError.Create('');
  11697. {$IFDEF THREADSAFE}
  11698. finally
  11699. if FThreadSafe then
  11700. SyncReaderWriter.EndRead;
  11701. end;
  11702. {$ENDIF THREADSAFE}
  11703. end;
  11704. function TJclIntfDoubleSortedMap.MapEquals(const AMap: IJclIntfDoubleMap): Boolean;
  11705. var
  11706. It: IJclIntfIterator;
  11707. Index: Integer;
  11708. AKey: IInterface;
  11709. begin
  11710. {$IFDEF THREADSAFE}
  11711. if FThreadSafe then
  11712. SyncReaderWriter.BeginRead;
  11713. try
  11714. {$ENDIF THREADSAFE}
  11715. Result := False;
  11716. if AMap = nil then
  11717. Exit;
  11718. if FSize <> AMap.Size then
  11719. Exit;
  11720. It := AMap.KeySet.First;
  11721. Index := 0;
  11722. while It.HasNext do
  11723. begin
  11724. if Index >= FSize then
  11725. Exit;
  11726. AKey := It.Next;
  11727. if ValuesCompare(AMap.GetValue(AKey), FEntries[Index].Value) <> 0 then
  11728. Exit;
  11729. Inc(Index);
  11730. end;
  11731. Result := True;
  11732. {$IFDEF THREADSAFE}
  11733. finally
  11734. if FThreadSafe then
  11735. SyncReaderWriter.EndRead;
  11736. end;
  11737. {$ENDIF THREADSAFE}
  11738. end;
  11739. procedure TJclIntfDoubleSortedMap.FinalizeArrayBeforeMove(var List: TJclIntfDoubleSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  11740. begin
  11741. Assert(Count > 0);
  11742. if FromIndex < ToIndex then
  11743. begin
  11744. if Count > (ToIndex - FromIndex) then
  11745. Finalize(List[FromIndex + Count], ToIndex - FromIndex)
  11746. else
  11747. Finalize(List[ToIndex], Count);
  11748. end
  11749. else
  11750. if FromIndex > ToIndex then
  11751. begin
  11752. if Count > (FromIndex - ToIndex) then
  11753. Count := FromIndex - ToIndex;
  11754. Finalize(List[ToIndex], Count)
  11755. end;
  11756. end;
  11757. procedure TJclIntfDoubleSortedMap.InitializeArray(var List: TJclIntfDoubleSortedMapEntryArray; FromIndex, Count: SizeInt);
  11758. begin
  11759. {$IFDEF FPC}
  11760. while Count > 0 do
  11761. begin
  11762. Initialize(List[FromIndex]);
  11763. Inc(FromIndex);
  11764. Dec(Count);
  11765. end;
  11766. {$ELSE ~FPC}
  11767. Initialize(List[FromIndex], Count);
  11768. {$ENDIF ~FPC}
  11769. end;
  11770. procedure TJclIntfDoubleSortedMap.InitializeArrayAfterMove(var List: TJclIntfDoubleSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  11771. begin
  11772. { Keep reference counting working }
  11773. if FromIndex < ToIndex then
  11774. begin
  11775. if (ToIndex - FromIndex) < Count then
  11776. Count := ToIndex - FromIndex;
  11777. InitializeArray(List, FromIndex, Count);
  11778. end
  11779. else
  11780. if FromIndex > ToIndex then
  11781. begin
  11782. if (FromIndex - ToIndex) < Count then
  11783. InitializeArray(List, ToIndex + Count, FromIndex - ToIndex)
  11784. else
  11785. InitializeArray(List, FromIndex, Count);
  11786. end;
  11787. end;
  11788. procedure TJclIntfDoubleSortedMap.MoveArray(var List: TJclIntfDoubleSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  11789. begin
  11790. if Count > 0 then
  11791. begin
  11792. FinalizeArrayBeforeMove(List, FromIndex, ToIndex, Count);
  11793. Move(List[FromIndex], List[ToIndex], Count * SizeOf(List[0]));
  11794. InitializeArrayAfterMove(List, FromIndex, ToIndex, Count);
  11795. end;
  11796. end;
  11797. procedure TJclIntfDoubleSortedMap.PutAll(const AMap: IJclIntfDoubleMap);
  11798. var
  11799. It: IJclIntfIterator;
  11800. Key: IInterface;
  11801. begin
  11802. if ReadOnly then
  11803. raise EJclReadOnlyError.Create;
  11804. {$IFDEF THREADSAFE}
  11805. if FThreadSafe then
  11806. SyncReaderWriter.BeginWrite;
  11807. try
  11808. {$ENDIF THREADSAFE}
  11809. if AMap = nil then
  11810. Exit;
  11811. It := AMap.KeySet.First;
  11812. while It.HasNext do
  11813. begin
  11814. Key := It.Next;
  11815. PutValue(Key, AMap.GetValue(Key));
  11816. end;
  11817. {$IFDEF THREADSAFE}
  11818. finally
  11819. if FThreadSafe then
  11820. SyncReaderWriter.EndWrite;
  11821. end;
  11822. {$ENDIF THREADSAFE}
  11823. end;
  11824. procedure TJclIntfDoubleSortedMap.PutValue(const Key: IInterface; const Value: Double);
  11825. var
  11826. Index: Integer;
  11827. begin
  11828. if ReadOnly then
  11829. raise EJclReadOnlyError.Create;
  11830. {$IFDEF THREADSAFE}
  11831. if FThreadSafe then
  11832. SyncReaderWriter.BeginWrite;
  11833. try
  11834. {$ENDIF THREADSAFE}
  11835. if FAllowDefaultElements or ((KeysCompare(Key, nil) <> 0) and (ValuesCompare(Value, 0.0) <> 0)) then
  11836. begin
  11837. Index := BinarySearch(Key);
  11838. if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then
  11839. begin
  11840. FreeValue(FEntries[Index].Value);
  11841. FEntries[Index].Value := Value;
  11842. end
  11843. else
  11844. begin
  11845. if FSize = FCapacity then
  11846. AutoGrow;
  11847. if FSize < FCapacity then
  11848. begin
  11849. Inc(Index);
  11850. if (Index < FSize) and (KeysCompare(FEntries[Index].Key, Key) <> 0) then
  11851. MoveArray(FEntries, Index, Index + 1, FSize - Index);
  11852. FEntries[Index].Key := Key;
  11853. FEntries[Index].Value := Value;
  11854. Inc(FSize);
  11855. end;
  11856. end;
  11857. end;
  11858. {$IFDEF THREADSAFE}
  11859. finally
  11860. if FThreadSafe then
  11861. SyncReaderWriter.EndWrite;
  11862. end;
  11863. {$ENDIF THREADSAFE}
  11864. end;
  11865. function TJclIntfDoubleSortedMap.Remove(const Key: IInterface): Double;
  11866. begin
  11867. if ReadOnly then
  11868. raise EJclReadOnlyError.Create;
  11869. {$IFDEF THREADSAFE}
  11870. if FThreadSafe then
  11871. SyncReaderWriter.BeginWrite;
  11872. try
  11873. {$ENDIF THREADSAFE}
  11874. Result := Extract(Key);
  11875. Result := FreeValue(Result);
  11876. {$IFDEF THREADSAFE}
  11877. finally
  11878. if FThreadSafe then
  11879. SyncReaderWriter.EndWrite;
  11880. end;
  11881. {$ENDIF THREADSAFE}
  11882. end;
  11883. procedure TJclIntfDoubleSortedMap.SetCapacity(Value: Integer);
  11884. begin
  11885. if ReadOnly then
  11886. raise EJclReadOnlyError.Create;
  11887. {$IFDEF THREADSAFE}
  11888. if FThreadSafe then
  11889. SyncReaderWriter.BeginWrite;
  11890. try
  11891. {$ENDIF THREADSAFE}
  11892. if FSize <= Value then
  11893. begin
  11894. SetLength(FEntries, Value);
  11895. inherited SetCapacity(Value);
  11896. end
  11897. else
  11898. raise EJclOperationNotSupportedError.Create;
  11899. {$IFDEF THREADSAFE}
  11900. finally
  11901. if FThreadSafe then
  11902. SyncReaderWriter.EndWrite;
  11903. end;
  11904. {$ENDIF THREADSAFE}
  11905. end;
  11906. function TJclIntfDoubleSortedMap.Size: Integer;
  11907. begin
  11908. Result := FSize;
  11909. end;
  11910. function TJclIntfDoubleSortedMap.SubMap(const FromKey, ToKey: IInterface): IJclIntfDoubleSortedMap;
  11911. var
  11912. FromIndex, ToIndex: Integer;
  11913. NewMap: TJclIntfDoubleSortedMap;
  11914. begin
  11915. {$IFDEF THREADSAFE}
  11916. if FThreadSafe then
  11917. SyncReaderWriter.BeginRead;
  11918. try
  11919. {$ENDIF THREADSAFE}
  11920. NewMap := CreateEmptyContainer as TJclIntfDoubleSortedMap;
  11921. FromIndex := BinarySearch(FromKey);
  11922. if (FromIndex = -1) or (KeysCompare(FEntries[FromIndex].Key, FromKey) < 0) then
  11923. Inc(FromIndex);
  11924. ToIndex := BinarySearch(ToKey);
  11925. if (FromIndex >= 0) and (FromIndex <= ToIndex) then
  11926. begin
  11927. NewMap.SetCapacity(ToIndex - FromIndex + 1);
  11928. NewMap.FSize := ToIndex - FromIndex + 1;
  11929. while ToIndex >= FromIndex do
  11930. begin
  11931. NewMap.FEntries[ToIndex - FromIndex] := FEntries[ToIndex];
  11932. Dec(ToIndex);
  11933. end;
  11934. end;
  11935. Result := NewMap;
  11936. {$IFDEF THREADSAFE}
  11937. finally
  11938. if FThreadSafe then
  11939. SyncReaderWriter.EndRead;
  11940. end;
  11941. {$ENDIF THREADSAFE}
  11942. end;
  11943. function TJclIntfDoubleSortedMap.TailMap(const FromKey: IInterface): IJclIntfDoubleSortedMap;
  11944. var
  11945. FromIndex, Index: Integer;
  11946. NewMap: TJclIntfDoubleSortedMap;
  11947. begin
  11948. {$IFDEF THREADSAFE}
  11949. if FThreadSafe then
  11950. SyncReaderWriter.BeginRead;
  11951. try
  11952. {$ENDIF THREADSAFE}
  11953. NewMap := CreateEmptyContainer as TJclIntfDoubleSortedMap;
  11954. FromIndex := BinarySearch(FromKey);
  11955. if (FromIndex = -1) or (KeysCompare(FEntries[FromIndex].Key, FromKey) < 0) then
  11956. Inc(FromIndex);
  11957. if (FromIndex >= 0) and (FromIndex < FSize) then
  11958. begin
  11959. NewMap.SetCapacity(FSize - FromIndex);
  11960. NewMap.FSize := FSize - FromIndex;
  11961. Index := FromIndex;
  11962. while Index < FSize do
  11963. begin
  11964. NewMap.FEntries[Index - FromIndex] := FEntries[Index];
  11965. Inc(Index);
  11966. end;
  11967. end;
  11968. Result := NewMap;
  11969. {$IFDEF THREADSAFE}
  11970. finally
  11971. if FThreadSafe then
  11972. SyncReaderWriter.EndRead;
  11973. end;
  11974. {$ENDIF THREADSAFE}
  11975. end;
  11976. function TJclIntfDoubleSortedMap.Values: IJclDoubleCollection;
  11977. var
  11978. Index: Integer;
  11979. begin
  11980. {$IFDEF THREADSAFE}
  11981. if FThreadSafe then
  11982. SyncReaderWriter.BeginRead;
  11983. try
  11984. {$ENDIF THREADSAFE}
  11985. Result := TJclDoubleArrayList.Create(FSize);
  11986. for Index := 0 to FSize - 1 do
  11987. Result.Add(FEntries[Index].Value);
  11988. {$IFDEF THREADSAFE}
  11989. finally
  11990. if FThreadSafe then
  11991. SyncReaderWriter.EndRead;
  11992. end;
  11993. {$ENDIF THREADSAFE}
  11994. end;
  11995. function TJclIntfDoubleSortedMap.CreateEmptyContainer: TJclAbstractContainerBase;
  11996. begin
  11997. Result := TJclIntfDoubleSortedMap.Create(FSize);
  11998. AssignPropertiesTo(Result);
  11999. end;
  12000. function TJclIntfDoubleSortedMap.FreeKey(var Key: IInterface): IInterface;
  12001. begin
  12002. Result := Key;
  12003. Key := nil;
  12004. end;
  12005. function TJclIntfDoubleSortedMap.FreeValue(var Value: Double): Double;
  12006. begin
  12007. Result := Value;
  12008. Value := 0.0;
  12009. end;
  12010. function TJclIntfDoubleSortedMap.KeysCompare(const A, B: IInterface): Integer;
  12011. begin
  12012. Result := IntfSimpleCompare(A, B);
  12013. end;
  12014. function TJclIntfDoubleSortedMap.ValuesCompare(const A, B: Double): Integer;
  12015. begin
  12016. Result := ItemsCompare(A, B);
  12017. end;
  12018. //=== { TJclDoubleDoubleSortedMap } ==============================================
  12019. constructor TJclDoubleDoubleSortedMap.Create(ACapacity: Integer);
  12020. begin
  12021. inherited Create();
  12022. SetCapacity(ACapacity);
  12023. end;
  12024. destructor TJclDoubleDoubleSortedMap.Destroy;
  12025. begin
  12026. FReadOnly := False;
  12027. Clear;
  12028. inherited Destroy;
  12029. end;
  12030. procedure TJclDoubleDoubleSortedMap.AssignDataTo(Dest: TJclAbstractContainerBase);
  12031. var
  12032. MyDest: TJclDoubleDoubleSortedMap;
  12033. begin
  12034. inherited AssignDataTo(Dest);
  12035. if Dest is TJclDoubleDoubleSortedMap then
  12036. begin
  12037. MyDest := TJclDoubleDoubleSortedMap(Dest);
  12038. MyDest.SetCapacity(FSize);
  12039. MyDest.FEntries := FEntries;
  12040. MyDest.FSize := FSize;
  12041. end;
  12042. end;
  12043. function TJclDoubleDoubleSortedMap.BinarySearch(const Key: Double): Integer;
  12044. var
  12045. HiPos, LoPos, CompPos: Integer;
  12046. Comp: Integer;
  12047. begin
  12048. {$IFDEF THREADSAFE}
  12049. if FThreadSafe then
  12050. SyncReaderWriter.BeginRead;
  12051. try
  12052. {$ENDIF THREADSAFE}
  12053. LoPos := 0;
  12054. HiPos := FSize - 1;
  12055. CompPos := (HiPos + LoPos) div 2;
  12056. while HiPos >= LoPos do
  12057. begin
  12058. Comp := KeysCompare(FEntries[CompPos].Key, Key);
  12059. if Comp < 0 then
  12060. LoPos := CompPos + 1
  12061. else
  12062. if Comp > 0 then
  12063. HiPos := CompPos - 1
  12064. else
  12065. begin
  12066. HiPos := CompPos;
  12067. LoPos := CompPos + 1;
  12068. end;
  12069. CompPos := (HiPos + LoPos) div 2;
  12070. end;
  12071. Result := HiPos;
  12072. {$IFDEF THREADSAFE}
  12073. finally
  12074. if FThreadSafe then
  12075. SyncReaderWriter.EndRead;
  12076. end;
  12077. {$ENDIF THREADSAFE}
  12078. end;
  12079. procedure TJclDoubleDoubleSortedMap.Clear;
  12080. var
  12081. Index: Integer;
  12082. begin
  12083. if ReadOnly then
  12084. raise EJclReadOnlyError.Create;
  12085. {$IFDEF THREADSAFE}
  12086. if FThreadSafe then
  12087. SyncReaderWriter.BeginWrite;
  12088. try
  12089. {$ENDIF THREADSAFE}
  12090. for Index := 0 to FSize - 1 do
  12091. begin
  12092. FreeKey(FEntries[Index].Key);
  12093. FreeValue(FEntries[Index].Value);
  12094. end;
  12095. FSize := 0;
  12096. AutoPack;
  12097. {$IFDEF THREADSAFE}
  12098. finally
  12099. if FThreadSafe then
  12100. SyncReaderWriter.EndWrite;
  12101. end;
  12102. {$ENDIF THREADSAFE}
  12103. end;
  12104. function TJclDoubleDoubleSortedMap.ContainsKey(const Key: Double): Boolean;
  12105. var
  12106. Index: Integer;
  12107. begin
  12108. {$IFDEF THREADSAFE}
  12109. if FThreadSafe then
  12110. SyncReaderWriter.BeginRead;
  12111. try
  12112. {$ENDIF THREADSAFE}
  12113. Index := BinarySearch(Key);
  12114. Result := (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0);
  12115. {$IFDEF THREADSAFE}
  12116. finally
  12117. if FThreadSafe then
  12118. SyncReaderWriter.EndRead;
  12119. end;
  12120. {$ENDIF THREADSAFE}
  12121. end;
  12122. function TJclDoubleDoubleSortedMap.ContainsValue(const Value: Double): Boolean;
  12123. var
  12124. Index: Integer;
  12125. begin
  12126. {$IFDEF THREADSAFE}
  12127. if FThreadSafe then
  12128. SyncReaderWriter.BeginRead;
  12129. try
  12130. {$ENDIF THREADSAFE}
  12131. Result := False;
  12132. for Index := 0 to FSize - 1 do
  12133. if ValuesCompare(FEntries[Index].Value, Value) = 0 then
  12134. begin
  12135. Result := True;
  12136. Break;
  12137. end;
  12138. {$IFDEF THREADSAFE}
  12139. finally
  12140. if FThreadSafe then
  12141. SyncReaderWriter.EndRead;
  12142. end;
  12143. {$ENDIF THREADSAFE}
  12144. end;
  12145. function TJclDoubleDoubleSortedMap.FirstKey: Double;
  12146. begin
  12147. {$IFDEF THREADSAFE}
  12148. if FThreadSafe then
  12149. SyncReaderWriter.BeginRead;
  12150. try
  12151. {$ENDIF THREADSAFE}
  12152. Result := 0.0;
  12153. if FSize > 0 then
  12154. Result := FEntries[0].Key
  12155. else
  12156. if not FReturnDefaultElements then
  12157. raise EJclNoSuchElementError.Create('');
  12158. {$IFDEF THREADSAFE}
  12159. finally
  12160. if FThreadSafe then
  12161. SyncReaderWriter.EndRead;
  12162. end;
  12163. {$ENDIF THREADSAFE}
  12164. end;
  12165. function TJclDoubleDoubleSortedMap.Extract(const Key: Double): Double;
  12166. var
  12167. Index: Integer;
  12168. begin
  12169. if ReadOnly then
  12170. raise EJclReadOnlyError.Create;
  12171. {$IFDEF THREADSAFE}
  12172. if FThreadSafe then
  12173. SyncReaderWriter.BeginWrite;
  12174. try
  12175. {$ENDIF THREADSAFE}
  12176. Index := BinarySearch(Key);
  12177. if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then
  12178. begin
  12179. Result := FEntries[Index].Value;
  12180. FEntries[Index].Value := 0.0;
  12181. FreeKey(FEntries[Index].Key);
  12182. if Index < (FSize - 1) then
  12183. MoveArray(FEntries, Index + 1, Index, FSize - Index - 1);
  12184. Dec(FSize);
  12185. AutoPack;
  12186. end
  12187. else
  12188. Result := 0.0;
  12189. {$IFDEF THREADSAFE}
  12190. finally
  12191. if FThreadSafe then
  12192. SyncReaderWriter.EndWrite;
  12193. end;
  12194. {$ENDIF THREADSAFE}
  12195. end;
  12196. function TJclDoubleDoubleSortedMap.GetValue(const Key: Double): Double;
  12197. var
  12198. Index: Integer;
  12199. begin
  12200. {$IFDEF THREADSAFE}
  12201. if FThreadSafe then
  12202. SyncReaderWriter.BeginRead;
  12203. try
  12204. {$ENDIF THREADSAFE}
  12205. Index := BinarySearch(Key);
  12206. Result := 0.0;
  12207. if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then
  12208. Result := FEntries[Index].Value
  12209. else if not FReturnDefaultElements then
  12210. raise EJclNoSuchElementError.Create('');
  12211. {$IFDEF THREADSAFE}
  12212. finally
  12213. if FThreadSafe then
  12214. SyncReaderWriter.EndRead;
  12215. end;
  12216. {$ENDIF THREADSAFE}
  12217. end;
  12218. function TJclDoubleDoubleSortedMap.HeadMap(const ToKey: Double): IJclDoubleDoubleSortedMap;
  12219. var
  12220. ToIndex: Integer;
  12221. NewMap: TJclDoubleDoubleSortedMap;
  12222. begin
  12223. {$IFDEF THREADSAFE}
  12224. if FThreadSafe then
  12225. SyncReaderWriter.BeginRead;
  12226. try
  12227. {$ENDIF THREADSAFE}
  12228. NewMap := CreateEmptyContainer as TJclDoubleDoubleSortedMap;
  12229. ToIndex := BinarySearch(ToKey);
  12230. if ToIndex >= 0 then
  12231. begin
  12232. NewMap.SetCapacity(ToIndex + 1);
  12233. NewMap.FSize := ToIndex + 1;
  12234. while ToIndex >= 0 do
  12235. begin
  12236. NewMap.FEntries[ToIndex] := FEntries[ToIndex];
  12237. Dec(ToIndex);
  12238. end;
  12239. end;
  12240. Result := NewMap;
  12241. {$IFDEF THREADSAFE}
  12242. finally
  12243. if FThreadSafe then
  12244. SyncReaderWriter.EndRead;
  12245. end;
  12246. {$ENDIF THREADSAFE}
  12247. end;
  12248. function TJclDoubleDoubleSortedMap.IsEmpty: Boolean;
  12249. begin
  12250. {$IFDEF THREADSAFE}
  12251. if FThreadSafe then
  12252. SyncReaderWriter.BeginRead;
  12253. try
  12254. {$ENDIF THREADSAFE}
  12255. Result := FSize = 0;
  12256. {$IFDEF THREADSAFE}
  12257. finally
  12258. if FThreadSafe then
  12259. SyncReaderWriter.EndRead;
  12260. end;
  12261. {$ENDIF THREADSAFE}
  12262. end;
  12263. function TJclDoubleDoubleSortedMap.KeyOfValue(const Value: Double): Double;
  12264. var
  12265. Index: Integer;
  12266. Found: Boolean;
  12267. begin
  12268. {$IFDEF THREADSAFE}
  12269. if FThreadSafe then
  12270. SyncReaderWriter.BeginRead;
  12271. try
  12272. {$ENDIF THREADSAFE}
  12273. Found := False;
  12274. Result := 0.0;
  12275. for Index := 0 to FSize - 1 do
  12276. if ValuesCompare(FEntries[Index].Value, Value) = 0 then
  12277. begin
  12278. Result := FEntries[Index].Key;
  12279. Found := True;
  12280. Break;
  12281. end;
  12282. if (not Found) and (not FReturnDefaultElements) then
  12283. raise EJclNoSuchElementError.Create('');
  12284. {$IFDEF THREADSAFE}
  12285. finally
  12286. if FThreadSafe then
  12287. SyncReaderWriter.EndRead;
  12288. end;
  12289. {$ENDIF THREADSAFE}
  12290. end;
  12291. function TJclDoubleDoubleSortedMap.KeySet: IJclDoubleSet;
  12292. var
  12293. Index: Integer;
  12294. begin
  12295. {$IFDEF THREADSAFE}
  12296. if FThreadSafe then
  12297. SyncReaderWriter.BeginRead;
  12298. try
  12299. {$ENDIF THREADSAFE}
  12300. Result := TJclDoubleArraySet.Create(FSize);
  12301. for Index := 0 to FSize - 1 do
  12302. Result.Add(FEntries[Index].Key);
  12303. {$IFDEF THREADSAFE}
  12304. finally
  12305. if FThreadSafe then
  12306. SyncReaderWriter.EndRead;
  12307. end;
  12308. {$ENDIF THREADSAFE}
  12309. end;
  12310. function TJclDoubleDoubleSortedMap.LastKey: Double;
  12311. begin
  12312. {$IFDEF THREADSAFE}
  12313. if FThreadSafe then
  12314. SyncReaderWriter.BeginRead;
  12315. try
  12316. {$ENDIF THREADSAFE}
  12317. Result := 0.0;
  12318. if FSize > 0 then
  12319. Result := FEntries[FSize - 1].Key
  12320. else
  12321. if not FReturnDefaultElements then
  12322. raise EJclNoSuchElementError.Create('');
  12323. {$IFDEF THREADSAFE}
  12324. finally
  12325. if FThreadSafe then
  12326. SyncReaderWriter.EndRead;
  12327. end;
  12328. {$ENDIF THREADSAFE}
  12329. end;
  12330. function TJclDoubleDoubleSortedMap.MapEquals(const AMap: IJclDoubleDoubleMap): Boolean;
  12331. var
  12332. It: IJclDoubleIterator;
  12333. Index: Integer;
  12334. AKey: Double;
  12335. begin
  12336. {$IFDEF THREADSAFE}
  12337. if FThreadSafe then
  12338. SyncReaderWriter.BeginRead;
  12339. try
  12340. {$ENDIF THREADSAFE}
  12341. Result := False;
  12342. if AMap = nil then
  12343. Exit;
  12344. if FSize <> AMap.Size then
  12345. Exit;
  12346. It := AMap.KeySet.First;
  12347. Index := 0;
  12348. while It.HasNext do
  12349. begin
  12350. if Index >= FSize then
  12351. Exit;
  12352. AKey := It.Next;
  12353. if ValuesCompare(AMap.GetValue(AKey), FEntries[Index].Value) <> 0 then
  12354. Exit;
  12355. Inc(Index);
  12356. end;
  12357. Result := True;
  12358. {$IFDEF THREADSAFE}
  12359. finally
  12360. if FThreadSafe then
  12361. SyncReaderWriter.EndRead;
  12362. end;
  12363. {$ENDIF THREADSAFE}
  12364. end;
  12365. procedure TJclDoubleDoubleSortedMap.InitializeArrayAfterMove(var List: TJclDoubleDoubleSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  12366. begin
  12367. { Clean array }
  12368. if FromIndex < ToIndex then
  12369. begin
  12370. if (ToIndex - FromIndex) < Count then
  12371. Count := ToIndex - FromIndex;
  12372. FillChar(List[FromIndex], Count * SizeOf(List[0]), 0);
  12373. end
  12374. else
  12375. if FromIndex > ToIndex then
  12376. begin
  12377. if (FromIndex - ToIndex) < Count then
  12378. FillChar(List[ToIndex + Count], (FromIndex - ToIndex) * SizeOf(List[0]), 0)
  12379. else
  12380. FillChar(List[FromIndex], Count * SizeOf(List[0]), 0);
  12381. end;
  12382. end;
  12383. procedure TJclDoubleDoubleSortedMap.MoveArray(var List: TJclDoubleDoubleSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  12384. begin
  12385. if Count > 0 then
  12386. begin
  12387. Move(List[FromIndex], List[ToIndex], Count * SizeOf(List[0]));
  12388. InitializeArrayAfterMove(List, FromIndex, ToIndex, Count);
  12389. end;
  12390. end;
  12391. procedure TJclDoubleDoubleSortedMap.PutAll(const AMap: IJclDoubleDoubleMap);
  12392. var
  12393. It: IJclDoubleIterator;
  12394. Key: Double;
  12395. begin
  12396. if ReadOnly then
  12397. raise EJclReadOnlyError.Create;
  12398. {$IFDEF THREADSAFE}
  12399. if FThreadSafe then
  12400. SyncReaderWriter.BeginWrite;
  12401. try
  12402. {$ENDIF THREADSAFE}
  12403. if AMap = nil then
  12404. Exit;
  12405. It := AMap.KeySet.First;
  12406. while It.HasNext do
  12407. begin
  12408. Key := It.Next;
  12409. PutValue(Key, AMap.GetValue(Key));
  12410. end;
  12411. {$IFDEF THREADSAFE}
  12412. finally
  12413. if FThreadSafe then
  12414. SyncReaderWriter.EndWrite;
  12415. end;
  12416. {$ENDIF THREADSAFE}
  12417. end;
  12418. procedure TJclDoubleDoubleSortedMap.PutValue(const Key: Double; const Value: Double);
  12419. var
  12420. Index: Integer;
  12421. begin
  12422. if ReadOnly then
  12423. raise EJclReadOnlyError.Create;
  12424. {$IFDEF THREADSAFE}
  12425. if FThreadSafe then
  12426. SyncReaderWriter.BeginWrite;
  12427. try
  12428. {$ENDIF THREADSAFE}
  12429. if FAllowDefaultElements or ((KeysCompare(Key, 0.0) <> 0) and (ValuesCompare(Value, 0.0) <> 0)) then
  12430. begin
  12431. Index := BinarySearch(Key);
  12432. if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then
  12433. begin
  12434. FreeValue(FEntries[Index].Value);
  12435. FEntries[Index].Value := Value;
  12436. end
  12437. else
  12438. begin
  12439. if FSize = FCapacity then
  12440. AutoGrow;
  12441. if FSize < FCapacity then
  12442. begin
  12443. Inc(Index);
  12444. if (Index < FSize) and (KeysCompare(FEntries[Index].Key, Key) <> 0) then
  12445. MoveArray(FEntries, Index, Index + 1, FSize - Index);
  12446. FEntries[Index].Key := Key;
  12447. FEntries[Index].Value := Value;
  12448. Inc(FSize);
  12449. end;
  12450. end;
  12451. end;
  12452. {$IFDEF THREADSAFE}
  12453. finally
  12454. if FThreadSafe then
  12455. SyncReaderWriter.EndWrite;
  12456. end;
  12457. {$ENDIF THREADSAFE}
  12458. end;
  12459. function TJclDoubleDoubleSortedMap.Remove(const Key: Double): Double;
  12460. begin
  12461. if ReadOnly then
  12462. raise EJclReadOnlyError.Create;
  12463. {$IFDEF THREADSAFE}
  12464. if FThreadSafe then
  12465. SyncReaderWriter.BeginWrite;
  12466. try
  12467. {$ENDIF THREADSAFE}
  12468. Result := Extract(Key);
  12469. Result := FreeValue(Result);
  12470. {$IFDEF THREADSAFE}
  12471. finally
  12472. if FThreadSafe then
  12473. SyncReaderWriter.EndWrite;
  12474. end;
  12475. {$ENDIF THREADSAFE}
  12476. end;
  12477. procedure TJclDoubleDoubleSortedMap.SetCapacity(Value: Integer);
  12478. begin
  12479. if ReadOnly then
  12480. raise EJclReadOnlyError.Create;
  12481. {$IFDEF THREADSAFE}
  12482. if FThreadSafe then
  12483. SyncReaderWriter.BeginWrite;
  12484. try
  12485. {$ENDIF THREADSAFE}
  12486. if FSize <= Value then
  12487. begin
  12488. SetLength(FEntries, Value);
  12489. inherited SetCapacity(Value);
  12490. end
  12491. else
  12492. raise EJclOperationNotSupportedError.Create;
  12493. {$IFDEF THREADSAFE}
  12494. finally
  12495. if FThreadSafe then
  12496. SyncReaderWriter.EndWrite;
  12497. end;
  12498. {$ENDIF THREADSAFE}
  12499. end;
  12500. function TJclDoubleDoubleSortedMap.Size: Integer;
  12501. begin
  12502. Result := FSize;
  12503. end;
  12504. function TJclDoubleDoubleSortedMap.SubMap(const FromKey, ToKey: Double): IJclDoubleDoubleSortedMap;
  12505. var
  12506. FromIndex, ToIndex: Integer;
  12507. NewMap: TJclDoubleDoubleSortedMap;
  12508. begin
  12509. {$IFDEF THREADSAFE}
  12510. if FThreadSafe then
  12511. SyncReaderWriter.BeginRead;
  12512. try
  12513. {$ENDIF THREADSAFE}
  12514. NewMap := CreateEmptyContainer as TJclDoubleDoubleSortedMap;
  12515. FromIndex := BinarySearch(FromKey);
  12516. if (FromIndex = -1) or (KeysCompare(FEntries[FromIndex].Key, FromKey) < 0) then
  12517. Inc(FromIndex);
  12518. ToIndex := BinarySearch(ToKey);
  12519. if (FromIndex >= 0) and (FromIndex <= ToIndex) then
  12520. begin
  12521. NewMap.SetCapacity(ToIndex - FromIndex + 1);
  12522. NewMap.FSize := ToIndex - FromIndex + 1;
  12523. while ToIndex >= FromIndex do
  12524. begin
  12525. NewMap.FEntries[ToIndex - FromIndex] := FEntries[ToIndex];
  12526. Dec(ToIndex);
  12527. end;
  12528. end;
  12529. Result := NewMap;
  12530. {$IFDEF THREADSAFE}
  12531. finally
  12532. if FThreadSafe then
  12533. SyncReaderWriter.EndRead;
  12534. end;
  12535. {$ENDIF THREADSAFE}
  12536. end;
  12537. function TJclDoubleDoubleSortedMap.TailMap(const FromKey: Double): IJclDoubleDoubleSortedMap;
  12538. var
  12539. FromIndex, Index: Integer;
  12540. NewMap: TJclDoubleDoubleSortedMap;
  12541. begin
  12542. {$IFDEF THREADSAFE}
  12543. if FThreadSafe then
  12544. SyncReaderWriter.BeginRead;
  12545. try
  12546. {$ENDIF THREADSAFE}
  12547. NewMap := CreateEmptyContainer as TJclDoubleDoubleSortedMap;
  12548. FromIndex := BinarySearch(FromKey);
  12549. if (FromIndex = -1) or (KeysCompare(FEntries[FromIndex].Key, FromKey) < 0) then
  12550. Inc(FromIndex);
  12551. if (FromIndex >= 0) and (FromIndex < FSize) then
  12552. begin
  12553. NewMap.SetCapacity(FSize - FromIndex);
  12554. NewMap.FSize := FSize - FromIndex;
  12555. Index := FromIndex;
  12556. while Index < FSize do
  12557. begin
  12558. NewMap.FEntries[Index - FromIndex] := FEntries[Index];
  12559. Inc(Index);
  12560. end;
  12561. end;
  12562. Result := NewMap;
  12563. {$IFDEF THREADSAFE}
  12564. finally
  12565. if FThreadSafe then
  12566. SyncReaderWriter.EndRead;
  12567. end;
  12568. {$ENDIF THREADSAFE}
  12569. end;
  12570. function TJclDoubleDoubleSortedMap.Values: IJclDoubleCollection;
  12571. var
  12572. Index: Integer;
  12573. begin
  12574. {$IFDEF THREADSAFE}
  12575. if FThreadSafe then
  12576. SyncReaderWriter.BeginRead;
  12577. try
  12578. {$ENDIF THREADSAFE}
  12579. Result := TJclDoubleArrayList.Create(FSize);
  12580. for Index := 0 to FSize - 1 do
  12581. Result.Add(FEntries[Index].Value);
  12582. {$IFDEF THREADSAFE}
  12583. finally
  12584. if FThreadSafe then
  12585. SyncReaderWriter.EndRead;
  12586. end;
  12587. {$ENDIF THREADSAFE}
  12588. end;
  12589. function TJclDoubleDoubleSortedMap.CreateEmptyContainer: TJclAbstractContainerBase;
  12590. begin
  12591. Result := TJclDoubleDoubleSortedMap.Create(FSize);
  12592. AssignPropertiesTo(Result);
  12593. end;
  12594. function TJclDoubleDoubleSortedMap.FreeKey(var Key: Double): Double;
  12595. begin
  12596. Result := Key;
  12597. Key := 0.0;
  12598. end;
  12599. function TJclDoubleDoubleSortedMap.FreeValue(var Value: Double): Double;
  12600. begin
  12601. Result := Value;
  12602. Value := 0.0;
  12603. end;
  12604. function TJclDoubleDoubleSortedMap.KeysCompare(const A, B: Double): Integer;
  12605. begin
  12606. Result := ItemsCompare(A, B);
  12607. end;
  12608. function TJclDoubleDoubleSortedMap.ValuesCompare(const A, B: Double): Integer;
  12609. begin
  12610. Result := ItemsCompare(A, B);
  12611. end;
  12612. //=== { TJclExtendedIntfSortedMap } ==============================================
  12613. constructor TJclExtendedIntfSortedMap.Create(ACapacity: Integer);
  12614. begin
  12615. inherited Create();
  12616. SetCapacity(ACapacity);
  12617. end;
  12618. destructor TJclExtendedIntfSortedMap.Destroy;
  12619. begin
  12620. FReadOnly := False;
  12621. Clear;
  12622. inherited Destroy;
  12623. end;
  12624. procedure TJclExtendedIntfSortedMap.AssignDataTo(Dest: TJclAbstractContainerBase);
  12625. var
  12626. MyDest: TJclExtendedIntfSortedMap;
  12627. begin
  12628. inherited AssignDataTo(Dest);
  12629. if Dest is TJclExtendedIntfSortedMap then
  12630. begin
  12631. MyDest := TJclExtendedIntfSortedMap(Dest);
  12632. MyDest.SetCapacity(FSize);
  12633. MyDest.FEntries := FEntries;
  12634. MyDest.FSize := FSize;
  12635. end;
  12636. end;
  12637. function TJclExtendedIntfSortedMap.BinarySearch(const Key: Extended): Integer;
  12638. var
  12639. HiPos, LoPos, CompPos: Integer;
  12640. Comp: Integer;
  12641. begin
  12642. {$IFDEF THREADSAFE}
  12643. if FThreadSafe then
  12644. SyncReaderWriter.BeginRead;
  12645. try
  12646. {$ENDIF THREADSAFE}
  12647. LoPos := 0;
  12648. HiPos := FSize - 1;
  12649. CompPos := (HiPos + LoPos) div 2;
  12650. while HiPos >= LoPos do
  12651. begin
  12652. Comp := KeysCompare(FEntries[CompPos].Key, Key);
  12653. if Comp < 0 then
  12654. LoPos := CompPos + 1
  12655. else
  12656. if Comp > 0 then
  12657. HiPos := CompPos - 1
  12658. else
  12659. begin
  12660. HiPos := CompPos;
  12661. LoPos := CompPos + 1;
  12662. end;
  12663. CompPos := (HiPos + LoPos) div 2;
  12664. end;
  12665. Result := HiPos;
  12666. {$IFDEF THREADSAFE}
  12667. finally
  12668. if FThreadSafe then
  12669. SyncReaderWriter.EndRead;
  12670. end;
  12671. {$ENDIF THREADSAFE}
  12672. end;
  12673. procedure TJclExtendedIntfSortedMap.Clear;
  12674. var
  12675. Index: Integer;
  12676. begin
  12677. if ReadOnly then
  12678. raise EJclReadOnlyError.Create;
  12679. {$IFDEF THREADSAFE}
  12680. if FThreadSafe then
  12681. SyncReaderWriter.BeginWrite;
  12682. try
  12683. {$ENDIF THREADSAFE}
  12684. for Index := 0 to FSize - 1 do
  12685. begin
  12686. FreeKey(FEntries[Index].Key);
  12687. FreeValue(FEntries[Index].Value);
  12688. end;
  12689. FSize := 0;
  12690. AutoPack;
  12691. {$IFDEF THREADSAFE}
  12692. finally
  12693. if FThreadSafe then
  12694. SyncReaderWriter.EndWrite;
  12695. end;
  12696. {$ENDIF THREADSAFE}
  12697. end;
  12698. function TJclExtendedIntfSortedMap.ContainsKey(const Key: Extended): Boolean;
  12699. var
  12700. Index: Integer;
  12701. begin
  12702. {$IFDEF THREADSAFE}
  12703. if FThreadSafe then
  12704. SyncReaderWriter.BeginRead;
  12705. try
  12706. {$ENDIF THREADSAFE}
  12707. Index := BinarySearch(Key);
  12708. Result := (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0);
  12709. {$IFDEF THREADSAFE}
  12710. finally
  12711. if FThreadSafe then
  12712. SyncReaderWriter.EndRead;
  12713. end;
  12714. {$ENDIF THREADSAFE}
  12715. end;
  12716. function TJclExtendedIntfSortedMap.ContainsValue(const Value: IInterface): Boolean;
  12717. var
  12718. Index: Integer;
  12719. begin
  12720. {$IFDEF THREADSAFE}
  12721. if FThreadSafe then
  12722. SyncReaderWriter.BeginRead;
  12723. try
  12724. {$ENDIF THREADSAFE}
  12725. Result := False;
  12726. for Index := 0 to FSize - 1 do
  12727. if ValuesCompare(FEntries[Index].Value, Value) = 0 then
  12728. begin
  12729. Result := True;
  12730. Break;
  12731. end;
  12732. {$IFDEF THREADSAFE}
  12733. finally
  12734. if FThreadSafe then
  12735. SyncReaderWriter.EndRead;
  12736. end;
  12737. {$ENDIF THREADSAFE}
  12738. end;
  12739. function TJclExtendedIntfSortedMap.FirstKey: Extended;
  12740. begin
  12741. {$IFDEF THREADSAFE}
  12742. if FThreadSafe then
  12743. SyncReaderWriter.BeginRead;
  12744. try
  12745. {$ENDIF THREADSAFE}
  12746. Result := 0.0;
  12747. if FSize > 0 then
  12748. Result := FEntries[0].Key
  12749. else
  12750. if not FReturnDefaultElements then
  12751. raise EJclNoSuchElementError.Create('');
  12752. {$IFDEF THREADSAFE}
  12753. finally
  12754. if FThreadSafe then
  12755. SyncReaderWriter.EndRead;
  12756. end;
  12757. {$ENDIF THREADSAFE}
  12758. end;
  12759. function TJclExtendedIntfSortedMap.Extract(const Key: Extended): IInterface;
  12760. var
  12761. Index: Integer;
  12762. begin
  12763. if ReadOnly then
  12764. raise EJclReadOnlyError.Create;
  12765. {$IFDEF THREADSAFE}
  12766. if FThreadSafe then
  12767. SyncReaderWriter.BeginWrite;
  12768. try
  12769. {$ENDIF THREADSAFE}
  12770. Index := BinarySearch(Key);
  12771. if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then
  12772. begin
  12773. Result := FEntries[Index].Value;
  12774. FEntries[Index].Value := nil;
  12775. FreeKey(FEntries[Index].Key);
  12776. if Index < (FSize - 1) then
  12777. MoveArray(FEntries, Index + 1, Index, FSize - Index - 1);
  12778. Dec(FSize);
  12779. AutoPack;
  12780. end
  12781. else
  12782. Result := nil;
  12783. {$IFDEF THREADSAFE}
  12784. finally
  12785. if FThreadSafe then
  12786. SyncReaderWriter.EndWrite;
  12787. end;
  12788. {$ENDIF THREADSAFE}
  12789. end;
  12790. function TJclExtendedIntfSortedMap.GetValue(const Key: Extended): IInterface;
  12791. var
  12792. Index: Integer;
  12793. begin
  12794. {$IFDEF THREADSAFE}
  12795. if FThreadSafe then
  12796. SyncReaderWriter.BeginRead;
  12797. try
  12798. {$ENDIF THREADSAFE}
  12799. Index := BinarySearch(Key);
  12800. Result := nil;
  12801. if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then
  12802. Result := FEntries[Index].Value
  12803. else if not FReturnDefaultElements then
  12804. raise EJclNoSuchElementError.Create('');
  12805. {$IFDEF THREADSAFE}
  12806. finally
  12807. if FThreadSafe then
  12808. SyncReaderWriter.EndRead;
  12809. end;
  12810. {$ENDIF THREADSAFE}
  12811. end;
  12812. function TJclExtendedIntfSortedMap.HeadMap(const ToKey: Extended): IJclExtendedIntfSortedMap;
  12813. var
  12814. ToIndex: Integer;
  12815. NewMap: TJclExtendedIntfSortedMap;
  12816. begin
  12817. {$IFDEF THREADSAFE}
  12818. if FThreadSafe then
  12819. SyncReaderWriter.BeginRead;
  12820. try
  12821. {$ENDIF THREADSAFE}
  12822. NewMap := CreateEmptyContainer as TJclExtendedIntfSortedMap;
  12823. ToIndex := BinarySearch(ToKey);
  12824. if ToIndex >= 0 then
  12825. begin
  12826. NewMap.SetCapacity(ToIndex + 1);
  12827. NewMap.FSize := ToIndex + 1;
  12828. while ToIndex >= 0 do
  12829. begin
  12830. NewMap.FEntries[ToIndex] := FEntries[ToIndex];
  12831. Dec(ToIndex);
  12832. end;
  12833. end;
  12834. Result := NewMap;
  12835. {$IFDEF THREADSAFE}
  12836. finally
  12837. if FThreadSafe then
  12838. SyncReaderWriter.EndRead;
  12839. end;
  12840. {$ENDIF THREADSAFE}
  12841. end;
  12842. function TJclExtendedIntfSortedMap.IsEmpty: Boolean;
  12843. begin
  12844. {$IFDEF THREADSAFE}
  12845. if FThreadSafe then
  12846. SyncReaderWriter.BeginRead;
  12847. try
  12848. {$ENDIF THREADSAFE}
  12849. Result := FSize = 0;
  12850. {$IFDEF THREADSAFE}
  12851. finally
  12852. if FThreadSafe then
  12853. SyncReaderWriter.EndRead;
  12854. end;
  12855. {$ENDIF THREADSAFE}
  12856. end;
  12857. function TJclExtendedIntfSortedMap.KeyOfValue(const Value: IInterface): Extended;
  12858. var
  12859. Index: Integer;
  12860. Found: Boolean;
  12861. begin
  12862. {$IFDEF THREADSAFE}
  12863. if FThreadSafe then
  12864. SyncReaderWriter.BeginRead;
  12865. try
  12866. {$ENDIF THREADSAFE}
  12867. Found := False;
  12868. Result := 0.0;
  12869. for Index := 0 to FSize - 1 do
  12870. if ValuesCompare(FEntries[Index].Value, Value) = 0 then
  12871. begin
  12872. Result := FEntries[Index].Key;
  12873. Found := True;
  12874. Break;
  12875. end;
  12876. if (not Found) and (not FReturnDefaultElements) then
  12877. raise EJclNoSuchElementError.Create('');
  12878. {$IFDEF THREADSAFE}
  12879. finally
  12880. if FThreadSafe then
  12881. SyncReaderWriter.EndRead;
  12882. end;
  12883. {$ENDIF THREADSAFE}
  12884. end;
  12885. function TJclExtendedIntfSortedMap.KeySet: IJclExtendedSet;
  12886. var
  12887. Index: Integer;
  12888. begin
  12889. {$IFDEF THREADSAFE}
  12890. if FThreadSafe then
  12891. SyncReaderWriter.BeginRead;
  12892. try
  12893. {$ENDIF THREADSAFE}
  12894. Result := TJclExtendedArraySet.Create(FSize);
  12895. for Index := 0 to FSize - 1 do
  12896. Result.Add(FEntries[Index].Key);
  12897. {$IFDEF THREADSAFE}
  12898. finally
  12899. if FThreadSafe then
  12900. SyncReaderWriter.EndRead;
  12901. end;
  12902. {$ENDIF THREADSAFE}
  12903. end;
  12904. function TJclExtendedIntfSortedMap.LastKey: Extended;
  12905. begin
  12906. {$IFDEF THREADSAFE}
  12907. if FThreadSafe then
  12908. SyncReaderWriter.BeginRead;
  12909. try
  12910. {$ENDIF THREADSAFE}
  12911. Result := 0.0;
  12912. if FSize > 0 then
  12913. Result := FEntries[FSize - 1].Key
  12914. else
  12915. if not FReturnDefaultElements then
  12916. raise EJclNoSuchElementError.Create('');
  12917. {$IFDEF THREADSAFE}
  12918. finally
  12919. if FThreadSafe then
  12920. SyncReaderWriter.EndRead;
  12921. end;
  12922. {$ENDIF THREADSAFE}
  12923. end;
  12924. function TJclExtendedIntfSortedMap.MapEquals(const AMap: IJclExtendedIntfMap): Boolean;
  12925. var
  12926. It: IJclExtendedIterator;
  12927. Index: Integer;
  12928. AKey: Extended;
  12929. begin
  12930. {$IFDEF THREADSAFE}
  12931. if FThreadSafe then
  12932. SyncReaderWriter.BeginRead;
  12933. try
  12934. {$ENDIF THREADSAFE}
  12935. Result := False;
  12936. if AMap = nil then
  12937. Exit;
  12938. if FSize <> AMap.Size then
  12939. Exit;
  12940. It := AMap.KeySet.First;
  12941. Index := 0;
  12942. while It.HasNext do
  12943. begin
  12944. if Index >= FSize then
  12945. Exit;
  12946. AKey := It.Next;
  12947. if ValuesCompare(AMap.GetValue(AKey), FEntries[Index].Value) <> 0 then
  12948. Exit;
  12949. Inc(Index);
  12950. end;
  12951. Result := True;
  12952. {$IFDEF THREADSAFE}
  12953. finally
  12954. if FThreadSafe then
  12955. SyncReaderWriter.EndRead;
  12956. end;
  12957. {$ENDIF THREADSAFE}
  12958. end;
  12959. procedure TJclExtendedIntfSortedMap.FinalizeArrayBeforeMove(var List: TJclExtendedIntfSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  12960. begin
  12961. Assert(Count > 0);
  12962. if FromIndex < ToIndex then
  12963. begin
  12964. if Count > (ToIndex - FromIndex) then
  12965. Finalize(List[FromIndex + Count], ToIndex - FromIndex)
  12966. else
  12967. Finalize(List[ToIndex], Count);
  12968. end
  12969. else
  12970. if FromIndex > ToIndex then
  12971. begin
  12972. if Count > (FromIndex - ToIndex) then
  12973. Count := FromIndex - ToIndex;
  12974. Finalize(List[ToIndex], Count)
  12975. end;
  12976. end;
  12977. procedure TJclExtendedIntfSortedMap.InitializeArray(var List: TJclExtendedIntfSortedMapEntryArray; FromIndex, Count: SizeInt);
  12978. begin
  12979. {$IFDEF FPC}
  12980. while Count > 0 do
  12981. begin
  12982. Initialize(List[FromIndex]);
  12983. Inc(FromIndex);
  12984. Dec(Count);
  12985. end;
  12986. {$ELSE ~FPC}
  12987. Initialize(List[FromIndex], Count);
  12988. {$ENDIF ~FPC}
  12989. end;
  12990. procedure TJclExtendedIntfSortedMap.InitializeArrayAfterMove(var List: TJclExtendedIntfSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  12991. begin
  12992. { Keep reference counting working }
  12993. if FromIndex < ToIndex then
  12994. begin
  12995. if (ToIndex - FromIndex) < Count then
  12996. Count := ToIndex - FromIndex;
  12997. InitializeArray(List, FromIndex, Count);
  12998. end
  12999. else
  13000. if FromIndex > ToIndex then
  13001. begin
  13002. if (FromIndex - ToIndex) < Count then
  13003. InitializeArray(List, ToIndex + Count, FromIndex - ToIndex)
  13004. else
  13005. InitializeArray(List, FromIndex, Count);
  13006. end;
  13007. end;
  13008. procedure TJclExtendedIntfSortedMap.MoveArray(var List: TJclExtendedIntfSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  13009. begin
  13010. if Count > 0 then
  13011. begin
  13012. FinalizeArrayBeforeMove(List, FromIndex, ToIndex, Count);
  13013. Move(List[FromIndex], List[ToIndex], Count * SizeOf(List[0]));
  13014. InitializeArrayAfterMove(List, FromIndex, ToIndex, Count);
  13015. end;
  13016. end;
  13017. procedure TJclExtendedIntfSortedMap.PutAll(const AMap: IJclExtendedIntfMap);
  13018. var
  13019. It: IJclExtendedIterator;
  13020. Key: Extended;
  13021. begin
  13022. if ReadOnly then
  13023. raise EJclReadOnlyError.Create;
  13024. {$IFDEF THREADSAFE}
  13025. if FThreadSafe then
  13026. SyncReaderWriter.BeginWrite;
  13027. try
  13028. {$ENDIF THREADSAFE}
  13029. if AMap = nil then
  13030. Exit;
  13031. It := AMap.KeySet.First;
  13032. while It.HasNext do
  13033. begin
  13034. Key := It.Next;
  13035. PutValue(Key, AMap.GetValue(Key));
  13036. end;
  13037. {$IFDEF THREADSAFE}
  13038. finally
  13039. if FThreadSafe then
  13040. SyncReaderWriter.EndWrite;
  13041. end;
  13042. {$ENDIF THREADSAFE}
  13043. end;
  13044. procedure TJclExtendedIntfSortedMap.PutValue(const Key: Extended; const Value: IInterface);
  13045. var
  13046. Index: Integer;
  13047. begin
  13048. if ReadOnly then
  13049. raise EJclReadOnlyError.Create;
  13050. {$IFDEF THREADSAFE}
  13051. if FThreadSafe then
  13052. SyncReaderWriter.BeginWrite;
  13053. try
  13054. {$ENDIF THREADSAFE}
  13055. if FAllowDefaultElements or ((KeysCompare(Key, 0.0) <> 0) and (ValuesCompare(Value, nil) <> 0)) then
  13056. begin
  13057. Index := BinarySearch(Key);
  13058. if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then
  13059. begin
  13060. FreeValue(FEntries[Index].Value);
  13061. FEntries[Index].Value := Value;
  13062. end
  13063. else
  13064. begin
  13065. if FSize = FCapacity then
  13066. AutoGrow;
  13067. if FSize < FCapacity then
  13068. begin
  13069. Inc(Index);
  13070. if (Index < FSize) and (KeysCompare(FEntries[Index].Key, Key) <> 0) then
  13071. MoveArray(FEntries, Index, Index + 1, FSize - Index);
  13072. FEntries[Index].Key := Key;
  13073. FEntries[Index].Value := Value;
  13074. Inc(FSize);
  13075. end;
  13076. end;
  13077. end;
  13078. {$IFDEF THREADSAFE}
  13079. finally
  13080. if FThreadSafe then
  13081. SyncReaderWriter.EndWrite;
  13082. end;
  13083. {$ENDIF THREADSAFE}
  13084. end;
  13085. function TJclExtendedIntfSortedMap.Remove(const Key: Extended): IInterface;
  13086. begin
  13087. if ReadOnly then
  13088. raise EJclReadOnlyError.Create;
  13089. {$IFDEF THREADSAFE}
  13090. if FThreadSafe then
  13091. SyncReaderWriter.BeginWrite;
  13092. try
  13093. {$ENDIF THREADSAFE}
  13094. Result := Extract(Key);
  13095. Result := FreeValue(Result);
  13096. {$IFDEF THREADSAFE}
  13097. finally
  13098. if FThreadSafe then
  13099. SyncReaderWriter.EndWrite;
  13100. end;
  13101. {$ENDIF THREADSAFE}
  13102. end;
  13103. procedure TJclExtendedIntfSortedMap.SetCapacity(Value: Integer);
  13104. begin
  13105. if ReadOnly then
  13106. raise EJclReadOnlyError.Create;
  13107. {$IFDEF THREADSAFE}
  13108. if FThreadSafe then
  13109. SyncReaderWriter.BeginWrite;
  13110. try
  13111. {$ENDIF THREADSAFE}
  13112. if FSize <= Value then
  13113. begin
  13114. SetLength(FEntries, Value);
  13115. inherited SetCapacity(Value);
  13116. end
  13117. else
  13118. raise EJclOperationNotSupportedError.Create;
  13119. {$IFDEF THREADSAFE}
  13120. finally
  13121. if FThreadSafe then
  13122. SyncReaderWriter.EndWrite;
  13123. end;
  13124. {$ENDIF THREADSAFE}
  13125. end;
  13126. function TJclExtendedIntfSortedMap.Size: Integer;
  13127. begin
  13128. Result := FSize;
  13129. end;
  13130. function TJclExtendedIntfSortedMap.SubMap(const FromKey, ToKey: Extended): IJclExtendedIntfSortedMap;
  13131. var
  13132. FromIndex, ToIndex: Integer;
  13133. NewMap: TJclExtendedIntfSortedMap;
  13134. begin
  13135. {$IFDEF THREADSAFE}
  13136. if FThreadSafe then
  13137. SyncReaderWriter.BeginRead;
  13138. try
  13139. {$ENDIF THREADSAFE}
  13140. NewMap := CreateEmptyContainer as TJclExtendedIntfSortedMap;
  13141. FromIndex := BinarySearch(FromKey);
  13142. if (FromIndex = -1) or (KeysCompare(FEntries[FromIndex].Key, FromKey) < 0) then
  13143. Inc(FromIndex);
  13144. ToIndex := BinarySearch(ToKey);
  13145. if (FromIndex >= 0) and (FromIndex <= ToIndex) then
  13146. begin
  13147. NewMap.SetCapacity(ToIndex - FromIndex + 1);
  13148. NewMap.FSize := ToIndex - FromIndex + 1;
  13149. while ToIndex >= FromIndex do
  13150. begin
  13151. NewMap.FEntries[ToIndex - FromIndex] := FEntries[ToIndex];
  13152. Dec(ToIndex);
  13153. end;
  13154. end;
  13155. Result := NewMap;
  13156. {$IFDEF THREADSAFE}
  13157. finally
  13158. if FThreadSafe then
  13159. SyncReaderWriter.EndRead;
  13160. end;
  13161. {$ENDIF THREADSAFE}
  13162. end;
  13163. function TJclExtendedIntfSortedMap.TailMap(const FromKey: Extended): IJclExtendedIntfSortedMap;
  13164. var
  13165. FromIndex, Index: Integer;
  13166. NewMap: TJclExtendedIntfSortedMap;
  13167. begin
  13168. {$IFDEF THREADSAFE}
  13169. if FThreadSafe then
  13170. SyncReaderWriter.BeginRead;
  13171. try
  13172. {$ENDIF THREADSAFE}
  13173. NewMap := CreateEmptyContainer as TJclExtendedIntfSortedMap;
  13174. FromIndex := BinarySearch(FromKey);
  13175. if (FromIndex = -1) or (KeysCompare(FEntries[FromIndex].Key, FromKey) < 0) then
  13176. Inc(FromIndex);
  13177. if (FromIndex >= 0) and (FromIndex < FSize) then
  13178. begin
  13179. NewMap.SetCapacity(FSize - FromIndex);
  13180. NewMap.FSize := FSize - FromIndex;
  13181. Index := FromIndex;
  13182. while Index < FSize do
  13183. begin
  13184. NewMap.FEntries[Index - FromIndex] := FEntries[Index];
  13185. Inc(Index);
  13186. end;
  13187. end;
  13188. Result := NewMap;
  13189. {$IFDEF THREADSAFE}
  13190. finally
  13191. if FThreadSafe then
  13192. SyncReaderWriter.EndRead;
  13193. end;
  13194. {$ENDIF THREADSAFE}
  13195. end;
  13196. function TJclExtendedIntfSortedMap.Values: IJclIntfCollection;
  13197. var
  13198. Index: Integer;
  13199. begin
  13200. {$IFDEF THREADSAFE}
  13201. if FThreadSafe then
  13202. SyncReaderWriter.BeginRead;
  13203. try
  13204. {$ENDIF THREADSAFE}
  13205. Result := TJclIntfArrayList.Create(FSize);
  13206. for Index := 0 to FSize - 1 do
  13207. Result.Add(FEntries[Index].Value);
  13208. {$IFDEF THREADSAFE}
  13209. finally
  13210. if FThreadSafe then
  13211. SyncReaderWriter.EndRead;
  13212. end;
  13213. {$ENDIF THREADSAFE}
  13214. end;
  13215. function TJclExtendedIntfSortedMap.CreateEmptyContainer: TJclAbstractContainerBase;
  13216. begin
  13217. Result := TJclExtendedIntfSortedMap.Create(FSize);
  13218. AssignPropertiesTo(Result);
  13219. end;
  13220. function TJclExtendedIntfSortedMap.FreeKey(var Key: Extended): Extended;
  13221. begin
  13222. Result := Key;
  13223. Key := 0.0;
  13224. end;
  13225. function TJclExtendedIntfSortedMap.FreeValue(var Value: IInterface): IInterface;
  13226. begin
  13227. Result := Value;
  13228. Value := nil;
  13229. end;
  13230. function TJclExtendedIntfSortedMap.KeysCompare(const A, B: Extended): Integer;
  13231. begin
  13232. Result := ItemsCompare(A, B);
  13233. end;
  13234. function TJclExtendedIntfSortedMap.ValuesCompare(const A, B: IInterface): Integer;
  13235. begin
  13236. Result := IntfSimpleCompare(A, B);
  13237. end;
  13238. //=== { TJclIntfExtendedSortedMap } ==============================================
  13239. constructor TJclIntfExtendedSortedMap.Create(ACapacity: Integer);
  13240. begin
  13241. inherited Create();
  13242. SetCapacity(ACapacity);
  13243. end;
  13244. destructor TJclIntfExtendedSortedMap.Destroy;
  13245. begin
  13246. FReadOnly := False;
  13247. Clear;
  13248. inherited Destroy;
  13249. end;
  13250. procedure TJclIntfExtendedSortedMap.AssignDataTo(Dest: TJclAbstractContainerBase);
  13251. var
  13252. MyDest: TJclIntfExtendedSortedMap;
  13253. begin
  13254. inherited AssignDataTo(Dest);
  13255. if Dest is TJclIntfExtendedSortedMap then
  13256. begin
  13257. MyDest := TJclIntfExtendedSortedMap(Dest);
  13258. MyDest.SetCapacity(FSize);
  13259. MyDest.FEntries := FEntries;
  13260. MyDest.FSize := FSize;
  13261. end;
  13262. end;
  13263. function TJclIntfExtendedSortedMap.BinarySearch(const Key: IInterface): Integer;
  13264. var
  13265. HiPos, LoPos, CompPos: Integer;
  13266. Comp: Integer;
  13267. begin
  13268. {$IFDEF THREADSAFE}
  13269. if FThreadSafe then
  13270. SyncReaderWriter.BeginRead;
  13271. try
  13272. {$ENDIF THREADSAFE}
  13273. LoPos := 0;
  13274. HiPos := FSize - 1;
  13275. CompPos := (HiPos + LoPos) div 2;
  13276. while HiPos >= LoPos do
  13277. begin
  13278. Comp := KeysCompare(FEntries[CompPos].Key, Key);
  13279. if Comp < 0 then
  13280. LoPos := CompPos + 1
  13281. else
  13282. if Comp > 0 then
  13283. HiPos := CompPos - 1
  13284. else
  13285. begin
  13286. HiPos := CompPos;
  13287. LoPos := CompPos + 1;
  13288. end;
  13289. CompPos := (HiPos + LoPos) div 2;
  13290. end;
  13291. Result := HiPos;
  13292. {$IFDEF THREADSAFE}
  13293. finally
  13294. if FThreadSafe then
  13295. SyncReaderWriter.EndRead;
  13296. end;
  13297. {$ENDIF THREADSAFE}
  13298. end;
  13299. procedure TJclIntfExtendedSortedMap.Clear;
  13300. var
  13301. Index: Integer;
  13302. begin
  13303. if ReadOnly then
  13304. raise EJclReadOnlyError.Create;
  13305. {$IFDEF THREADSAFE}
  13306. if FThreadSafe then
  13307. SyncReaderWriter.BeginWrite;
  13308. try
  13309. {$ENDIF THREADSAFE}
  13310. for Index := 0 to FSize - 1 do
  13311. begin
  13312. FreeKey(FEntries[Index].Key);
  13313. FreeValue(FEntries[Index].Value);
  13314. end;
  13315. FSize := 0;
  13316. AutoPack;
  13317. {$IFDEF THREADSAFE}
  13318. finally
  13319. if FThreadSafe then
  13320. SyncReaderWriter.EndWrite;
  13321. end;
  13322. {$ENDIF THREADSAFE}
  13323. end;
  13324. function TJclIntfExtendedSortedMap.ContainsKey(const Key: IInterface): Boolean;
  13325. var
  13326. Index: Integer;
  13327. begin
  13328. {$IFDEF THREADSAFE}
  13329. if FThreadSafe then
  13330. SyncReaderWriter.BeginRead;
  13331. try
  13332. {$ENDIF THREADSAFE}
  13333. Index := BinarySearch(Key);
  13334. Result := (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0);
  13335. {$IFDEF THREADSAFE}
  13336. finally
  13337. if FThreadSafe then
  13338. SyncReaderWriter.EndRead;
  13339. end;
  13340. {$ENDIF THREADSAFE}
  13341. end;
  13342. function TJclIntfExtendedSortedMap.ContainsValue(const Value: Extended): Boolean;
  13343. var
  13344. Index: Integer;
  13345. begin
  13346. {$IFDEF THREADSAFE}
  13347. if FThreadSafe then
  13348. SyncReaderWriter.BeginRead;
  13349. try
  13350. {$ENDIF THREADSAFE}
  13351. Result := False;
  13352. for Index := 0 to FSize - 1 do
  13353. if ValuesCompare(FEntries[Index].Value, Value) = 0 then
  13354. begin
  13355. Result := True;
  13356. Break;
  13357. end;
  13358. {$IFDEF THREADSAFE}
  13359. finally
  13360. if FThreadSafe then
  13361. SyncReaderWriter.EndRead;
  13362. end;
  13363. {$ENDIF THREADSAFE}
  13364. end;
  13365. function TJclIntfExtendedSortedMap.FirstKey: IInterface;
  13366. begin
  13367. {$IFDEF THREADSAFE}
  13368. if FThreadSafe then
  13369. SyncReaderWriter.BeginRead;
  13370. try
  13371. {$ENDIF THREADSAFE}
  13372. Result := nil;
  13373. if FSize > 0 then
  13374. Result := FEntries[0].Key
  13375. else
  13376. if not FReturnDefaultElements then
  13377. raise EJclNoSuchElementError.Create('');
  13378. {$IFDEF THREADSAFE}
  13379. finally
  13380. if FThreadSafe then
  13381. SyncReaderWriter.EndRead;
  13382. end;
  13383. {$ENDIF THREADSAFE}
  13384. end;
  13385. function TJclIntfExtendedSortedMap.Extract(const Key: IInterface): Extended;
  13386. var
  13387. Index: Integer;
  13388. begin
  13389. if ReadOnly then
  13390. raise EJclReadOnlyError.Create;
  13391. {$IFDEF THREADSAFE}
  13392. if FThreadSafe then
  13393. SyncReaderWriter.BeginWrite;
  13394. try
  13395. {$ENDIF THREADSAFE}
  13396. Index := BinarySearch(Key);
  13397. if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then
  13398. begin
  13399. Result := FEntries[Index].Value;
  13400. FEntries[Index].Value := 0.0;
  13401. FreeKey(FEntries[Index].Key);
  13402. if Index < (FSize - 1) then
  13403. MoveArray(FEntries, Index + 1, Index, FSize - Index - 1);
  13404. Dec(FSize);
  13405. AutoPack;
  13406. end
  13407. else
  13408. Result := 0.0;
  13409. {$IFDEF THREADSAFE}
  13410. finally
  13411. if FThreadSafe then
  13412. SyncReaderWriter.EndWrite;
  13413. end;
  13414. {$ENDIF THREADSAFE}
  13415. end;
  13416. function TJclIntfExtendedSortedMap.GetValue(const Key: IInterface): Extended;
  13417. var
  13418. Index: Integer;
  13419. begin
  13420. {$IFDEF THREADSAFE}
  13421. if FThreadSafe then
  13422. SyncReaderWriter.BeginRead;
  13423. try
  13424. {$ENDIF THREADSAFE}
  13425. Index := BinarySearch(Key);
  13426. Result := 0.0;
  13427. if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then
  13428. Result := FEntries[Index].Value
  13429. else if not FReturnDefaultElements then
  13430. raise EJclNoSuchElementError.Create('');
  13431. {$IFDEF THREADSAFE}
  13432. finally
  13433. if FThreadSafe then
  13434. SyncReaderWriter.EndRead;
  13435. end;
  13436. {$ENDIF THREADSAFE}
  13437. end;
  13438. function TJclIntfExtendedSortedMap.HeadMap(const ToKey: IInterface): IJclIntfExtendedSortedMap;
  13439. var
  13440. ToIndex: Integer;
  13441. NewMap: TJclIntfExtendedSortedMap;
  13442. begin
  13443. {$IFDEF THREADSAFE}
  13444. if FThreadSafe then
  13445. SyncReaderWriter.BeginRead;
  13446. try
  13447. {$ENDIF THREADSAFE}
  13448. NewMap := CreateEmptyContainer as TJclIntfExtendedSortedMap;
  13449. ToIndex := BinarySearch(ToKey);
  13450. if ToIndex >= 0 then
  13451. begin
  13452. NewMap.SetCapacity(ToIndex + 1);
  13453. NewMap.FSize := ToIndex + 1;
  13454. while ToIndex >= 0 do
  13455. begin
  13456. NewMap.FEntries[ToIndex] := FEntries[ToIndex];
  13457. Dec(ToIndex);
  13458. end;
  13459. end;
  13460. Result := NewMap;
  13461. {$IFDEF THREADSAFE}
  13462. finally
  13463. if FThreadSafe then
  13464. SyncReaderWriter.EndRead;
  13465. end;
  13466. {$ENDIF THREADSAFE}
  13467. end;
  13468. function TJclIntfExtendedSortedMap.IsEmpty: Boolean;
  13469. begin
  13470. {$IFDEF THREADSAFE}
  13471. if FThreadSafe then
  13472. SyncReaderWriter.BeginRead;
  13473. try
  13474. {$ENDIF THREADSAFE}
  13475. Result := FSize = 0;
  13476. {$IFDEF THREADSAFE}
  13477. finally
  13478. if FThreadSafe then
  13479. SyncReaderWriter.EndRead;
  13480. end;
  13481. {$ENDIF THREADSAFE}
  13482. end;
  13483. function TJclIntfExtendedSortedMap.KeyOfValue(const Value: Extended): IInterface;
  13484. var
  13485. Index: Integer;
  13486. Found: Boolean;
  13487. begin
  13488. {$IFDEF THREADSAFE}
  13489. if FThreadSafe then
  13490. SyncReaderWriter.BeginRead;
  13491. try
  13492. {$ENDIF THREADSAFE}
  13493. Found := False;
  13494. Result := nil;
  13495. for Index := 0 to FSize - 1 do
  13496. if ValuesCompare(FEntries[Index].Value, Value) = 0 then
  13497. begin
  13498. Result := FEntries[Index].Key;
  13499. Found := True;
  13500. Break;
  13501. end;
  13502. if (not Found) and (not FReturnDefaultElements) then
  13503. raise EJclNoSuchElementError.Create('');
  13504. {$IFDEF THREADSAFE}
  13505. finally
  13506. if FThreadSafe then
  13507. SyncReaderWriter.EndRead;
  13508. end;
  13509. {$ENDIF THREADSAFE}
  13510. end;
  13511. function TJclIntfExtendedSortedMap.KeySet: IJclIntfSet;
  13512. var
  13513. Index: Integer;
  13514. begin
  13515. {$IFDEF THREADSAFE}
  13516. if FThreadSafe then
  13517. SyncReaderWriter.BeginRead;
  13518. try
  13519. {$ENDIF THREADSAFE}
  13520. Result := TJclIntfArraySet.Create(FSize);
  13521. for Index := 0 to FSize - 1 do
  13522. Result.Add(FEntries[Index].Key);
  13523. {$IFDEF THREADSAFE}
  13524. finally
  13525. if FThreadSafe then
  13526. SyncReaderWriter.EndRead;
  13527. end;
  13528. {$ENDIF THREADSAFE}
  13529. end;
  13530. function TJclIntfExtendedSortedMap.LastKey: IInterface;
  13531. begin
  13532. {$IFDEF THREADSAFE}
  13533. if FThreadSafe then
  13534. SyncReaderWriter.BeginRead;
  13535. try
  13536. {$ENDIF THREADSAFE}
  13537. Result := nil;
  13538. if FSize > 0 then
  13539. Result := FEntries[FSize - 1].Key
  13540. else
  13541. if not FReturnDefaultElements then
  13542. raise EJclNoSuchElementError.Create('');
  13543. {$IFDEF THREADSAFE}
  13544. finally
  13545. if FThreadSafe then
  13546. SyncReaderWriter.EndRead;
  13547. end;
  13548. {$ENDIF THREADSAFE}
  13549. end;
  13550. function TJclIntfExtendedSortedMap.MapEquals(const AMap: IJclIntfExtendedMap): Boolean;
  13551. var
  13552. It: IJclIntfIterator;
  13553. Index: Integer;
  13554. AKey: IInterface;
  13555. begin
  13556. {$IFDEF THREADSAFE}
  13557. if FThreadSafe then
  13558. SyncReaderWriter.BeginRead;
  13559. try
  13560. {$ENDIF THREADSAFE}
  13561. Result := False;
  13562. if AMap = nil then
  13563. Exit;
  13564. if FSize <> AMap.Size then
  13565. Exit;
  13566. It := AMap.KeySet.First;
  13567. Index := 0;
  13568. while It.HasNext do
  13569. begin
  13570. if Index >= FSize then
  13571. Exit;
  13572. AKey := It.Next;
  13573. if ValuesCompare(AMap.GetValue(AKey), FEntries[Index].Value) <> 0 then
  13574. Exit;
  13575. Inc(Index);
  13576. end;
  13577. Result := True;
  13578. {$IFDEF THREADSAFE}
  13579. finally
  13580. if FThreadSafe then
  13581. SyncReaderWriter.EndRead;
  13582. end;
  13583. {$ENDIF THREADSAFE}
  13584. end;
  13585. procedure TJclIntfExtendedSortedMap.FinalizeArrayBeforeMove(var List: TJclIntfExtendedSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  13586. begin
  13587. Assert(Count > 0);
  13588. if FromIndex < ToIndex then
  13589. begin
  13590. if Count > (ToIndex - FromIndex) then
  13591. Finalize(List[FromIndex + Count], ToIndex - FromIndex)
  13592. else
  13593. Finalize(List[ToIndex], Count);
  13594. end
  13595. else
  13596. if FromIndex > ToIndex then
  13597. begin
  13598. if Count > (FromIndex - ToIndex) then
  13599. Count := FromIndex - ToIndex;
  13600. Finalize(List[ToIndex], Count)
  13601. end;
  13602. end;
  13603. procedure TJclIntfExtendedSortedMap.InitializeArray(var List: TJclIntfExtendedSortedMapEntryArray; FromIndex, Count: SizeInt);
  13604. begin
  13605. {$IFDEF FPC}
  13606. while Count > 0 do
  13607. begin
  13608. Initialize(List[FromIndex]);
  13609. Inc(FromIndex);
  13610. Dec(Count);
  13611. end;
  13612. {$ELSE ~FPC}
  13613. Initialize(List[FromIndex], Count);
  13614. {$ENDIF ~FPC}
  13615. end;
  13616. procedure TJclIntfExtendedSortedMap.InitializeArrayAfterMove(var List: TJclIntfExtendedSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  13617. begin
  13618. { Keep reference counting working }
  13619. if FromIndex < ToIndex then
  13620. begin
  13621. if (ToIndex - FromIndex) < Count then
  13622. Count := ToIndex - FromIndex;
  13623. InitializeArray(List, FromIndex, Count);
  13624. end
  13625. else
  13626. if FromIndex > ToIndex then
  13627. begin
  13628. if (FromIndex - ToIndex) < Count then
  13629. InitializeArray(List, ToIndex + Count, FromIndex - ToIndex)
  13630. else
  13631. InitializeArray(List, FromIndex, Count);
  13632. end;
  13633. end;
  13634. procedure TJclIntfExtendedSortedMap.MoveArray(var List: TJclIntfExtendedSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  13635. begin
  13636. if Count > 0 then
  13637. begin
  13638. FinalizeArrayBeforeMove(List, FromIndex, ToIndex, Count);
  13639. Move(List[FromIndex], List[ToIndex], Count * SizeOf(List[0]));
  13640. InitializeArrayAfterMove(List, FromIndex, ToIndex, Count);
  13641. end;
  13642. end;
  13643. procedure TJclIntfExtendedSortedMap.PutAll(const AMap: IJclIntfExtendedMap);
  13644. var
  13645. It: IJclIntfIterator;
  13646. Key: IInterface;
  13647. begin
  13648. if ReadOnly then
  13649. raise EJclReadOnlyError.Create;
  13650. {$IFDEF THREADSAFE}
  13651. if FThreadSafe then
  13652. SyncReaderWriter.BeginWrite;
  13653. try
  13654. {$ENDIF THREADSAFE}
  13655. if AMap = nil then
  13656. Exit;
  13657. It := AMap.KeySet.First;
  13658. while It.HasNext do
  13659. begin
  13660. Key := It.Next;
  13661. PutValue(Key, AMap.GetValue(Key));
  13662. end;
  13663. {$IFDEF THREADSAFE}
  13664. finally
  13665. if FThreadSafe then
  13666. SyncReaderWriter.EndWrite;
  13667. end;
  13668. {$ENDIF THREADSAFE}
  13669. end;
  13670. procedure TJclIntfExtendedSortedMap.PutValue(const Key: IInterface; const Value: Extended);
  13671. var
  13672. Index: Integer;
  13673. begin
  13674. if ReadOnly then
  13675. raise EJclReadOnlyError.Create;
  13676. {$IFDEF THREADSAFE}
  13677. if FThreadSafe then
  13678. SyncReaderWriter.BeginWrite;
  13679. try
  13680. {$ENDIF THREADSAFE}
  13681. if FAllowDefaultElements or ((KeysCompare(Key, nil) <> 0) and (ValuesCompare(Value, 0.0) <> 0)) then
  13682. begin
  13683. Index := BinarySearch(Key);
  13684. if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then
  13685. begin
  13686. FreeValue(FEntries[Index].Value);
  13687. FEntries[Index].Value := Value;
  13688. end
  13689. else
  13690. begin
  13691. if FSize = FCapacity then
  13692. AutoGrow;
  13693. if FSize < FCapacity then
  13694. begin
  13695. Inc(Index);
  13696. if (Index < FSize) and (KeysCompare(FEntries[Index].Key, Key) <> 0) then
  13697. MoveArray(FEntries, Index, Index + 1, FSize - Index);
  13698. FEntries[Index].Key := Key;
  13699. FEntries[Index].Value := Value;
  13700. Inc(FSize);
  13701. end;
  13702. end;
  13703. end;
  13704. {$IFDEF THREADSAFE}
  13705. finally
  13706. if FThreadSafe then
  13707. SyncReaderWriter.EndWrite;
  13708. end;
  13709. {$ENDIF THREADSAFE}
  13710. end;
  13711. function TJclIntfExtendedSortedMap.Remove(const Key: IInterface): Extended;
  13712. begin
  13713. if ReadOnly then
  13714. raise EJclReadOnlyError.Create;
  13715. {$IFDEF THREADSAFE}
  13716. if FThreadSafe then
  13717. SyncReaderWriter.BeginWrite;
  13718. try
  13719. {$ENDIF THREADSAFE}
  13720. Result := Extract(Key);
  13721. Result := FreeValue(Result);
  13722. {$IFDEF THREADSAFE}
  13723. finally
  13724. if FThreadSafe then
  13725. SyncReaderWriter.EndWrite;
  13726. end;
  13727. {$ENDIF THREADSAFE}
  13728. end;
  13729. procedure TJclIntfExtendedSortedMap.SetCapacity(Value: Integer);
  13730. begin
  13731. if ReadOnly then
  13732. raise EJclReadOnlyError.Create;
  13733. {$IFDEF THREADSAFE}
  13734. if FThreadSafe then
  13735. SyncReaderWriter.BeginWrite;
  13736. try
  13737. {$ENDIF THREADSAFE}
  13738. if FSize <= Value then
  13739. begin
  13740. SetLength(FEntries, Value);
  13741. inherited SetCapacity(Value);
  13742. end
  13743. else
  13744. raise EJclOperationNotSupportedError.Create;
  13745. {$IFDEF THREADSAFE}
  13746. finally
  13747. if FThreadSafe then
  13748. SyncReaderWriter.EndWrite;
  13749. end;
  13750. {$ENDIF THREADSAFE}
  13751. end;
  13752. function TJclIntfExtendedSortedMap.Size: Integer;
  13753. begin
  13754. Result := FSize;
  13755. end;
  13756. function TJclIntfExtendedSortedMap.SubMap(const FromKey, ToKey: IInterface): IJclIntfExtendedSortedMap;
  13757. var
  13758. FromIndex, ToIndex: Integer;
  13759. NewMap: TJclIntfExtendedSortedMap;
  13760. begin
  13761. {$IFDEF THREADSAFE}
  13762. if FThreadSafe then
  13763. SyncReaderWriter.BeginRead;
  13764. try
  13765. {$ENDIF THREADSAFE}
  13766. NewMap := CreateEmptyContainer as TJclIntfExtendedSortedMap;
  13767. FromIndex := BinarySearch(FromKey);
  13768. if (FromIndex = -1) or (KeysCompare(FEntries[FromIndex].Key, FromKey) < 0) then
  13769. Inc(FromIndex);
  13770. ToIndex := BinarySearch(ToKey);
  13771. if (FromIndex >= 0) and (FromIndex <= ToIndex) then
  13772. begin
  13773. NewMap.SetCapacity(ToIndex - FromIndex + 1);
  13774. NewMap.FSize := ToIndex - FromIndex + 1;
  13775. while ToIndex >= FromIndex do
  13776. begin
  13777. NewMap.FEntries[ToIndex - FromIndex] := FEntries[ToIndex];
  13778. Dec(ToIndex);
  13779. end;
  13780. end;
  13781. Result := NewMap;
  13782. {$IFDEF THREADSAFE}
  13783. finally
  13784. if FThreadSafe then
  13785. SyncReaderWriter.EndRead;
  13786. end;
  13787. {$ENDIF THREADSAFE}
  13788. end;
  13789. function TJclIntfExtendedSortedMap.TailMap(const FromKey: IInterface): IJclIntfExtendedSortedMap;
  13790. var
  13791. FromIndex, Index: Integer;
  13792. NewMap: TJclIntfExtendedSortedMap;
  13793. begin
  13794. {$IFDEF THREADSAFE}
  13795. if FThreadSafe then
  13796. SyncReaderWriter.BeginRead;
  13797. try
  13798. {$ENDIF THREADSAFE}
  13799. NewMap := CreateEmptyContainer as TJclIntfExtendedSortedMap;
  13800. FromIndex := BinarySearch(FromKey);
  13801. if (FromIndex = -1) or (KeysCompare(FEntries[FromIndex].Key, FromKey) < 0) then
  13802. Inc(FromIndex);
  13803. if (FromIndex >= 0) and (FromIndex < FSize) then
  13804. begin
  13805. NewMap.SetCapacity(FSize - FromIndex);
  13806. NewMap.FSize := FSize - FromIndex;
  13807. Index := FromIndex;
  13808. while Index < FSize do
  13809. begin
  13810. NewMap.FEntries[Index - FromIndex] := FEntries[Index];
  13811. Inc(Index);
  13812. end;
  13813. end;
  13814. Result := NewMap;
  13815. {$IFDEF THREADSAFE}
  13816. finally
  13817. if FThreadSafe then
  13818. SyncReaderWriter.EndRead;
  13819. end;
  13820. {$ENDIF THREADSAFE}
  13821. end;
  13822. function TJclIntfExtendedSortedMap.Values: IJclExtendedCollection;
  13823. var
  13824. Index: Integer;
  13825. begin
  13826. {$IFDEF THREADSAFE}
  13827. if FThreadSafe then
  13828. SyncReaderWriter.BeginRead;
  13829. try
  13830. {$ENDIF THREADSAFE}
  13831. Result := TJclExtendedArrayList.Create(FSize);
  13832. for Index := 0 to FSize - 1 do
  13833. Result.Add(FEntries[Index].Value);
  13834. {$IFDEF THREADSAFE}
  13835. finally
  13836. if FThreadSafe then
  13837. SyncReaderWriter.EndRead;
  13838. end;
  13839. {$ENDIF THREADSAFE}
  13840. end;
  13841. function TJclIntfExtendedSortedMap.CreateEmptyContainer: TJclAbstractContainerBase;
  13842. begin
  13843. Result := TJclIntfExtendedSortedMap.Create(FSize);
  13844. AssignPropertiesTo(Result);
  13845. end;
  13846. function TJclIntfExtendedSortedMap.FreeKey(var Key: IInterface): IInterface;
  13847. begin
  13848. Result := Key;
  13849. Key := nil;
  13850. end;
  13851. function TJclIntfExtendedSortedMap.FreeValue(var Value: Extended): Extended;
  13852. begin
  13853. Result := Value;
  13854. Value := 0.0;
  13855. end;
  13856. function TJclIntfExtendedSortedMap.KeysCompare(const A, B: IInterface): Integer;
  13857. begin
  13858. Result := IntfSimpleCompare(A, B);
  13859. end;
  13860. function TJclIntfExtendedSortedMap.ValuesCompare(const A, B: Extended): Integer;
  13861. begin
  13862. Result := ItemsCompare(A, B);
  13863. end;
  13864. //=== { TJclExtendedExtendedSortedMap } ==============================================
  13865. constructor TJclExtendedExtendedSortedMap.Create(ACapacity: Integer);
  13866. begin
  13867. inherited Create();
  13868. SetCapacity(ACapacity);
  13869. end;
  13870. destructor TJclExtendedExtendedSortedMap.Destroy;
  13871. begin
  13872. FReadOnly := False;
  13873. Clear;
  13874. inherited Destroy;
  13875. end;
  13876. procedure TJclExtendedExtendedSortedMap.AssignDataTo(Dest: TJclAbstractContainerBase);
  13877. var
  13878. MyDest: TJclExtendedExtendedSortedMap;
  13879. begin
  13880. inherited AssignDataTo(Dest);
  13881. if Dest is TJclExtendedExtendedSortedMap then
  13882. begin
  13883. MyDest := TJclExtendedExtendedSortedMap(Dest);
  13884. MyDest.SetCapacity(FSize);
  13885. MyDest.FEntries := FEntries;
  13886. MyDest.FSize := FSize;
  13887. end;
  13888. end;
  13889. function TJclExtendedExtendedSortedMap.BinarySearch(const Key: Extended): Integer;
  13890. var
  13891. HiPos, LoPos, CompPos: Integer;
  13892. Comp: Integer;
  13893. begin
  13894. {$IFDEF THREADSAFE}
  13895. if FThreadSafe then
  13896. SyncReaderWriter.BeginRead;
  13897. try
  13898. {$ENDIF THREADSAFE}
  13899. LoPos := 0;
  13900. HiPos := FSize - 1;
  13901. CompPos := (HiPos + LoPos) div 2;
  13902. while HiPos >= LoPos do
  13903. begin
  13904. Comp := KeysCompare(FEntries[CompPos].Key, Key);
  13905. if Comp < 0 then
  13906. LoPos := CompPos + 1
  13907. else
  13908. if Comp > 0 then
  13909. HiPos := CompPos - 1
  13910. else
  13911. begin
  13912. HiPos := CompPos;
  13913. LoPos := CompPos + 1;
  13914. end;
  13915. CompPos := (HiPos + LoPos) div 2;
  13916. end;
  13917. Result := HiPos;
  13918. {$IFDEF THREADSAFE}
  13919. finally
  13920. if FThreadSafe then
  13921. SyncReaderWriter.EndRead;
  13922. end;
  13923. {$ENDIF THREADSAFE}
  13924. end;
  13925. procedure TJclExtendedExtendedSortedMap.Clear;
  13926. var
  13927. Index: Integer;
  13928. begin
  13929. if ReadOnly then
  13930. raise EJclReadOnlyError.Create;
  13931. {$IFDEF THREADSAFE}
  13932. if FThreadSafe then
  13933. SyncReaderWriter.BeginWrite;
  13934. try
  13935. {$ENDIF THREADSAFE}
  13936. for Index := 0 to FSize - 1 do
  13937. begin
  13938. FreeKey(FEntries[Index].Key);
  13939. FreeValue(FEntries[Index].Value);
  13940. end;
  13941. FSize := 0;
  13942. AutoPack;
  13943. {$IFDEF THREADSAFE}
  13944. finally
  13945. if FThreadSafe then
  13946. SyncReaderWriter.EndWrite;
  13947. end;
  13948. {$ENDIF THREADSAFE}
  13949. end;
  13950. function TJclExtendedExtendedSortedMap.ContainsKey(const Key: Extended): Boolean;
  13951. var
  13952. Index: Integer;
  13953. begin
  13954. {$IFDEF THREADSAFE}
  13955. if FThreadSafe then
  13956. SyncReaderWriter.BeginRead;
  13957. try
  13958. {$ENDIF THREADSAFE}
  13959. Index := BinarySearch(Key);
  13960. Result := (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0);
  13961. {$IFDEF THREADSAFE}
  13962. finally
  13963. if FThreadSafe then
  13964. SyncReaderWriter.EndRead;
  13965. end;
  13966. {$ENDIF THREADSAFE}
  13967. end;
  13968. function TJclExtendedExtendedSortedMap.ContainsValue(const Value: Extended): Boolean;
  13969. var
  13970. Index: Integer;
  13971. begin
  13972. {$IFDEF THREADSAFE}
  13973. if FThreadSafe then
  13974. SyncReaderWriter.BeginRead;
  13975. try
  13976. {$ENDIF THREADSAFE}
  13977. Result := False;
  13978. for Index := 0 to FSize - 1 do
  13979. if ValuesCompare(FEntries[Index].Value, Value) = 0 then
  13980. begin
  13981. Result := True;
  13982. Break;
  13983. end;
  13984. {$IFDEF THREADSAFE}
  13985. finally
  13986. if FThreadSafe then
  13987. SyncReaderWriter.EndRead;
  13988. end;
  13989. {$ENDIF THREADSAFE}
  13990. end;
  13991. function TJclExtendedExtendedSortedMap.FirstKey: Extended;
  13992. begin
  13993. {$IFDEF THREADSAFE}
  13994. if FThreadSafe then
  13995. SyncReaderWriter.BeginRead;
  13996. try
  13997. {$ENDIF THREADSAFE}
  13998. Result := 0.0;
  13999. if FSize > 0 then
  14000. Result := FEntries[0].Key
  14001. else
  14002. if not FReturnDefaultElements then
  14003. raise EJclNoSuchElementError.Create('');
  14004. {$IFDEF THREADSAFE}
  14005. finally
  14006. if FThreadSafe then
  14007. SyncReaderWriter.EndRead;
  14008. end;
  14009. {$ENDIF THREADSAFE}
  14010. end;
  14011. function TJclExtendedExtendedSortedMap.Extract(const Key: Extended): Extended;
  14012. var
  14013. Index: Integer;
  14014. begin
  14015. if ReadOnly then
  14016. raise EJclReadOnlyError.Create;
  14017. {$IFDEF THREADSAFE}
  14018. if FThreadSafe then
  14019. SyncReaderWriter.BeginWrite;
  14020. try
  14021. {$ENDIF THREADSAFE}
  14022. Index := BinarySearch(Key);
  14023. if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then
  14024. begin
  14025. Result := FEntries[Index].Value;
  14026. FEntries[Index].Value := 0.0;
  14027. FreeKey(FEntries[Index].Key);
  14028. if Index < (FSize - 1) then
  14029. MoveArray(FEntries, Index + 1, Index, FSize - Index - 1);
  14030. Dec(FSize);
  14031. AutoPack;
  14032. end
  14033. else
  14034. Result := 0.0;
  14035. {$IFDEF THREADSAFE}
  14036. finally
  14037. if FThreadSafe then
  14038. SyncReaderWriter.EndWrite;
  14039. end;
  14040. {$ENDIF THREADSAFE}
  14041. end;
  14042. function TJclExtendedExtendedSortedMap.GetValue(const Key: Extended): Extended;
  14043. var
  14044. Index: Integer;
  14045. begin
  14046. {$IFDEF THREADSAFE}
  14047. if FThreadSafe then
  14048. SyncReaderWriter.BeginRead;
  14049. try
  14050. {$ENDIF THREADSAFE}
  14051. Index := BinarySearch(Key);
  14052. Result := 0.0;
  14053. if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then
  14054. Result := FEntries[Index].Value
  14055. else if not FReturnDefaultElements then
  14056. raise EJclNoSuchElementError.Create('');
  14057. {$IFDEF THREADSAFE}
  14058. finally
  14059. if FThreadSafe then
  14060. SyncReaderWriter.EndRead;
  14061. end;
  14062. {$ENDIF THREADSAFE}
  14063. end;
  14064. function TJclExtendedExtendedSortedMap.HeadMap(const ToKey: Extended): IJclExtendedExtendedSortedMap;
  14065. var
  14066. ToIndex: Integer;
  14067. NewMap: TJclExtendedExtendedSortedMap;
  14068. begin
  14069. {$IFDEF THREADSAFE}
  14070. if FThreadSafe then
  14071. SyncReaderWriter.BeginRead;
  14072. try
  14073. {$ENDIF THREADSAFE}
  14074. NewMap := CreateEmptyContainer as TJclExtendedExtendedSortedMap;
  14075. ToIndex := BinarySearch(ToKey);
  14076. if ToIndex >= 0 then
  14077. begin
  14078. NewMap.SetCapacity(ToIndex + 1);
  14079. NewMap.FSize := ToIndex + 1;
  14080. while ToIndex >= 0 do
  14081. begin
  14082. NewMap.FEntries[ToIndex] := FEntries[ToIndex];
  14083. Dec(ToIndex);
  14084. end;
  14085. end;
  14086. Result := NewMap;
  14087. {$IFDEF THREADSAFE}
  14088. finally
  14089. if FThreadSafe then
  14090. SyncReaderWriter.EndRead;
  14091. end;
  14092. {$ENDIF THREADSAFE}
  14093. end;
  14094. function TJclExtendedExtendedSortedMap.IsEmpty: Boolean;
  14095. begin
  14096. {$IFDEF THREADSAFE}
  14097. if FThreadSafe then
  14098. SyncReaderWriter.BeginRead;
  14099. try
  14100. {$ENDIF THREADSAFE}
  14101. Result := FSize = 0;
  14102. {$IFDEF THREADSAFE}
  14103. finally
  14104. if FThreadSafe then
  14105. SyncReaderWriter.EndRead;
  14106. end;
  14107. {$ENDIF THREADSAFE}
  14108. end;
  14109. function TJclExtendedExtendedSortedMap.KeyOfValue(const Value: Extended): Extended;
  14110. var
  14111. Index: Integer;
  14112. Found: Boolean;
  14113. begin
  14114. {$IFDEF THREADSAFE}
  14115. if FThreadSafe then
  14116. SyncReaderWriter.BeginRead;
  14117. try
  14118. {$ENDIF THREADSAFE}
  14119. Found := False;
  14120. Result := 0.0;
  14121. for Index := 0 to FSize - 1 do
  14122. if ValuesCompare(FEntries[Index].Value, Value) = 0 then
  14123. begin
  14124. Result := FEntries[Index].Key;
  14125. Found := True;
  14126. Break;
  14127. end;
  14128. if (not Found) and (not FReturnDefaultElements) then
  14129. raise EJclNoSuchElementError.Create('');
  14130. {$IFDEF THREADSAFE}
  14131. finally
  14132. if FThreadSafe then
  14133. SyncReaderWriter.EndRead;
  14134. end;
  14135. {$ENDIF THREADSAFE}
  14136. end;
  14137. function TJclExtendedExtendedSortedMap.KeySet: IJclExtendedSet;
  14138. var
  14139. Index: Integer;
  14140. begin
  14141. {$IFDEF THREADSAFE}
  14142. if FThreadSafe then
  14143. SyncReaderWriter.BeginRead;
  14144. try
  14145. {$ENDIF THREADSAFE}
  14146. Result := TJclExtendedArraySet.Create(FSize);
  14147. for Index := 0 to FSize - 1 do
  14148. Result.Add(FEntries[Index].Key);
  14149. {$IFDEF THREADSAFE}
  14150. finally
  14151. if FThreadSafe then
  14152. SyncReaderWriter.EndRead;
  14153. end;
  14154. {$ENDIF THREADSAFE}
  14155. end;
  14156. function TJclExtendedExtendedSortedMap.LastKey: Extended;
  14157. begin
  14158. {$IFDEF THREADSAFE}
  14159. if FThreadSafe then
  14160. SyncReaderWriter.BeginRead;
  14161. try
  14162. {$ENDIF THREADSAFE}
  14163. Result := 0.0;
  14164. if FSize > 0 then
  14165. Result := FEntries[FSize - 1].Key
  14166. else
  14167. if not FReturnDefaultElements then
  14168. raise EJclNoSuchElementError.Create('');
  14169. {$IFDEF THREADSAFE}
  14170. finally
  14171. if FThreadSafe then
  14172. SyncReaderWriter.EndRead;
  14173. end;
  14174. {$ENDIF THREADSAFE}
  14175. end;
  14176. function TJclExtendedExtendedSortedMap.MapEquals(const AMap: IJclExtendedExtendedMap): Boolean;
  14177. var
  14178. It: IJclExtendedIterator;
  14179. Index: Integer;
  14180. AKey: Extended;
  14181. begin
  14182. {$IFDEF THREADSAFE}
  14183. if FThreadSafe then
  14184. SyncReaderWriter.BeginRead;
  14185. try
  14186. {$ENDIF THREADSAFE}
  14187. Result := False;
  14188. if AMap = nil then
  14189. Exit;
  14190. if FSize <> AMap.Size then
  14191. Exit;
  14192. It := AMap.KeySet.First;
  14193. Index := 0;
  14194. while It.HasNext do
  14195. begin
  14196. if Index >= FSize then
  14197. Exit;
  14198. AKey := It.Next;
  14199. if ValuesCompare(AMap.GetValue(AKey), FEntries[Index].Value) <> 0 then
  14200. Exit;
  14201. Inc(Index);
  14202. end;
  14203. Result := True;
  14204. {$IFDEF THREADSAFE}
  14205. finally
  14206. if FThreadSafe then
  14207. SyncReaderWriter.EndRead;
  14208. end;
  14209. {$ENDIF THREADSAFE}
  14210. end;
  14211. procedure TJclExtendedExtendedSortedMap.InitializeArrayAfterMove(var List: TJclExtendedExtendedSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  14212. begin
  14213. { Clean array }
  14214. if FromIndex < ToIndex then
  14215. begin
  14216. if (ToIndex - FromIndex) < Count then
  14217. Count := ToIndex - FromIndex;
  14218. FillChar(List[FromIndex], Count * SizeOf(List[0]), 0);
  14219. end
  14220. else
  14221. if FromIndex > ToIndex then
  14222. begin
  14223. if (FromIndex - ToIndex) < Count then
  14224. FillChar(List[ToIndex + Count], (FromIndex - ToIndex) * SizeOf(List[0]), 0)
  14225. else
  14226. FillChar(List[FromIndex], Count * SizeOf(List[0]), 0);
  14227. end;
  14228. end;
  14229. procedure TJclExtendedExtendedSortedMap.MoveArray(var List: TJclExtendedExtendedSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  14230. begin
  14231. if Count > 0 then
  14232. begin
  14233. Move(List[FromIndex], List[ToIndex], Count * SizeOf(List[0]));
  14234. InitializeArrayAfterMove(List, FromIndex, ToIndex, Count);
  14235. end;
  14236. end;
  14237. procedure TJclExtendedExtendedSortedMap.PutAll(const AMap: IJclExtendedExtendedMap);
  14238. var
  14239. It: IJclExtendedIterator;
  14240. Key: Extended;
  14241. begin
  14242. if ReadOnly then
  14243. raise EJclReadOnlyError.Create;
  14244. {$IFDEF THREADSAFE}
  14245. if FThreadSafe then
  14246. SyncReaderWriter.BeginWrite;
  14247. try
  14248. {$ENDIF THREADSAFE}
  14249. if AMap = nil then
  14250. Exit;
  14251. It := AMap.KeySet.First;
  14252. while It.HasNext do
  14253. begin
  14254. Key := It.Next;
  14255. PutValue(Key, AMap.GetValue(Key));
  14256. end;
  14257. {$IFDEF THREADSAFE}
  14258. finally
  14259. if FThreadSafe then
  14260. SyncReaderWriter.EndWrite;
  14261. end;
  14262. {$ENDIF THREADSAFE}
  14263. end;
  14264. procedure TJclExtendedExtendedSortedMap.PutValue(const Key: Extended; const Value: Extended);
  14265. var
  14266. Index: Integer;
  14267. begin
  14268. if ReadOnly then
  14269. raise EJclReadOnlyError.Create;
  14270. {$IFDEF THREADSAFE}
  14271. if FThreadSafe then
  14272. SyncReaderWriter.BeginWrite;
  14273. try
  14274. {$ENDIF THREADSAFE}
  14275. if FAllowDefaultElements or ((KeysCompare(Key, 0.0) <> 0) and (ValuesCompare(Value, 0.0) <> 0)) then
  14276. begin
  14277. Index := BinarySearch(Key);
  14278. if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then
  14279. begin
  14280. FreeValue(FEntries[Index].Value);
  14281. FEntries[Index].Value := Value;
  14282. end
  14283. else
  14284. begin
  14285. if FSize = FCapacity then
  14286. AutoGrow;
  14287. if FSize < FCapacity then
  14288. begin
  14289. Inc(Index);
  14290. if (Index < FSize) and (KeysCompare(FEntries[Index].Key, Key) <> 0) then
  14291. MoveArray(FEntries, Index, Index + 1, FSize - Index);
  14292. FEntries[Index].Key := Key;
  14293. FEntries[Index].Value := Value;
  14294. Inc(FSize);
  14295. end;
  14296. end;
  14297. end;
  14298. {$IFDEF THREADSAFE}
  14299. finally
  14300. if FThreadSafe then
  14301. SyncReaderWriter.EndWrite;
  14302. end;
  14303. {$ENDIF THREADSAFE}
  14304. end;
  14305. function TJclExtendedExtendedSortedMap.Remove(const Key: Extended): Extended;
  14306. begin
  14307. if ReadOnly then
  14308. raise EJclReadOnlyError.Create;
  14309. {$IFDEF THREADSAFE}
  14310. if FThreadSafe then
  14311. SyncReaderWriter.BeginWrite;
  14312. try
  14313. {$ENDIF THREADSAFE}
  14314. Result := Extract(Key);
  14315. Result := FreeValue(Result);
  14316. {$IFDEF THREADSAFE}
  14317. finally
  14318. if FThreadSafe then
  14319. SyncReaderWriter.EndWrite;
  14320. end;
  14321. {$ENDIF THREADSAFE}
  14322. end;
  14323. procedure TJclExtendedExtendedSortedMap.SetCapacity(Value: Integer);
  14324. begin
  14325. if ReadOnly then
  14326. raise EJclReadOnlyError.Create;
  14327. {$IFDEF THREADSAFE}
  14328. if FThreadSafe then
  14329. SyncReaderWriter.BeginWrite;
  14330. try
  14331. {$ENDIF THREADSAFE}
  14332. if FSize <= Value then
  14333. begin
  14334. SetLength(FEntries, Value);
  14335. inherited SetCapacity(Value);
  14336. end
  14337. else
  14338. raise EJclOperationNotSupportedError.Create;
  14339. {$IFDEF THREADSAFE}
  14340. finally
  14341. if FThreadSafe then
  14342. SyncReaderWriter.EndWrite;
  14343. end;
  14344. {$ENDIF THREADSAFE}
  14345. end;
  14346. function TJclExtendedExtendedSortedMap.Size: Integer;
  14347. begin
  14348. Result := FSize;
  14349. end;
  14350. function TJclExtendedExtendedSortedMap.SubMap(const FromKey, ToKey: Extended): IJclExtendedExtendedSortedMap;
  14351. var
  14352. FromIndex, ToIndex: Integer;
  14353. NewMap: TJclExtendedExtendedSortedMap;
  14354. begin
  14355. {$IFDEF THREADSAFE}
  14356. if FThreadSafe then
  14357. SyncReaderWriter.BeginRead;
  14358. try
  14359. {$ENDIF THREADSAFE}
  14360. NewMap := CreateEmptyContainer as TJclExtendedExtendedSortedMap;
  14361. FromIndex := BinarySearch(FromKey);
  14362. if (FromIndex = -1) or (KeysCompare(FEntries[FromIndex].Key, FromKey) < 0) then
  14363. Inc(FromIndex);
  14364. ToIndex := BinarySearch(ToKey);
  14365. if (FromIndex >= 0) and (FromIndex <= ToIndex) then
  14366. begin
  14367. NewMap.SetCapacity(ToIndex - FromIndex + 1);
  14368. NewMap.FSize := ToIndex - FromIndex + 1;
  14369. while ToIndex >= FromIndex do
  14370. begin
  14371. NewMap.FEntries[ToIndex - FromIndex] := FEntries[ToIndex];
  14372. Dec(ToIndex);
  14373. end;
  14374. end;
  14375. Result := NewMap;
  14376. {$IFDEF THREADSAFE}
  14377. finally
  14378. if FThreadSafe then
  14379. SyncReaderWriter.EndRead;
  14380. end;
  14381. {$ENDIF THREADSAFE}
  14382. end;
  14383. function TJclExtendedExtendedSortedMap.TailMap(const FromKey: Extended): IJclExtendedExtendedSortedMap;
  14384. var
  14385. FromIndex, Index: Integer;
  14386. NewMap: TJclExtendedExtendedSortedMap;
  14387. begin
  14388. {$IFDEF THREADSAFE}
  14389. if FThreadSafe then
  14390. SyncReaderWriter.BeginRead;
  14391. try
  14392. {$ENDIF THREADSAFE}
  14393. NewMap := CreateEmptyContainer as TJclExtendedExtendedSortedMap;
  14394. FromIndex := BinarySearch(FromKey);
  14395. if (FromIndex = -1) or (KeysCompare(FEntries[FromIndex].Key, FromKey) < 0) then
  14396. Inc(FromIndex);
  14397. if (FromIndex >= 0) and (FromIndex < FSize) then
  14398. begin
  14399. NewMap.SetCapacity(FSize - FromIndex);
  14400. NewMap.FSize := FSize - FromIndex;
  14401. Index := FromIndex;
  14402. while Index < FSize do
  14403. begin
  14404. NewMap.FEntries[Index - FromIndex] := FEntries[Index];
  14405. Inc(Index);
  14406. end;
  14407. end;
  14408. Result := NewMap;
  14409. {$IFDEF THREADSAFE}
  14410. finally
  14411. if FThreadSafe then
  14412. SyncReaderWriter.EndRead;
  14413. end;
  14414. {$ENDIF THREADSAFE}
  14415. end;
  14416. function TJclExtendedExtendedSortedMap.Values: IJclExtendedCollection;
  14417. var
  14418. Index: Integer;
  14419. begin
  14420. {$IFDEF THREADSAFE}
  14421. if FThreadSafe then
  14422. SyncReaderWriter.BeginRead;
  14423. try
  14424. {$ENDIF THREADSAFE}
  14425. Result := TJclExtendedArrayList.Create(FSize);
  14426. for Index := 0 to FSize - 1 do
  14427. Result.Add(FEntries[Index].Value);
  14428. {$IFDEF THREADSAFE}
  14429. finally
  14430. if FThreadSafe then
  14431. SyncReaderWriter.EndRead;
  14432. end;
  14433. {$ENDIF THREADSAFE}
  14434. end;
  14435. function TJclExtendedExtendedSortedMap.CreateEmptyContainer: TJclAbstractContainerBase;
  14436. begin
  14437. Result := TJclExtendedExtendedSortedMap.Create(FSize);
  14438. AssignPropertiesTo(Result);
  14439. end;
  14440. function TJclExtendedExtendedSortedMap.FreeKey(var Key: Extended): Extended;
  14441. begin
  14442. Result := Key;
  14443. Key := 0.0;
  14444. end;
  14445. function TJclExtendedExtendedSortedMap.FreeValue(var Value: Extended): Extended;
  14446. begin
  14447. Result := Value;
  14448. Value := 0.0;
  14449. end;
  14450. function TJclExtendedExtendedSortedMap.KeysCompare(const A, B: Extended): Integer;
  14451. begin
  14452. Result := ItemsCompare(A, B);
  14453. end;
  14454. function TJclExtendedExtendedSortedMap.ValuesCompare(const A, B: Extended): Integer;
  14455. begin
  14456. Result := ItemsCompare(A, B);
  14457. end;
  14458. //=== { TJclIntegerIntfSortedMap } ==============================================
  14459. constructor TJclIntegerIntfSortedMap.Create(ACapacity: Integer);
  14460. begin
  14461. inherited Create();
  14462. SetCapacity(ACapacity);
  14463. end;
  14464. destructor TJclIntegerIntfSortedMap.Destroy;
  14465. begin
  14466. FReadOnly := False;
  14467. Clear;
  14468. inherited Destroy;
  14469. end;
  14470. procedure TJclIntegerIntfSortedMap.AssignDataTo(Dest: TJclAbstractContainerBase);
  14471. var
  14472. MyDest: TJclIntegerIntfSortedMap;
  14473. begin
  14474. inherited AssignDataTo(Dest);
  14475. if Dest is TJclIntegerIntfSortedMap then
  14476. begin
  14477. MyDest := TJclIntegerIntfSortedMap(Dest);
  14478. MyDest.SetCapacity(FSize);
  14479. MyDest.FEntries := FEntries;
  14480. MyDest.FSize := FSize;
  14481. end;
  14482. end;
  14483. function TJclIntegerIntfSortedMap.BinarySearch(Key: Integer): Integer;
  14484. var
  14485. HiPos, LoPos, CompPos: Integer;
  14486. Comp: Integer;
  14487. begin
  14488. {$IFDEF THREADSAFE}
  14489. if FThreadSafe then
  14490. SyncReaderWriter.BeginRead;
  14491. try
  14492. {$ENDIF THREADSAFE}
  14493. LoPos := 0;
  14494. HiPos := FSize - 1;
  14495. CompPos := (HiPos + LoPos) div 2;
  14496. while HiPos >= LoPos do
  14497. begin
  14498. Comp := KeysCompare(FEntries[CompPos].Key, Key);
  14499. if Comp < 0 then
  14500. LoPos := CompPos + 1
  14501. else
  14502. if Comp > 0 then
  14503. HiPos := CompPos - 1
  14504. else
  14505. begin
  14506. HiPos := CompPos;
  14507. LoPos := CompPos + 1;
  14508. end;
  14509. CompPos := (HiPos + LoPos) div 2;
  14510. end;
  14511. Result := HiPos;
  14512. {$IFDEF THREADSAFE}
  14513. finally
  14514. if FThreadSafe then
  14515. SyncReaderWriter.EndRead;
  14516. end;
  14517. {$ENDIF THREADSAFE}
  14518. end;
  14519. procedure TJclIntegerIntfSortedMap.Clear;
  14520. var
  14521. Index: Integer;
  14522. begin
  14523. if ReadOnly then
  14524. raise EJclReadOnlyError.Create;
  14525. {$IFDEF THREADSAFE}
  14526. if FThreadSafe then
  14527. SyncReaderWriter.BeginWrite;
  14528. try
  14529. {$ENDIF THREADSAFE}
  14530. for Index := 0 to FSize - 1 do
  14531. begin
  14532. FreeKey(FEntries[Index].Key);
  14533. FreeValue(FEntries[Index].Value);
  14534. end;
  14535. FSize := 0;
  14536. AutoPack;
  14537. {$IFDEF THREADSAFE}
  14538. finally
  14539. if FThreadSafe then
  14540. SyncReaderWriter.EndWrite;
  14541. end;
  14542. {$ENDIF THREADSAFE}
  14543. end;
  14544. function TJclIntegerIntfSortedMap.ContainsKey(Key: Integer): Boolean;
  14545. var
  14546. Index: Integer;
  14547. begin
  14548. {$IFDEF THREADSAFE}
  14549. if FThreadSafe then
  14550. SyncReaderWriter.BeginRead;
  14551. try
  14552. {$ENDIF THREADSAFE}
  14553. Index := BinarySearch(Key);
  14554. Result := (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0);
  14555. {$IFDEF THREADSAFE}
  14556. finally
  14557. if FThreadSafe then
  14558. SyncReaderWriter.EndRead;
  14559. end;
  14560. {$ENDIF THREADSAFE}
  14561. end;
  14562. function TJclIntegerIntfSortedMap.ContainsValue(const Value: IInterface): Boolean;
  14563. var
  14564. Index: Integer;
  14565. begin
  14566. {$IFDEF THREADSAFE}
  14567. if FThreadSafe then
  14568. SyncReaderWriter.BeginRead;
  14569. try
  14570. {$ENDIF THREADSAFE}
  14571. Result := False;
  14572. for Index := 0 to FSize - 1 do
  14573. if ValuesCompare(FEntries[Index].Value, Value) = 0 then
  14574. begin
  14575. Result := True;
  14576. Break;
  14577. end;
  14578. {$IFDEF THREADSAFE}
  14579. finally
  14580. if FThreadSafe then
  14581. SyncReaderWriter.EndRead;
  14582. end;
  14583. {$ENDIF THREADSAFE}
  14584. end;
  14585. function TJclIntegerIntfSortedMap.FirstKey: Integer;
  14586. begin
  14587. {$IFDEF THREADSAFE}
  14588. if FThreadSafe then
  14589. SyncReaderWriter.BeginRead;
  14590. try
  14591. {$ENDIF THREADSAFE}
  14592. Result := 0;
  14593. if FSize > 0 then
  14594. Result := FEntries[0].Key
  14595. else
  14596. if not FReturnDefaultElements then
  14597. raise EJclNoSuchElementError.Create('');
  14598. {$IFDEF THREADSAFE}
  14599. finally
  14600. if FThreadSafe then
  14601. SyncReaderWriter.EndRead;
  14602. end;
  14603. {$ENDIF THREADSAFE}
  14604. end;
  14605. function TJclIntegerIntfSortedMap.Extract(Key: Integer): IInterface;
  14606. var
  14607. Index: Integer;
  14608. begin
  14609. if ReadOnly then
  14610. raise EJclReadOnlyError.Create;
  14611. {$IFDEF THREADSAFE}
  14612. if FThreadSafe then
  14613. SyncReaderWriter.BeginWrite;
  14614. try
  14615. {$ENDIF THREADSAFE}
  14616. Index := BinarySearch(Key);
  14617. if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then
  14618. begin
  14619. Result := FEntries[Index].Value;
  14620. FEntries[Index].Value := nil;
  14621. FreeKey(FEntries[Index].Key);
  14622. if Index < (FSize - 1) then
  14623. MoveArray(FEntries, Index + 1, Index, FSize - Index - 1);
  14624. Dec(FSize);
  14625. AutoPack;
  14626. end
  14627. else
  14628. Result := nil;
  14629. {$IFDEF THREADSAFE}
  14630. finally
  14631. if FThreadSafe then
  14632. SyncReaderWriter.EndWrite;
  14633. end;
  14634. {$ENDIF THREADSAFE}
  14635. end;
  14636. function TJclIntegerIntfSortedMap.GetValue(Key: Integer): IInterface;
  14637. var
  14638. Index: Integer;
  14639. begin
  14640. {$IFDEF THREADSAFE}
  14641. if FThreadSafe then
  14642. SyncReaderWriter.BeginRead;
  14643. try
  14644. {$ENDIF THREADSAFE}
  14645. Index := BinarySearch(Key);
  14646. Result := nil;
  14647. if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then
  14648. Result := FEntries[Index].Value
  14649. else if not FReturnDefaultElements then
  14650. raise EJclNoSuchElementError.Create('');
  14651. {$IFDEF THREADSAFE}
  14652. finally
  14653. if FThreadSafe then
  14654. SyncReaderWriter.EndRead;
  14655. end;
  14656. {$ENDIF THREADSAFE}
  14657. end;
  14658. function TJclIntegerIntfSortedMap.HeadMap(ToKey: Integer): IJclIntegerIntfSortedMap;
  14659. var
  14660. ToIndex: Integer;
  14661. NewMap: TJclIntegerIntfSortedMap;
  14662. begin
  14663. {$IFDEF THREADSAFE}
  14664. if FThreadSafe then
  14665. SyncReaderWriter.BeginRead;
  14666. try
  14667. {$ENDIF THREADSAFE}
  14668. NewMap := CreateEmptyContainer as TJclIntegerIntfSortedMap;
  14669. ToIndex := BinarySearch(ToKey);
  14670. if ToIndex >= 0 then
  14671. begin
  14672. NewMap.SetCapacity(ToIndex + 1);
  14673. NewMap.FSize := ToIndex + 1;
  14674. while ToIndex >= 0 do
  14675. begin
  14676. NewMap.FEntries[ToIndex] := FEntries[ToIndex];
  14677. Dec(ToIndex);
  14678. end;
  14679. end;
  14680. Result := NewMap;
  14681. {$IFDEF THREADSAFE}
  14682. finally
  14683. if FThreadSafe then
  14684. SyncReaderWriter.EndRead;
  14685. end;
  14686. {$ENDIF THREADSAFE}
  14687. end;
  14688. function TJclIntegerIntfSortedMap.IsEmpty: Boolean;
  14689. begin
  14690. {$IFDEF THREADSAFE}
  14691. if FThreadSafe then
  14692. SyncReaderWriter.BeginRead;
  14693. try
  14694. {$ENDIF THREADSAFE}
  14695. Result := FSize = 0;
  14696. {$IFDEF THREADSAFE}
  14697. finally
  14698. if FThreadSafe then
  14699. SyncReaderWriter.EndRead;
  14700. end;
  14701. {$ENDIF THREADSAFE}
  14702. end;
  14703. function TJclIntegerIntfSortedMap.KeyOfValue(const Value: IInterface): Integer;
  14704. var
  14705. Index: Integer;
  14706. Found: Boolean;
  14707. begin
  14708. {$IFDEF THREADSAFE}
  14709. if FThreadSafe then
  14710. SyncReaderWriter.BeginRead;
  14711. try
  14712. {$ENDIF THREADSAFE}
  14713. Found := False;
  14714. Result := 0;
  14715. for Index := 0 to FSize - 1 do
  14716. if ValuesCompare(FEntries[Index].Value, Value) = 0 then
  14717. begin
  14718. Result := FEntries[Index].Key;
  14719. Found := True;
  14720. Break;
  14721. end;
  14722. if (not Found) and (not FReturnDefaultElements) then
  14723. raise EJclNoSuchElementError.Create('');
  14724. {$IFDEF THREADSAFE}
  14725. finally
  14726. if FThreadSafe then
  14727. SyncReaderWriter.EndRead;
  14728. end;
  14729. {$ENDIF THREADSAFE}
  14730. end;
  14731. function TJclIntegerIntfSortedMap.KeySet: IJclIntegerSet;
  14732. var
  14733. Index: Integer;
  14734. begin
  14735. {$IFDEF THREADSAFE}
  14736. if FThreadSafe then
  14737. SyncReaderWriter.BeginRead;
  14738. try
  14739. {$ENDIF THREADSAFE}
  14740. Result := TJclIntegerArraySet.Create(FSize);
  14741. for Index := 0 to FSize - 1 do
  14742. Result.Add(FEntries[Index].Key);
  14743. {$IFDEF THREADSAFE}
  14744. finally
  14745. if FThreadSafe then
  14746. SyncReaderWriter.EndRead;
  14747. end;
  14748. {$ENDIF THREADSAFE}
  14749. end;
  14750. function TJclIntegerIntfSortedMap.LastKey: Integer;
  14751. begin
  14752. {$IFDEF THREADSAFE}
  14753. if FThreadSafe then
  14754. SyncReaderWriter.BeginRead;
  14755. try
  14756. {$ENDIF THREADSAFE}
  14757. Result := 0;
  14758. if FSize > 0 then
  14759. Result := FEntries[FSize - 1].Key
  14760. else
  14761. if not FReturnDefaultElements then
  14762. raise EJclNoSuchElementError.Create('');
  14763. {$IFDEF THREADSAFE}
  14764. finally
  14765. if FThreadSafe then
  14766. SyncReaderWriter.EndRead;
  14767. end;
  14768. {$ENDIF THREADSAFE}
  14769. end;
  14770. function TJclIntegerIntfSortedMap.MapEquals(const AMap: IJclIntegerIntfMap): Boolean;
  14771. var
  14772. It: IJclIntegerIterator;
  14773. Index: Integer;
  14774. AKey: Integer;
  14775. begin
  14776. {$IFDEF THREADSAFE}
  14777. if FThreadSafe then
  14778. SyncReaderWriter.BeginRead;
  14779. try
  14780. {$ENDIF THREADSAFE}
  14781. Result := False;
  14782. if AMap = nil then
  14783. Exit;
  14784. if FSize <> AMap.Size then
  14785. Exit;
  14786. It := AMap.KeySet.First;
  14787. Index := 0;
  14788. while It.HasNext do
  14789. begin
  14790. if Index >= FSize then
  14791. Exit;
  14792. AKey := It.Next;
  14793. if ValuesCompare(AMap.GetValue(AKey), FEntries[Index].Value) <> 0 then
  14794. Exit;
  14795. Inc(Index);
  14796. end;
  14797. Result := True;
  14798. {$IFDEF THREADSAFE}
  14799. finally
  14800. if FThreadSafe then
  14801. SyncReaderWriter.EndRead;
  14802. end;
  14803. {$ENDIF THREADSAFE}
  14804. end;
  14805. procedure TJclIntegerIntfSortedMap.FinalizeArrayBeforeMove(var List: TJclIntegerIntfSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  14806. begin
  14807. Assert(Count > 0);
  14808. if FromIndex < ToIndex then
  14809. begin
  14810. if Count > (ToIndex - FromIndex) then
  14811. Finalize(List[FromIndex + Count], ToIndex - FromIndex)
  14812. else
  14813. Finalize(List[ToIndex], Count);
  14814. end
  14815. else
  14816. if FromIndex > ToIndex then
  14817. begin
  14818. if Count > (FromIndex - ToIndex) then
  14819. Count := FromIndex - ToIndex;
  14820. Finalize(List[ToIndex], Count)
  14821. end;
  14822. end;
  14823. procedure TJclIntegerIntfSortedMap.InitializeArray(var List: TJclIntegerIntfSortedMapEntryArray; FromIndex, Count: SizeInt);
  14824. begin
  14825. {$IFDEF FPC}
  14826. while Count > 0 do
  14827. begin
  14828. Initialize(List[FromIndex]);
  14829. Inc(FromIndex);
  14830. Dec(Count);
  14831. end;
  14832. {$ELSE ~FPC}
  14833. Initialize(List[FromIndex], Count);
  14834. {$ENDIF ~FPC}
  14835. end;
  14836. procedure TJclIntegerIntfSortedMap.InitializeArrayAfterMove(var List: TJclIntegerIntfSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  14837. begin
  14838. { Keep reference counting working }
  14839. if FromIndex < ToIndex then
  14840. begin
  14841. if (ToIndex - FromIndex) < Count then
  14842. Count := ToIndex - FromIndex;
  14843. InitializeArray(List, FromIndex, Count);
  14844. end
  14845. else
  14846. if FromIndex > ToIndex then
  14847. begin
  14848. if (FromIndex - ToIndex) < Count then
  14849. InitializeArray(List, ToIndex + Count, FromIndex - ToIndex)
  14850. else
  14851. InitializeArray(List, FromIndex, Count);
  14852. end;
  14853. end;
  14854. procedure TJclIntegerIntfSortedMap.MoveArray(var List: TJclIntegerIntfSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  14855. begin
  14856. if Count > 0 then
  14857. begin
  14858. FinalizeArrayBeforeMove(List, FromIndex, ToIndex, Count);
  14859. Move(List[FromIndex], List[ToIndex], Count * SizeOf(List[0]));
  14860. InitializeArrayAfterMove(List, FromIndex, ToIndex, Count);
  14861. end;
  14862. end;
  14863. procedure TJclIntegerIntfSortedMap.PutAll(const AMap: IJclIntegerIntfMap);
  14864. var
  14865. It: IJclIntegerIterator;
  14866. Key: Integer;
  14867. begin
  14868. if ReadOnly then
  14869. raise EJclReadOnlyError.Create;
  14870. {$IFDEF THREADSAFE}
  14871. if FThreadSafe then
  14872. SyncReaderWriter.BeginWrite;
  14873. try
  14874. {$ENDIF THREADSAFE}
  14875. if AMap = nil then
  14876. Exit;
  14877. It := AMap.KeySet.First;
  14878. while It.HasNext do
  14879. begin
  14880. Key := It.Next;
  14881. PutValue(Key, AMap.GetValue(Key));
  14882. end;
  14883. {$IFDEF THREADSAFE}
  14884. finally
  14885. if FThreadSafe then
  14886. SyncReaderWriter.EndWrite;
  14887. end;
  14888. {$ENDIF THREADSAFE}
  14889. end;
  14890. procedure TJclIntegerIntfSortedMap.PutValue(Key: Integer; const Value: IInterface);
  14891. var
  14892. Index: Integer;
  14893. begin
  14894. if ReadOnly then
  14895. raise EJclReadOnlyError.Create;
  14896. {$IFDEF THREADSAFE}
  14897. if FThreadSafe then
  14898. SyncReaderWriter.BeginWrite;
  14899. try
  14900. {$ENDIF THREADSAFE}
  14901. if FAllowDefaultElements or ((KeysCompare(Key, 0) <> 0) and (ValuesCompare(Value, nil) <> 0)) then
  14902. begin
  14903. Index := BinarySearch(Key);
  14904. if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then
  14905. begin
  14906. FreeValue(FEntries[Index].Value);
  14907. FEntries[Index].Value := Value;
  14908. end
  14909. else
  14910. begin
  14911. if FSize = FCapacity then
  14912. AutoGrow;
  14913. if FSize < FCapacity then
  14914. begin
  14915. Inc(Index);
  14916. if (Index < FSize) and (KeysCompare(FEntries[Index].Key, Key) <> 0) then
  14917. MoveArray(FEntries, Index, Index + 1, FSize - Index);
  14918. FEntries[Index].Key := Key;
  14919. FEntries[Index].Value := Value;
  14920. Inc(FSize);
  14921. end;
  14922. end;
  14923. end;
  14924. {$IFDEF THREADSAFE}
  14925. finally
  14926. if FThreadSafe then
  14927. SyncReaderWriter.EndWrite;
  14928. end;
  14929. {$ENDIF THREADSAFE}
  14930. end;
  14931. function TJclIntegerIntfSortedMap.Remove(Key: Integer): IInterface;
  14932. begin
  14933. if ReadOnly then
  14934. raise EJclReadOnlyError.Create;
  14935. {$IFDEF THREADSAFE}
  14936. if FThreadSafe then
  14937. SyncReaderWriter.BeginWrite;
  14938. try
  14939. {$ENDIF THREADSAFE}
  14940. Result := Extract(Key);
  14941. Result := FreeValue(Result);
  14942. {$IFDEF THREADSAFE}
  14943. finally
  14944. if FThreadSafe then
  14945. SyncReaderWriter.EndWrite;
  14946. end;
  14947. {$ENDIF THREADSAFE}
  14948. end;
  14949. procedure TJclIntegerIntfSortedMap.SetCapacity(Value: Integer);
  14950. begin
  14951. if ReadOnly then
  14952. raise EJclReadOnlyError.Create;
  14953. {$IFDEF THREADSAFE}
  14954. if FThreadSafe then
  14955. SyncReaderWriter.BeginWrite;
  14956. try
  14957. {$ENDIF THREADSAFE}
  14958. if FSize <= Value then
  14959. begin
  14960. SetLength(FEntries, Value);
  14961. inherited SetCapacity(Value);
  14962. end
  14963. else
  14964. raise EJclOperationNotSupportedError.Create;
  14965. {$IFDEF THREADSAFE}
  14966. finally
  14967. if FThreadSafe then
  14968. SyncReaderWriter.EndWrite;
  14969. end;
  14970. {$ENDIF THREADSAFE}
  14971. end;
  14972. function TJclIntegerIntfSortedMap.Size: Integer;
  14973. begin
  14974. Result := FSize;
  14975. end;
  14976. function TJclIntegerIntfSortedMap.SubMap(FromKey, ToKey: Integer): IJclIntegerIntfSortedMap;
  14977. var
  14978. FromIndex, ToIndex: Integer;
  14979. NewMap: TJclIntegerIntfSortedMap;
  14980. begin
  14981. {$IFDEF THREADSAFE}
  14982. if FThreadSafe then
  14983. SyncReaderWriter.BeginRead;
  14984. try
  14985. {$ENDIF THREADSAFE}
  14986. NewMap := CreateEmptyContainer as TJclIntegerIntfSortedMap;
  14987. FromIndex := BinarySearch(FromKey);
  14988. if (FromIndex = -1) or (KeysCompare(FEntries[FromIndex].Key, FromKey) < 0) then
  14989. Inc(FromIndex);
  14990. ToIndex := BinarySearch(ToKey);
  14991. if (FromIndex >= 0) and (FromIndex <= ToIndex) then
  14992. begin
  14993. NewMap.SetCapacity(ToIndex - FromIndex + 1);
  14994. NewMap.FSize := ToIndex - FromIndex + 1;
  14995. while ToIndex >= FromIndex do
  14996. begin
  14997. NewMap.FEntries[ToIndex - FromIndex] := FEntries[ToIndex];
  14998. Dec(ToIndex);
  14999. end;
  15000. end;
  15001. Result := NewMap;
  15002. {$IFDEF THREADSAFE}
  15003. finally
  15004. if FThreadSafe then
  15005. SyncReaderWriter.EndRead;
  15006. end;
  15007. {$ENDIF THREADSAFE}
  15008. end;
  15009. function TJclIntegerIntfSortedMap.TailMap(FromKey: Integer): IJclIntegerIntfSortedMap;
  15010. var
  15011. FromIndex, Index: Integer;
  15012. NewMap: TJclIntegerIntfSortedMap;
  15013. begin
  15014. {$IFDEF THREADSAFE}
  15015. if FThreadSafe then
  15016. SyncReaderWriter.BeginRead;
  15017. try
  15018. {$ENDIF THREADSAFE}
  15019. NewMap := CreateEmptyContainer as TJclIntegerIntfSortedMap;
  15020. FromIndex := BinarySearch(FromKey);
  15021. if (FromIndex = -1) or (KeysCompare(FEntries[FromIndex].Key, FromKey) < 0) then
  15022. Inc(FromIndex);
  15023. if (FromIndex >= 0) and (FromIndex < FSize) then
  15024. begin
  15025. NewMap.SetCapacity(FSize - FromIndex);
  15026. NewMap.FSize := FSize - FromIndex;
  15027. Index := FromIndex;
  15028. while Index < FSize do
  15029. begin
  15030. NewMap.FEntries[Index - FromIndex] := FEntries[Index];
  15031. Inc(Index);
  15032. end;
  15033. end;
  15034. Result := NewMap;
  15035. {$IFDEF THREADSAFE}
  15036. finally
  15037. if FThreadSafe then
  15038. SyncReaderWriter.EndRead;
  15039. end;
  15040. {$ENDIF THREADSAFE}
  15041. end;
  15042. function TJclIntegerIntfSortedMap.Values: IJclIntfCollection;
  15043. var
  15044. Index: Integer;
  15045. begin
  15046. {$IFDEF THREADSAFE}
  15047. if FThreadSafe then
  15048. SyncReaderWriter.BeginRead;
  15049. try
  15050. {$ENDIF THREADSAFE}
  15051. Result := TJclIntfArrayList.Create(FSize);
  15052. for Index := 0 to FSize - 1 do
  15053. Result.Add(FEntries[Index].Value);
  15054. {$IFDEF THREADSAFE}
  15055. finally
  15056. if FThreadSafe then
  15057. SyncReaderWriter.EndRead;
  15058. end;
  15059. {$ENDIF THREADSAFE}
  15060. end;
  15061. function TJclIntegerIntfSortedMap.CreateEmptyContainer: TJclAbstractContainerBase;
  15062. begin
  15063. Result := TJclIntegerIntfSortedMap.Create(FSize);
  15064. AssignPropertiesTo(Result);
  15065. end;
  15066. function TJclIntegerIntfSortedMap.FreeKey(var Key: Integer): Integer;
  15067. begin
  15068. Result := Key;
  15069. Key := 0;
  15070. end;
  15071. function TJclIntegerIntfSortedMap.FreeValue(var Value: IInterface): IInterface;
  15072. begin
  15073. Result := Value;
  15074. Value := nil;
  15075. end;
  15076. function TJclIntegerIntfSortedMap.KeysCompare(A, B: Integer): Integer;
  15077. begin
  15078. Result := ItemsCompare(A, B);
  15079. end;
  15080. function TJclIntegerIntfSortedMap.ValuesCompare(const A, B: IInterface): Integer;
  15081. begin
  15082. Result := IntfSimpleCompare(A, B);
  15083. end;
  15084. //=== { TJclIntfIntegerSortedMap } ==============================================
  15085. constructor TJclIntfIntegerSortedMap.Create(ACapacity: Integer);
  15086. begin
  15087. inherited Create();
  15088. SetCapacity(ACapacity);
  15089. end;
  15090. destructor TJclIntfIntegerSortedMap.Destroy;
  15091. begin
  15092. FReadOnly := False;
  15093. Clear;
  15094. inherited Destroy;
  15095. end;
  15096. procedure TJclIntfIntegerSortedMap.AssignDataTo(Dest: TJclAbstractContainerBase);
  15097. var
  15098. MyDest: TJclIntfIntegerSortedMap;
  15099. begin
  15100. inherited AssignDataTo(Dest);
  15101. if Dest is TJclIntfIntegerSortedMap then
  15102. begin
  15103. MyDest := TJclIntfIntegerSortedMap(Dest);
  15104. MyDest.SetCapacity(FSize);
  15105. MyDest.FEntries := FEntries;
  15106. MyDest.FSize := FSize;
  15107. end;
  15108. end;
  15109. function TJclIntfIntegerSortedMap.BinarySearch(const Key: IInterface): Integer;
  15110. var
  15111. HiPos, LoPos, CompPos: Integer;
  15112. Comp: Integer;
  15113. begin
  15114. {$IFDEF THREADSAFE}
  15115. if FThreadSafe then
  15116. SyncReaderWriter.BeginRead;
  15117. try
  15118. {$ENDIF THREADSAFE}
  15119. LoPos := 0;
  15120. HiPos := FSize - 1;
  15121. CompPos := (HiPos + LoPos) div 2;
  15122. while HiPos >= LoPos do
  15123. begin
  15124. Comp := KeysCompare(FEntries[CompPos].Key, Key);
  15125. if Comp < 0 then
  15126. LoPos := CompPos + 1
  15127. else
  15128. if Comp > 0 then
  15129. HiPos := CompPos - 1
  15130. else
  15131. begin
  15132. HiPos := CompPos;
  15133. LoPos := CompPos + 1;
  15134. end;
  15135. CompPos := (HiPos + LoPos) div 2;
  15136. end;
  15137. Result := HiPos;
  15138. {$IFDEF THREADSAFE}
  15139. finally
  15140. if FThreadSafe then
  15141. SyncReaderWriter.EndRead;
  15142. end;
  15143. {$ENDIF THREADSAFE}
  15144. end;
  15145. procedure TJclIntfIntegerSortedMap.Clear;
  15146. var
  15147. Index: Integer;
  15148. begin
  15149. if ReadOnly then
  15150. raise EJclReadOnlyError.Create;
  15151. {$IFDEF THREADSAFE}
  15152. if FThreadSafe then
  15153. SyncReaderWriter.BeginWrite;
  15154. try
  15155. {$ENDIF THREADSAFE}
  15156. for Index := 0 to FSize - 1 do
  15157. begin
  15158. FreeKey(FEntries[Index].Key);
  15159. FreeValue(FEntries[Index].Value);
  15160. end;
  15161. FSize := 0;
  15162. AutoPack;
  15163. {$IFDEF THREADSAFE}
  15164. finally
  15165. if FThreadSafe then
  15166. SyncReaderWriter.EndWrite;
  15167. end;
  15168. {$ENDIF THREADSAFE}
  15169. end;
  15170. function TJclIntfIntegerSortedMap.ContainsKey(const Key: IInterface): Boolean;
  15171. var
  15172. Index: Integer;
  15173. begin
  15174. {$IFDEF THREADSAFE}
  15175. if FThreadSafe then
  15176. SyncReaderWriter.BeginRead;
  15177. try
  15178. {$ENDIF THREADSAFE}
  15179. Index := BinarySearch(Key);
  15180. Result := (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0);
  15181. {$IFDEF THREADSAFE}
  15182. finally
  15183. if FThreadSafe then
  15184. SyncReaderWriter.EndRead;
  15185. end;
  15186. {$ENDIF THREADSAFE}
  15187. end;
  15188. function TJclIntfIntegerSortedMap.ContainsValue(Value: Integer): Boolean;
  15189. var
  15190. Index: Integer;
  15191. begin
  15192. {$IFDEF THREADSAFE}
  15193. if FThreadSafe then
  15194. SyncReaderWriter.BeginRead;
  15195. try
  15196. {$ENDIF THREADSAFE}
  15197. Result := False;
  15198. for Index := 0 to FSize - 1 do
  15199. if ValuesCompare(FEntries[Index].Value, Value) = 0 then
  15200. begin
  15201. Result := True;
  15202. Break;
  15203. end;
  15204. {$IFDEF THREADSAFE}
  15205. finally
  15206. if FThreadSafe then
  15207. SyncReaderWriter.EndRead;
  15208. end;
  15209. {$ENDIF THREADSAFE}
  15210. end;
  15211. function TJclIntfIntegerSortedMap.FirstKey: IInterface;
  15212. begin
  15213. {$IFDEF THREADSAFE}
  15214. if FThreadSafe then
  15215. SyncReaderWriter.BeginRead;
  15216. try
  15217. {$ENDIF THREADSAFE}
  15218. Result := nil;
  15219. if FSize > 0 then
  15220. Result := FEntries[0].Key
  15221. else
  15222. if not FReturnDefaultElements then
  15223. raise EJclNoSuchElementError.Create('');
  15224. {$IFDEF THREADSAFE}
  15225. finally
  15226. if FThreadSafe then
  15227. SyncReaderWriter.EndRead;
  15228. end;
  15229. {$ENDIF THREADSAFE}
  15230. end;
  15231. function TJclIntfIntegerSortedMap.Extract(const Key: IInterface): Integer;
  15232. var
  15233. Index: Integer;
  15234. begin
  15235. if ReadOnly then
  15236. raise EJclReadOnlyError.Create;
  15237. {$IFDEF THREADSAFE}
  15238. if FThreadSafe then
  15239. SyncReaderWriter.BeginWrite;
  15240. try
  15241. {$ENDIF THREADSAFE}
  15242. Index := BinarySearch(Key);
  15243. if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then
  15244. begin
  15245. Result := FEntries[Index].Value;
  15246. FEntries[Index].Value := 0;
  15247. FreeKey(FEntries[Index].Key);
  15248. if Index < (FSize - 1) then
  15249. MoveArray(FEntries, Index + 1, Index, FSize - Index - 1);
  15250. Dec(FSize);
  15251. AutoPack;
  15252. end
  15253. else
  15254. Result := 0;
  15255. {$IFDEF THREADSAFE}
  15256. finally
  15257. if FThreadSafe then
  15258. SyncReaderWriter.EndWrite;
  15259. end;
  15260. {$ENDIF THREADSAFE}
  15261. end;
  15262. function TJclIntfIntegerSortedMap.GetValue(const Key: IInterface): Integer;
  15263. var
  15264. Index: Integer;
  15265. begin
  15266. {$IFDEF THREADSAFE}
  15267. if FThreadSafe then
  15268. SyncReaderWriter.BeginRead;
  15269. try
  15270. {$ENDIF THREADSAFE}
  15271. Index := BinarySearch(Key);
  15272. Result := 0;
  15273. if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then
  15274. Result := FEntries[Index].Value
  15275. else if not FReturnDefaultElements then
  15276. raise EJclNoSuchElementError.Create('');
  15277. {$IFDEF THREADSAFE}
  15278. finally
  15279. if FThreadSafe then
  15280. SyncReaderWriter.EndRead;
  15281. end;
  15282. {$ENDIF THREADSAFE}
  15283. end;
  15284. function TJclIntfIntegerSortedMap.HeadMap(const ToKey: IInterface): IJclIntfIntegerSortedMap;
  15285. var
  15286. ToIndex: Integer;
  15287. NewMap: TJclIntfIntegerSortedMap;
  15288. begin
  15289. {$IFDEF THREADSAFE}
  15290. if FThreadSafe then
  15291. SyncReaderWriter.BeginRead;
  15292. try
  15293. {$ENDIF THREADSAFE}
  15294. NewMap := CreateEmptyContainer as TJclIntfIntegerSortedMap;
  15295. ToIndex := BinarySearch(ToKey);
  15296. if ToIndex >= 0 then
  15297. begin
  15298. NewMap.SetCapacity(ToIndex + 1);
  15299. NewMap.FSize := ToIndex + 1;
  15300. while ToIndex >= 0 do
  15301. begin
  15302. NewMap.FEntries[ToIndex] := FEntries[ToIndex];
  15303. Dec(ToIndex);
  15304. end;
  15305. end;
  15306. Result := NewMap;
  15307. {$IFDEF THREADSAFE}
  15308. finally
  15309. if FThreadSafe then
  15310. SyncReaderWriter.EndRead;
  15311. end;
  15312. {$ENDIF THREADSAFE}
  15313. end;
  15314. function TJclIntfIntegerSortedMap.IsEmpty: Boolean;
  15315. begin
  15316. {$IFDEF THREADSAFE}
  15317. if FThreadSafe then
  15318. SyncReaderWriter.BeginRead;
  15319. try
  15320. {$ENDIF THREADSAFE}
  15321. Result := FSize = 0;
  15322. {$IFDEF THREADSAFE}
  15323. finally
  15324. if FThreadSafe then
  15325. SyncReaderWriter.EndRead;
  15326. end;
  15327. {$ENDIF THREADSAFE}
  15328. end;
  15329. function TJclIntfIntegerSortedMap.KeyOfValue(Value: Integer): IInterface;
  15330. var
  15331. Index: Integer;
  15332. Found: Boolean;
  15333. begin
  15334. {$IFDEF THREADSAFE}
  15335. if FThreadSafe then
  15336. SyncReaderWriter.BeginRead;
  15337. try
  15338. {$ENDIF THREADSAFE}
  15339. Found := False;
  15340. Result := nil;
  15341. for Index := 0 to FSize - 1 do
  15342. if ValuesCompare(FEntries[Index].Value, Value) = 0 then
  15343. begin
  15344. Result := FEntries[Index].Key;
  15345. Found := True;
  15346. Break;
  15347. end;
  15348. if (not Found) and (not FReturnDefaultElements) then
  15349. raise EJclNoSuchElementError.Create('');
  15350. {$IFDEF THREADSAFE}
  15351. finally
  15352. if FThreadSafe then
  15353. SyncReaderWriter.EndRead;
  15354. end;
  15355. {$ENDIF THREADSAFE}
  15356. end;
  15357. function TJclIntfIntegerSortedMap.KeySet: IJclIntfSet;
  15358. var
  15359. Index: Integer;
  15360. begin
  15361. {$IFDEF THREADSAFE}
  15362. if FThreadSafe then
  15363. SyncReaderWriter.BeginRead;
  15364. try
  15365. {$ENDIF THREADSAFE}
  15366. Result := TJclIntfArraySet.Create(FSize);
  15367. for Index := 0 to FSize - 1 do
  15368. Result.Add(FEntries[Index].Key);
  15369. {$IFDEF THREADSAFE}
  15370. finally
  15371. if FThreadSafe then
  15372. SyncReaderWriter.EndRead;
  15373. end;
  15374. {$ENDIF THREADSAFE}
  15375. end;
  15376. function TJclIntfIntegerSortedMap.LastKey: IInterface;
  15377. begin
  15378. {$IFDEF THREADSAFE}
  15379. if FThreadSafe then
  15380. SyncReaderWriter.BeginRead;
  15381. try
  15382. {$ENDIF THREADSAFE}
  15383. Result := nil;
  15384. if FSize > 0 then
  15385. Result := FEntries[FSize - 1].Key
  15386. else
  15387. if not FReturnDefaultElements then
  15388. raise EJclNoSuchElementError.Create('');
  15389. {$IFDEF THREADSAFE}
  15390. finally
  15391. if FThreadSafe then
  15392. SyncReaderWriter.EndRead;
  15393. end;
  15394. {$ENDIF THREADSAFE}
  15395. end;
  15396. function TJclIntfIntegerSortedMap.MapEquals(const AMap: IJclIntfIntegerMap): Boolean;
  15397. var
  15398. It: IJclIntfIterator;
  15399. Index: Integer;
  15400. AKey: IInterface;
  15401. begin
  15402. {$IFDEF THREADSAFE}
  15403. if FThreadSafe then
  15404. SyncReaderWriter.BeginRead;
  15405. try
  15406. {$ENDIF THREADSAFE}
  15407. Result := False;
  15408. if AMap = nil then
  15409. Exit;
  15410. if FSize <> AMap.Size then
  15411. Exit;
  15412. It := AMap.KeySet.First;
  15413. Index := 0;
  15414. while It.HasNext do
  15415. begin
  15416. if Index >= FSize then
  15417. Exit;
  15418. AKey := It.Next;
  15419. if ValuesCompare(AMap.GetValue(AKey), FEntries[Index].Value) <> 0 then
  15420. Exit;
  15421. Inc(Index);
  15422. end;
  15423. Result := True;
  15424. {$IFDEF THREADSAFE}
  15425. finally
  15426. if FThreadSafe then
  15427. SyncReaderWriter.EndRead;
  15428. end;
  15429. {$ENDIF THREADSAFE}
  15430. end;
  15431. procedure TJclIntfIntegerSortedMap.FinalizeArrayBeforeMove(var List: TJclIntfIntegerSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  15432. begin
  15433. Assert(Count > 0);
  15434. if FromIndex < ToIndex then
  15435. begin
  15436. if Count > (ToIndex - FromIndex) then
  15437. Finalize(List[FromIndex + Count], ToIndex - FromIndex)
  15438. else
  15439. Finalize(List[ToIndex], Count);
  15440. end
  15441. else
  15442. if FromIndex > ToIndex then
  15443. begin
  15444. if Count > (FromIndex - ToIndex) then
  15445. Count := FromIndex - ToIndex;
  15446. Finalize(List[ToIndex], Count)
  15447. end;
  15448. end;
  15449. procedure TJclIntfIntegerSortedMap.InitializeArray(var List: TJclIntfIntegerSortedMapEntryArray; FromIndex, Count: SizeInt);
  15450. begin
  15451. {$IFDEF FPC}
  15452. while Count > 0 do
  15453. begin
  15454. Initialize(List[FromIndex]);
  15455. Inc(FromIndex);
  15456. Dec(Count);
  15457. end;
  15458. {$ELSE ~FPC}
  15459. Initialize(List[FromIndex], Count);
  15460. {$ENDIF ~FPC}
  15461. end;
  15462. procedure TJclIntfIntegerSortedMap.InitializeArrayAfterMove(var List: TJclIntfIntegerSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  15463. begin
  15464. { Keep reference counting working }
  15465. if FromIndex < ToIndex then
  15466. begin
  15467. if (ToIndex - FromIndex) < Count then
  15468. Count := ToIndex - FromIndex;
  15469. InitializeArray(List, FromIndex, Count);
  15470. end
  15471. else
  15472. if FromIndex > ToIndex then
  15473. begin
  15474. if (FromIndex - ToIndex) < Count then
  15475. InitializeArray(List, ToIndex + Count, FromIndex - ToIndex)
  15476. else
  15477. InitializeArray(List, FromIndex, Count);
  15478. end;
  15479. end;
  15480. procedure TJclIntfIntegerSortedMap.MoveArray(var List: TJclIntfIntegerSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  15481. begin
  15482. if Count > 0 then
  15483. begin
  15484. FinalizeArrayBeforeMove(List, FromIndex, ToIndex, Count);
  15485. Move(List[FromIndex], List[ToIndex], Count * SizeOf(List[0]));
  15486. InitializeArrayAfterMove(List, FromIndex, ToIndex, Count);
  15487. end;
  15488. end;
  15489. procedure TJclIntfIntegerSortedMap.PutAll(const AMap: IJclIntfIntegerMap);
  15490. var
  15491. It: IJclIntfIterator;
  15492. Key: IInterface;
  15493. begin
  15494. if ReadOnly then
  15495. raise EJclReadOnlyError.Create;
  15496. {$IFDEF THREADSAFE}
  15497. if FThreadSafe then
  15498. SyncReaderWriter.BeginWrite;
  15499. try
  15500. {$ENDIF THREADSAFE}
  15501. if AMap = nil then
  15502. Exit;
  15503. It := AMap.KeySet.First;
  15504. while It.HasNext do
  15505. begin
  15506. Key := It.Next;
  15507. PutValue(Key, AMap.GetValue(Key));
  15508. end;
  15509. {$IFDEF THREADSAFE}
  15510. finally
  15511. if FThreadSafe then
  15512. SyncReaderWriter.EndWrite;
  15513. end;
  15514. {$ENDIF THREADSAFE}
  15515. end;
  15516. procedure TJclIntfIntegerSortedMap.PutValue(const Key: IInterface; Value: Integer);
  15517. var
  15518. Index: Integer;
  15519. begin
  15520. if ReadOnly then
  15521. raise EJclReadOnlyError.Create;
  15522. {$IFDEF THREADSAFE}
  15523. if FThreadSafe then
  15524. SyncReaderWriter.BeginWrite;
  15525. try
  15526. {$ENDIF THREADSAFE}
  15527. if FAllowDefaultElements or ((KeysCompare(Key, nil) <> 0) and (ValuesCompare(Value, 0) <> 0)) then
  15528. begin
  15529. Index := BinarySearch(Key);
  15530. if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then
  15531. begin
  15532. FreeValue(FEntries[Index].Value);
  15533. FEntries[Index].Value := Value;
  15534. end
  15535. else
  15536. begin
  15537. if FSize = FCapacity then
  15538. AutoGrow;
  15539. if FSize < FCapacity then
  15540. begin
  15541. Inc(Index);
  15542. if (Index < FSize) and (KeysCompare(FEntries[Index].Key, Key) <> 0) then
  15543. MoveArray(FEntries, Index, Index + 1, FSize - Index);
  15544. FEntries[Index].Key := Key;
  15545. FEntries[Index].Value := Value;
  15546. Inc(FSize);
  15547. end;
  15548. end;
  15549. end;
  15550. {$IFDEF THREADSAFE}
  15551. finally
  15552. if FThreadSafe then
  15553. SyncReaderWriter.EndWrite;
  15554. end;
  15555. {$ENDIF THREADSAFE}
  15556. end;
  15557. function TJclIntfIntegerSortedMap.Remove(const Key: IInterface): Integer;
  15558. begin
  15559. if ReadOnly then
  15560. raise EJclReadOnlyError.Create;
  15561. {$IFDEF THREADSAFE}
  15562. if FThreadSafe then
  15563. SyncReaderWriter.BeginWrite;
  15564. try
  15565. {$ENDIF THREADSAFE}
  15566. Result := Extract(Key);
  15567. Result := FreeValue(Result);
  15568. {$IFDEF THREADSAFE}
  15569. finally
  15570. if FThreadSafe then
  15571. SyncReaderWriter.EndWrite;
  15572. end;
  15573. {$ENDIF THREADSAFE}
  15574. end;
  15575. procedure TJclIntfIntegerSortedMap.SetCapacity(Value: Integer);
  15576. begin
  15577. if ReadOnly then
  15578. raise EJclReadOnlyError.Create;
  15579. {$IFDEF THREADSAFE}
  15580. if FThreadSafe then
  15581. SyncReaderWriter.BeginWrite;
  15582. try
  15583. {$ENDIF THREADSAFE}
  15584. if FSize <= Value then
  15585. begin
  15586. SetLength(FEntries, Value);
  15587. inherited SetCapacity(Value);
  15588. end
  15589. else
  15590. raise EJclOperationNotSupportedError.Create;
  15591. {$IFDEF THREADSAFE}
  15592. finally
  15593. if FThreadSafe then
  15594. SyncReaderWriter.EndWrite;
  15595. end;
  15596. {$ENDIF THREADSAFE}
  15597. end;
  15598. function TJclIntfIntegerSortedMap.Size: Integer;
  15599. begin
  15600. Result := FSize;
  15601. end;
  15602. function TJclIntfIntegerSortedMap.SubMap(const FromKey, ToKey: IInterface): IJclIntfIntegerSortedMap;
  15603. var
  15604. FromIndex, ToIndex: Integer;
  15605. NewMap: TJclIntfIntegerSortedMap;
  15606. begin
  15607. {$IFDEF THREADSAFE}
  15608. if FThreadSafe then
  15609. SyncReaderWriter.BeginRead;
  15610. try
  15611. {$ENDIF THREADSAFE}
  15612. NewMap := CreateEmptyContainer as TJclIntfIntegerSortedMap;
  15613. FromIndex := BinarySearch(FromKey);
  15614. if (FromIndex = -1) or (KeysCompare(FEntries[FromIndex].Key, FromKey) < 0) then
  15615. Inc(FromIndex);
  15616. ToIndex := BinarySearch(ToKey);
  15617. if (FromIndex >= 0) and (FromIndex <= ToIndex) then
  15618. begin
  15619. NewMap.SetCapacity(ToIndex - FromIndex + 1);
  15620. NewMap.FSize := ToIndex - FromIndex + 1;
  15621. while ToIndex >= FromIndex do
  15622. begin
  15623. NewMap.FEntries[ToIndex - FromIndex] := FEntries[ToIndex];
  15624. Dec(ToIndex);
  15625. end;
  15626. end;
  15627. Result := NewMap;
  15628. {$IFDEF THREADSAFE}
  15629. finally
  15630. if FThreadSafe then
  15631. SyncReaderWriter.EndRead;
  15632. end;
  15633. {$ENDIF THREADSAFE}
  15634. end;
  15635. function TJclIntfIntegerSortedMap.TailMap(const FromKey: IInterface): IJclIntfIntegerSortedMap;
  15636. var
  15637. FromIndex, Index: Integer;
  15638. NewMap: TJclIntfIntegerSortedMap;
  15639. begin
  15640. {$IFDEF THREADSAFE}
  15641. if FThreadSafe then
  15642. SyncReaderWriter.BeginRead;
  15643. try
  15644. {$ENDIF THREADSAFE}
  15645. NewMap := CreateEmptyContainer as TJclIntfIntegerSortedMap;
  15646. FromIndex := BinarySearch(FromKey);
  15647. if (FromIndex = -1) or (KeysCompare(FEntries[FromIndex].Key, FromKey) < 0) then
  15648. Inc(FromIndex);
  15649. if (FromIndex >= 0) and (FromIndex < FSize) then
  15650. begin
  15651. NewMap.SetCapacity(FSize - FromIndex);
  15652. NewMap.FSize := FSize - FromIndex;
  15653. Index := FromIndex;
  15654. while Index < FSize do
  15655. begin
  15656. NewMap.FEntries[Index - FromIndex] := FEntries[Index];
  15657. Inc(Index);
  15658. end;
  15659. end;
  15660. Result := NewMap;
  15661. {$IFDEF THREADSAFE}
  15662. finally
  15663. if FThreadSafe then
  15664. SyncReaderWriter.EndRead;
  15665. end;
  15666. {$ENDIF THREADSAFE}
  15667. end;
  15668. function TJclIntfIntegerSortedMap.Values: IJclIntegerCollection;
  15669. var
  15670. Index: Integer;
  15671. begin
  15672. {$IFDEF THREADSAFE}
  15673. if FThreadSafe then
  15674. SyncReaderWriter.BeginRead;
  15675. try
  15676. {$ENDIF THREADSAFE}
  15677. Result := TJclIntegerArrayList.Create(FSize);
  15678. for Index := 0 to FSize - 1 do
  15679. Result.Add(FEntries[Index].Value);
  15680. {$IFDEF THREADSAFE}
  15681. finally
  15682. if FThreadSafe then
  15683. SyncReaderWriter.EndRead;
  15684. end;
  15685. {$ENDIF THREADSAFE}
  15686. end;
  15687. function TJclIntfIntegerSortedMap.CreateEmptyContainer: TJclAbstractContainerBase;
  15688. begin
  15689. Result := TJclIntfIntegerSortedMap.Create(FSize);
  15690. AssignPropertiesTo(Result);
  15691. end;
  15692. function TJclIntfIntegerSortedMap.FreeKey(var Key: IInterface): IInterface;
  15693. begin
  15694. Result := Key;
  15695. Key := nil;
  15696. end;
  15697. function TJclIntfIntegerSortedMap.FreeValue(var Value: Integer): Integer;
  15698. begin
  15699. Result := Value;
  15700. Value := 0;
  15701. end;
  15702. function TJclIntfIntegerSortedMap.KeysCompare(const A, B: IInterface): Integer;
  15703. begin
  15704. Result := IntfSimpleCompare(A, B);
  15705. end;
  15706. function TJclIntfIntegerSortedMap.ValuesCompare(A, B: Integer): Integer;
  15707. begin
  15708. Result := ItemsCompare(A, B);
  15709. end;
  15710. //=== { TJclIntegerIntegerSortedMap } ==============================================
  15711. constructor TJclIntegerIntegerSortedMap.Create(ACapacity: Integer);
  15712. begin
  15713. inherited Create();
  15714. SetCapacity(ACapacity);
  15715. end;
  15716. destructor TJclIntegerIntegerSortedMap.Destroy;
  15717. begin
  15718. FReadOnly := False;
  15719. Clear;
  15720. inherited Destroy;
  15721. end;
  15722. procedure TJclIntegerIntegerSortedMap.AssignDataTo(Dest: TJclAbstractContainerBase);
  15723. var
  15724. MyDest: TJclIntegerIntegerSortedMap;
  15725. begin
  15726. inherited AssignDataTo(Dest);
  15727. if Dest is TJclIntegerIntegerSortedMap then
  15728. begin
  15729. MyDest := TJclIntegerIntegerSortedMap(Dest);
  15730. MyDest.SetCapacity(FSize);
  15731. MyDest.FEntries := FEntries;
  15732. MyDest.FSize := FSize;
  15733. end;
  15734. end;
  15735. function TJclIntegerIntegerSortedMap.BinarySearch(Key: Integer): Integer;
  15736. var
  15737. HiPos, LoPos, CompPos: Integer;
  15738. Comp: Integer;
  15739. begin
  15740. {$IFDEF THREADSAFE}
  15741. if FThreadSafe then
  15742. SyncReaderWriter.BeginRead;
  15743. try
  15744. {$ENDIF THREADSAFE}
  15745. LoPos := 0;
  15746. HiPos := FSize - 1;
  15747. CompPos := (HiPos + LoPos) div 2;
  15748. while HiPos >= LoPos do
  15749. begin
  15750. Comp := KeysCompare(FEntries[CompPos].Key, Key);
  15751. if Comp < 0 then
  15752. LoPos := CompPos + 1
  15753. else
  15754. if Comp > 0 then
  15755. HiPos := CompPos - 1
  15756. else
  15757. begin
  15758. HiPos := CompPos;
  15759. LoPos := CompPos + 1;
  15760. end;
  15761. CompPos := (HiPos + LoPos) div 2;
  15762. end;
  15763. Result := HiPos;
  15764. {$IFDEF THREADSAFE}
  15765. finally
  15766. if FThreadSafe then
  15767. SyncReaderWriter.EndRead;
  15768. end;
  15769. {$ENDIF THREADSAFE}
  15770. end;
  15771. procedure TJclIntegerIntegerSortedMap.Clear;
  15772. var
  15773. Index: Integer;
  15774. begin
  15775. if ReadOnly then
  15776. raise EJclReadOnlyError.Create;
  15777. {$IFDEF THREADSAFE}
  15778. if FThreadSafe then
  15779. SyncReaderWriter.BeginWrite;
  15780. try
  15781. {$ENDIF THREADSAFE}
  15782. for Index := 0 to FSize - 1 do
  15783. begin
  15784. FreeKey(FEntries[Index].Key);
  15785. FreeValue(FEntries[Index].Value);
  15786. end;
  15787. FSize := 0;
  15788. AutoPack;
  15789. {$IFDEF THREADSAFE}
  15790. finally
  15791. if FThreadSafe then
  15792. SyncReaderWriter.EndWrite;
  15793. end;
  15794. {$ENDIF THREADSAFE}
  15795. end;
  15796. function TJclIntegerIntegerSortedMap.ContainsKey(Key: Integer): Boolean;
  15797. var
  15798. Index: Integer;
  15799. begin
  15800. {$IFDEF THREADSAFE}
  15801. if FThreadSafe then
  15802. SyncReaderWriter.BeginRead;
  15803. try
  15804. {$ENDIF THREADSAFE}
  15805. Index := BinarySearch(Key);
  15806. Result := (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0);
  15807. {$IFDEF THREADSAFE}
  15808. finally
  15809. if FThreadSafe then
  15810. SyncReaderWriter.EndRead;
  15811. end;
  15812. {$ENDIF THREADSAFE}
  15813. end;
  15814. function TJclIntegerIntegerSortedMap.ContainsValue(Value: Integer): Boolean;
  15815. var
  15816. Index: Integer;
  15817. begin
  15818. {$IFDEF THREADSAFE}
  15819. if FThreadSafe then
  15820. SyncReaderWriter.BeginRead;
  15821. try
  15822. {$ENDIF THREADSAFE}
  15823. Result := False;
  15824. for Index := 0 to FSize - 1 do
  15825. if ValuesCompare(FEntries[Index].Value, Value) = 0 then
  15826. begin
  15827. Result := True;
  15828. Break;
  15829. end;
  15830. {$IFDEF THREADSAFE}
  15831. finally
  15832. if FThreadSafe then
  15833. SyncReaderWriter.EndRead;
  15834. end;
  15835. {$ENDIF THREADSAFE}
  15836. end;
  15837. function TJclIntegerIntegerSortedMap.FirstKey: Integer;
  15838. begin
  15839. {$IFDEF THREADSAFE}
  15840. if FThreadSafe then
  15841. SyncReaderWriter.BeginRead;
  15842. try
  15843. {$ENDIF THREADSAFE}
  15844. Result := 0;
  15845. if FSize > 0 then
  15846. Result := FEntries[0].Key
  15847. else
  15848. if not FReturnDefaultElements then
  15849. raise EJclNoSuchElementError.Create('');
  15850. {$IFDEF THREADSAFE}
  15851. finally
  15852. if FThreadSafe then
  15853. SyncReaderWriter.EndRead;
  15854. end;
  15855. {$ENDIF THREADSAFE}
  15856. end;
  15857. function TJclIntegerIntegerSortedMap.Extract(Key: Integer): Integer;
  15858. var
  15859. Index: Integer;
  15860. begin
  15861. if ReadOnly then
  15862. raise EJclReadOnlyError.Create;
  15863. {$IFDEF THREADSAFE}
  15864. if FThreadSafe then
  15865. SyncReaderWriter.BeginWrite;
  15866. try
  15867. {$ENDIF THREADSAFE}
  15868. Index := BinarySearch(Key);
  15869. if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then
  15870. begin
  15871. Result := FEntries[Index].Value;
  15872. FEntries[Index].Value := 0;
  15873. FreeKey(FEntries[Index].Key);
  15874. if Index < (FSize - 1) then
  15875. MoveArray(FEntries, Index + 1, Index, FSize - Index - 1);
  15876. Dec(FSize);
  15877. AutoPack;
  15878. end
  15879. else
  15880. Result := 0;
  15881. {$IFDEF THREADSAFE}
  15882. finally
  15883. if FThreadSafe then
  15884. SyncReaderWriter.EndWrite;
  15885. end;
  15886. {$ENDIF THREADSAFE}
  15887. end;
  15888. function TJclIntegerIntegerSortedMap.GetValue(Key: Integer): Integer;
  15889. var
  15890. Index: Integer;
  15891. begin
  15892. {$IFDEF THREADSAFE}
  15893. if FThreadSafe then
  15894. SyncReaderWriter.BeginRead;
  15895. try
  15896. {$ENDIF THREADSAFE}
  15897. Index := BinarySearch(Key);
  15898. Result := 0;
  15899. if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then
  15900. Result := FEntries[Index].Value
  15901. else if not FReturnDefaultElements then
  15902. raise EJclNoSuchElementError.Create('');
  15903. {$IFDEF THREADSAFE}
  15904. finally
  15905. if FThreadSafe then
  15906. SyncReaderWriter.EndRead;
  15907. end;
  15908. {$ENDIF THREADSAFE}
  15909. end;
  15910. function TJclIntegerIntegerSortedMap.HeadMap(ToKey: Integer): IJclIntegerIntegerSortedMap;
  15911. var
  15912. ToIndex: Integer;
  15913. NewMap: TJclIntegerIntegerSortedMap;
  15914. begin
  15915. {$IFDEF THREADSAFE}
  15916. if FThreadSafe then
  15917. SyncReaderWriter.BeginRead;
  15918. try
  15919. {$ENDIF THREADSAFE}
  15920. NewMap := CreateEmptyContainer as TJclIntegerIntegerSortedMap;
  15921. ToIndex := BinarySearch(ToKey);
  15922. if ToIndex >= 0 then
  15923. begin
  15924. NewMap.SetCapacity(ToIndex + 1);
  15925. NewMap.FSize := ToIndex + 1;
  15926. while ToIndex >= 0 do
  15927. begin
  15928. NewMap.FEntries[ToIndex] := FEntries[ToIndex];
  15929. Dec(ToIndex);
  15930. end;
  15931. end;
  15932. Result := NewMap;
  15933. {$IFDEF THREADSAFE}
  15934. finally
  15935. if FThreadSafe then
  15936. SyncReaderWriter.EndRead;
  15937. end;
  15938. {$ENDIF THREADSAFE}
  15939. end;
  15940. function TJclIntegerIntegerSortedMap.IsEmpty: Boolean;
  15941. begin
  15942. {$IFDEF THREADSAFE}
  15943. if FThreadSafe then
  15944. SyncReaderWriter.BeginRead;
  15945. try
  15946. {$ENDIF THREADSAFE}
  15947. Result := FSize = 0;
  15948. {$IFDEF THREADSAFE}
  15949. finally
  15950. if FThreadSafe then
  15951. SyncReaderWriter.EndRead;
  15952. end;
  15953. {$ENDIF THREADSAFE}
  15954. end;
  15955. function TJclIntegerIntegerSortedMap.KeyOfValue(Value: Integer): Integer;
  15956. var
  15957. Index: Integer;
  15958. Found: Boolean;
  15959. begin
  15960. {$IFDEF THREADSAFE}
  15961. if FThreadSafe then
  15962. SyncReaderWriter.BeginRead;
  15963. try
  15964. {$ENDIF THREADSAFE}
  15965. Found := False;
  15966. Result := 0;
  15967. for Index := 0 to FSize - 1 do
  15968. if ValuesCompare(FEntries[Index].Value, Value) = 0 then
  15969. begin
  15970. Result := FEntries[Index].Key;
  15971. Found := True;
  15972. Break;
  15973. end;
  15974. if (not Found) and (not FReturnDefaultElements) then
  15975. raise EJclNoSuchElementError.Create('');
  15976. {$IFDEF THREADSAFE}
  15977. finally
  15978. if FThreadSafe then
  15979. SyncReaderWriter.EndRead;
  15980. end;
  15981. {$ENDIF THREADSAFE}
  15982. end;
  15983. function TJclIntegerIntegerSortedMap.KeySet: IJclIntegerSet;
  15984. var
  15985. Index: Integer;
  15986. begin
  15987. {$IFDEF THREADSAFE}
  15988. if FThreadSafe then
  15989. SyncReaderWriter.BeginRead;
  15990. try
  15991. {$ENDIF THREADSAFE}
  15992. Result := TJclIntegerArraySet.Create(FSize);
  15993. for Index := 0 to FSize - 1 do
  15994. Result.Add(FEntries[Index].Key);
  15995. {$IFDEF THREADSAFE}
  15996. finally
  15997. if FThreadSafe then
  15998. SyncReaderWriter.EndRead;
  15999. end;
  16000. {$ENDIF THREADSAFE}
  16001. end;
  16002. function TJclIntegerIntegerSortedMap.LastKey: Integer;
  16003. begin
  16004. {$IFDEF THREADSAFE}
  16005. if FThreadSafe then
  16006. SyncReaderWriter.BeginRead;
  16007. try
  16008. {$ENDIF THREADSAFE}
  16009. Result := 0;
  16010. if FSize > 0 then
  16011. Result := FEntries[FSize - 1].Key
  16012. else
  16013. if not FReturnDefaultElements then
  16014. raise EJclNoSuchElementError.Create('');
  16015. {$IFDEF THREADSAFE}
  16016. finally
  16017. if FThreadSafe then
  16018. SyncReaderWriter.EndRead;
  16019. end;
  16020. {$ENDIF THREADSAFE}
  16021. end;
  16022. function TJclIntegerIntegerSortedMap.MapEquals(const AMap: IJclIntegerIntegerMap): Boolean;
  16023. var
  16024. It: IJclIntegerIterator;
  16025. Index: Integer;
  16026. AKey: Integer;
  16027. begin
  16028. {$IFDEF THREADSAFE}
  16029. if FThreadSafe then
  16030. SyncReaderWriter.BeginRead;
  16031. try
  16032. {$ENDIF THREADSAFE}
  16033. Result := False;
  16034. if AMap = nil then
  16035. Exit;
  16036. if FSize <> AMap.Size then
  16037. Exit;
  16038. It := AMap.KeySet.First;
  16039. Index := 0;
  16040. while It.HasNext do
  16041. begin
  16042. if Index >= FSize then
  16043. Exit;
  16044. AKey := It.Next;
  16045. if ValuesCompare(AMap.GetValue(AKey), FEntries[Index].Value) <> 0 then
  16046. Exit;
  16047. Inc(Index);
  16048. end;
  16049. Result := True;
  16050. {$IFDEF THREADSAFE}
  16051. finally
  16052. if FThreadSafe then
  16053. SyncReaderWriter.EndRead;
  16054. end;
  16055. {$ENDIF THREADSAFE}
  16056. end;
  16057. procedure TJclIntegerIntegerSortedMap.InitializeArrayAfterMove(var List: TJclIntegerIntegerSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  16058. begin
  16059. { Clean array }
  16060. if FromIndex < ToIndex then
  16061. begin
  16062. if (ToIndex - FromIndex) < Count then
  16063. Count := ToIndex - FromIndex;
  16064. FillChar(List[FromIndex], Count * SizeOf(List[0]), 0);
  16065. end
  16066. else
  16067. if FromIndex > ToIndex then
  16068. begin
  16069. if (FromIndex - ToIndex) < Count then
  16070. FillChar(List[ToIndex + Count], (FromIndex - ToIndex) * SizeOf(List[0]), 0)
  16071. else
  16072. FillChar(List[FromIndex], Count * SizeOf(List[0]), 0);
  16073. end;
  16074. end;
  16075. procedure TJclIntegerIntegerSortedMap.MoveArray(var List: TJclIntegerIntegerSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  16076. begin
  16077. if Count > 0 then
  16078. begin
  16079. Move(List[FromIndex], List[ToIndex], Count * SizeOf(List[0]));
  16080. InitializeArrayAfterMove(List, FromIndex, ToIndex, Count);
  16081. end;
  16082. end;
  16083. procedure TJclIntegerIntegerSortedMap.PutAll(const AMap: IJclIntegerIntegerMap);
  16084. var
  16085. It: IJclIntegerIterator;
  16086. Key: Integer;
  16087. begin
  16088. if ReadOnly then
  16089. raise EJclReadOnlyError.Create;
  16090. {$IFDEF THREADSAFE}
  16091. if FThreadSafe then
  16092. SyncReaderWriter.BeginWrite;
  16093. try
  16094. {$ENDIF THREADSAFE}
  16095. if AMap = nil then
  16096. Exit;
  16097. It := AMap.KeySet.First;
  16098. while It.HasNext do
  16099. begin
  16100. Key := It.Next;
  16101. PutValue(Key, AMap.GetValue(Key));
  16102. end;
  16103. {$IFDEF THREADSAFE}
  16104. finally
  16105. if FThreadSafe then
  16106. SyncReaderWriter.EndWrite;
  16107. end;
  16108. {$ENDIF THREADSAFE}
  16109. end;
  16110. procedure TJclIntegerIntegerSortedMap.PutValue(Key: Integer; Value: Integer);
  16111. var
  16112. Index: Integer;
  16113. begin
  16114. if ReadOnly then
  16115. raise EJclReadOnlyError.Create;
  16116. {$IFDEF THREADSAFE}
  16117. if FThreadSafe then
  16118. SyncReaderWriter.BeginWrite;
  16119. try
  16120. {$ENDIF THREADSAFE}
  16121. if FAllowDefaultElements or ((KeysCompare(Key, 0) <> 0) and (ValuesCompare(Value, 0) <> 0)) then
  16122. begin
  16123. Index := BinarySearch(Key);
  16124. if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then
  16125. begin
  16126. FreeValue(FEntries[Index].Value);
  16127. FEntries[Index].Value := Value;
  16128. end
  16129. else
  16130. begin
  16131. if FSize = FCapacity then
  16132. AutoGrow;
  16133. if FSize < FCapacity then
  16134. begin
  16135. Inc(Index);
  16136. if (Index < FSize) and (KeysCompare(FEntries[Index].Key, Key) <> 0) then
  16137. MoveArray(FEntries, Index, Index + 1, FSize - Index);
  16138. FEntries[Index].Key := Key;
  16139. FEntries[Index].Value := Value;
  16140. Inc(FSize);
  16141. end;
  16142. end;
  16143. end;
  16144. {$IFDEF THREADSAFE}
  16145. finally
  16146. if FThreadSafe then
  16147. SyncReaderWriter.EndWrite;
  16148. end;
  16149. {$ENDIF THREADSAFE}
  16150. end;
  16151. function TJclIntegerIntegerSortedMap.Remove(Key: Integer): Integer;
  16152. begin
  16153. if ReadOnly then
  16154. raise EJclReadOnlyError.Create;
  16155. {$IFDEF THREADSAFE}
  16156. if FThreadSafe then
  16157. SyncReaderWriter.BeginWrite;
  16158. try
  16159. {$ENDIF THREADSAFE}
  16160. Result := Extract(Key);
  16161. Result := FreeValue(Result);
  16162. {$IFDEF THREADSAFE}
  16163. finally
  16164. if FThreadSafe then
  16165. SyncReaderWriter.EndWrite;
  16166. end;
  16167. {$ENDIF THREADSAFE}
  16168. end;
  16169. procedure TJclIntegerIntegerSortedMap.SetCapacity(Value: Integer);
  16170. begin
  16171. if ReadOnly then
  16172. raise EJclReadOnlyError.Create;
  16173. {$IFDEF THREADSAFE}
  16174. if FThreadSafe then
  16175. SyncReaderWriter.BeginWrite;
  16176. try
  16177. {$ENDIF THREADSAFE}
  16178. if FSize <= Value then
  16179. begin
  16180. SetLength(FEntries, Value);
  16181. inherited SetCapacity(Value);
  16182. end
  16183. else
  16184. raise EJclOperationNotSupportedError.Create;
  16185. {$IFDEF THREADSAFE}
  16186. finally
  16187. if FThreadSafe then
  16188. SyncReaderWriter.EndWrite;
  16189. end;
  16190. {$ENDIF THREADSAFE}
  16191. end;
  16192. function TJclIntegerIntegerSortedMap.Size: Integer;
  16193. begin
  16194. Result := FSize;
  16195. end;
  16196. function TJclIntegerIntegerSortedMap.SubMap(FromKey, ToKey: Integer): IJclIntegerIntegerSortedMap;
  16197. var
  16198. FromIndex, ToIndex: Integer;
  16199. NewMap: TJclIntegerIntegerSortedMap;
  16200. begin
  16201. {$IFDEF THREADSAFE}
  16202. if FThreadSafe then
  16203. SyncReaderWriter.BeginRead;
  16204. try
  16205. {$ENDIF THREADSAFE}
  16206. NewMap := CreateEmptyContainer as TJclIntegerIntegerSortedMap;
  16207. FromIndex := BinarySearch(FromKey);
  16208. if (FromIndex = -1) or (KeysCompare(FEntries[FromIndex].Key, FromKey) < 0) then
  16209. Inc(FromIndex);
  16210. ToIndex := BinarySearch(ToKey);
  16211. if (FromIndex >= 0) and (FromIndex <= ToIndex) then
  16212. begin
  16213. NewMap.SetCapacity(ToIndex - FromIndex + 1);
  16214. NewMap.FSize := ToIndex - FromIndex + 1;
  16215. while ToIndex >= FromIndex do
  16216. begin
  16217. NewMap.FEntries[ToIndex - FromIndex] := FEntries[ToIndex];
  16218. Dec(ToIndex);
  16219. end;
  16220. end;
  16221. Result := NewMap;
  16222. {$IFDEF THREADSAFE}
  16223. finally
  16224. if FThreadSafe then
  16225. SyncReaderWriter.EndRead;
  16226. end;
  16227. {$ENDIF THREADSAFE}
  16228. end;
  16229. function TJclIntegerIntegerSortedMap.TailMap(FromKey: Integer): IJclIntegerIntegerSortedMap;
  16230. var
  16231. FromIndex, Index: Integer;
  16232. NewMap: TJclIntegerIntegerSortedMap;
  16233. begin
  16234. {$IFDEF THREADSAFE}
  16235. if FThreadSafe then
  16236. SyncReaderWriter.BeginRead;
  16237. try
  16238. {$ENDIF THREADSAFE}
  16239. NewMap := CreateEmptyContainer as TJclIntegerIntegerSortedMap;
  16240. FromIndex := BinarySearch(FromKey);
  16241. if (FromIndex = -1) or (KeysCompare(FEntries[FromIndex].Key, FromKey) < 0) then
  16242. Inc(FromIndex);
  16243. if (FromIndex >= 0) and (FromIndex < FSize) then
  16244. begin
  16245. NewMap.SetCapacity(FSize - FromIndex);
  16246. NewMap.FSize := FSize - FromIndex;
  16247. Index := FromIndex;
  16248. while Index < FSize do
  16249. begin
  16250. NewMap.FEntries[Index - FromIndex] := FEntries[Index];
  16251. Inc(Index);
  16252. end;
  16253. end;
  16254. Result := NewMap;
  16255. {$IFDEF THREADSAFE}
  16256. finally
  16257. if FThreadSafe then
  16258. SyncReaderWriter.EndRead;
  16259. end;
  16260. {$ENDIF THREADSAFE}
  16261. end;
  16262. function TJclIntegerIntegerSortedMap.Values: IJclIntegerCollection;
  16263. var
  16264. Index: Integer;
  16265. begin
  16266. {$IFDEF THREADSAFE}
  16267. if FThreadSafe then
  16268. SyncReaderWriter.BeginRead;
  16269. try
  16270. {$ENDIF THREADSAFE}
  16271. Result := TJclIntegerArrayList.Create(FSize);
  16272. for Index := 0 to FSize - 1 do
  16273. Result.Add(FEntries[Index].Value);
  16274. {$IFDEF THREADSAFE}
  16275. finally
  16276. if FThreadSafe then
  16277. SyncReaderWriter.EndRead;
  16278. end;
  16279. {$ENDIF THREADSAFE}
  16280. end;
  16281. function TJclIntegerIntegerSortedMap.CreateEmptyContainer: TJclAbstractContainerBase;
  16282. begin
  16283. Result := TJclIntegerIntegerSortedMap.Create(FSize);
  16284. AssignPropertiesTo(Result);
  16285. end;
  16286. function TJclIntegerIntegerSortedMap.FreeKey(var Key: Integer): Integer;
  16287. begin
  16288. Result := Key;
  16289. Key := 0;
  16290. end;
  16291. function TJclIntegerIntegerSortedMap.FreeValue(var Value: Integer): Integer;
  16292. begin
  16293. Result := Value;
  16294. Value := 0;
  16295. end;
  16296. function TJclIntegerIntegerSortedMap.KeysCompare(A, B: Integer): Integer;
  16297. begin
  16298. Result := ItemsCompare(A, B);
  16299. end;
  16300. function TJclIntegerIntegerSortedMap.ValuesCompare(A, B: Integer): Integer;
  16301. begin
  16302. Result := ItemsCompare(A, B);
  16303. end;
  16304. //=== { TJclCardinalIntfSortedMap } ==============================================
  16305. constructor TJclCardinalIntfSortedMap.Create(ACapacity: Integer);
  16306. begin
  16307. inherited Create();
  16308. SetCapacity(ACapacity);
  16309. end;
  16310. destructor TJclCardinalIntfSortedMap.Destroy;
  16311. begin
  16312. FReadOnly := False;
  16313. Clear;
  16314. inherited Destroy;
  16315. end;
  16316. procedure TJclCardinalIntfSortedMap.AssignDataTo(Dest: TJclAbstractContainerBase);
  16317. var
  16318. MyDest: TJclCardinalIntfSortedMap;
  16319. begin
  16320. inherited AssignDataTo(Dest);
  16321. if Dest is TJclCardinalIntfSortedMap then
  16322. begin
  16323. MyDest := TJclCardinalIntfSortedMap(Dest);
  16324. MyDest.SetCapacity(FSize);
  16325. MyDest.FEntries := FEntries;
  16326. MyDest.FSize := FSize;
  16327. end;
  16328. end;
  16329. function TJclCardinalIntfSortedMap.BinarySearch(Key: Cardinal): Integer;
  16330. var
  16331. HiPos, LoPos, CompPos: Integer;
  16332. Comp: Integer;
  16333. begin
  16334. {$IFDEF THREADSAFE}
  16335. if FThreadSafe then
  16336. SyncReaderWriter.BeginRead;
  16337. try
  16338. {$ENDIF THREADSAFE}
  16339. LoPos := 0;
  16340. HiPos := FSize - 1;
  16341. CompPos := (HiPos + LoPos) div 2;
  16342. while HiPos >= LoPos do
  16343. begin
  16344. Comp := KeysCompare(FEntries[CompPos].Key, Key);
  16345. if Comp < 0 then
  16346. LoPos := CompPos + 1
  16347. else
  16348. if Comp > 0 then
  16349. HiPos := CompPos - 1
  16350. else
  16351. begin
  16352. HiPos := CompPos;
  16353. LoPos := CompPos + 1;
  16354. end;
  16355. CompPos := (HiPos + LoPos) div 2;
  16356. end;
  16357. Result := HiPos;
  16358. {$IFDEF THREADSAFE}
  16359. finally
  16360. if FThreadSafe then
  16361. SyncReaderWriter.EndRead;
  16362. end;
  16363. {$ENDIF THREADSAFE}
  16364. end;
  16365. procedure TJclCardinalIntfSortedMap.Clear;
  16366. var
  16367. Index: Integer;
  16368. begin
  16369. if ReadOnly then
  16370. raise EJclReadOnlyError.Create;
  16371. {$IFDEF THREADSAFE}
  16372. if FThreadSafe then
  16373. SyncReaderWriter.BeginWrite;
  16374. try
  16375. {$ENDIF THREADSAFE}
  16376. for Index := 0 to FSize - 1 do
  16377. begin
  16378. FreeKey(FEntries[Index].Key);
  16379. FreeValue(FEntries[Index].Value);
  16380. end;
  16381. FSize := 0;
  16382. AutoPack;
  16383. {$IFDEF THREADSAFE}
  16384. finally
  16385. if FThreadSafe then
  16386. SyncReaderWriter.EndWrite;
  16387. end;
  16388. {$ENDIF THREADSAFE}
  16389. end;
  16390. function TJclCardinalIntfSortedMap.ContainsKey(Key: Cardinal): Boolean;
  16391. var
  16392. Index: Integer;
  16393. begin
  16394. {$IFDEF THREADSAFE}
  16395. if FThreadSafe then
  16396. SyncReaderWriter.BeginRead;
  16397. try
  16398. {$ENDIF THREADSAFE}
  16399. Index := BinarySearch(Key);
  16400. Result := (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0);
  16401. {$IFDEF THREADSAFE}
  16402. finally
  16403. if FThreadSafe then
  16404. SyncReaderWriter.EndRead;
  16405. end;
  16406. {$ENDIF THREADSAFE}
  16407. end;
  16408. function TJclCardinalIntfSortedMap.ContainsValue(const Value: IInterface): Boolean;
  16409. var
  16410. Index: Integer;
  16411. begin
  16412. {$IFDEF THREADSAFE}
  16413. if FThreadSafe then
  16414. SyncReaderWriter.BeginRead;
  16415. try
  16416. {$ENDIF THREADSAFE}
  16417. Result := False;
  16418. for Index := 0 to FSize - 1 do
  16419. if ValuesCompare(FEntries[Index].Value, Value) = 0 then
  16420. begin
  16421. Result := True;
  16422. Break;
  16423. end;
  16424. {$IFDEF THREADSAFE}
  16425. finally
  16426. if FThreadSafe then
  16427. SyncReaderWriter.EndRead;
  16428. end;
  16429. {$ENDIF THREADSAFE}
  16430. end;
  16431. function TJclCardinalIntfSortedMap.FirstKey: Cardinal;
  16432. begin
  16433. {$IFDEF THREADSAFE}
  16434. if FThreadSafe then
  16435. SyncReaderWriter.BeginRead;
  16436. try
  16437. {$ENDIF THREADSAFE}
  16438. Result := 0;
  16439. if FSize > 0 then
  16440. Result := FEntries[0].Key
  16441. else
  16442. if not FReturnDefaultElements then
  16443. raise EJclNoSuchElementError.Create('');
  16444. {$IFDEF THREADSAFE}
  16445. finally
  16446. if FThreadSafe then
  16447. SyncReaderWriter.EndRead;
  16448. end;
  16449. {$ENDIF THREADSAFE}
  16450. end;
  16451. function TJclCardinalIntfSortedMap.Extract(Key: Cardinal): IInterface;
  16452. var
  16453. Index: Integer;
  16454. begin
  16455. if ReadOnly then
  16456. raise EJclReadOnlyError.Create;
  16457. {$IFDEF THREADSAFE}
  16458. if FThreadSafe then
  16459. SyncReaderWriter.BeginWrite;
  16460. try
  16461. {$ENDIF THREADSAFE}
  16462. Index := BinarySearch(Key);
  16463. if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then
  16464. begin
  16465. Result := FEntries[Index].Value;
  16466. FEntries[Index].Value := nil;
  16467. FreeKey(FEntries[Index].Key);
  16468. if Index < (FSize - 1) then
  16469. MoveArray(FEntries, Index + 1, Index, FSize - Index - 1);
  16470. Dec(FSize);
  16471. AutoPack;
  16472. end
  16473. else
  16474. Result := nil;
  16475. {$IFDEF THREADSAFE}
  16476. finally
  16477. if FThreadSafe then
  16478. SyncReaderWriter.EndWrite;
  16479. end;
  16480. {$ENDIF THREADSAFE}
  16481. end;
  16482. function TJclCardinalIntfSortedMap.GetValue(Key: Cardinal): IInterface;
  16483. var
  16484. Index: Integer;
  16485. begin
  16486. {$IFDEF THREADSAFE}
  16487. if FThreadSafe then
  16488. SyncReaderWriter.BeginRead;
  16489. try
  16490. {$ENDIF THREADSAFE}
  16491. Index := BinarySearch(Key);
  16492. Result := nil;
  16493. if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then
  16494. Result := FEntries[Index].Value
  16495. else if not FReturnDefaultElements then
  16496. raise EJclNoSuchElementError.Create('');
  16497. {$IFDEF THREADSAFE}
  16498. finally
  16499. if FThreadSafe then
  16500. SyncReaderWriter.EndRead;
  16501. end;
  16502. {$ENDIF THREADSAFE}
  16503. end;
  16504. function TJclCardinalIntfSortedMap.HeadMap(ToKey: Cardinal): IJclCardinalIntfSortedMap;
  16505. var
  16506. ToIndex: Integer;
  16507. NewMap: TJclCardinalIntfSortedMap;
  16508. begin
  16509. {$IFDEF THREADSAFE}
  16510. if FThreadSafe then
  16511. SyncReaderWriter.BeginRead;
  16512. try
  16513. {$ENDIF THREADSAFE}
  16514. NewMap := CreateEmptyContainer as TJclCardinalIntfSortedMap;
  16515. ToIndex := BinarySearch(ToKey);
  16516. if ToIndex >= 0 then
  16517. begin
  16518. NewMap.SetCapacity(ToIndex + 1);
  16519. NewMap.FSize := ToIndex + 1;
  16520. while ToIndex >= 0 do
  16521. begin
  16522. NewMap.FEntries[ToIndex] := FEntries[ToIndex];
  16523. Dec(ToIndex);
  16524. end;
  16525. end;
  16526. Result := NewMap;
  16527. {$IFDEF THREADSAFE}
  16528. finally
  16529. if FThreadSafe then
  16530. SyncReaderWriter.EndRead;
  16531. end;
  16532. {$ENDIF THREADSAFE}
  16533. end;
  16534. function TJclCardinalIntfSortedMap.IsEmpty: Boolean;
  16535. begin
  16536. {$IFDEF THREADSAFE}
  16537. if FThreadSafe then
  16538. SyncReaderWriter.BeginRead;
  16539. try
  16540. {$ENDIF THREADSAFE}
  16541. Result := FSize = 0;
  16542. {$IFDEF THREADSAFE}
  16543. finally
  16544. if FThreadSafe then
  16545. SyncReaderWriter.EndRead;
  16546. end;
  16547. {$ENDIF THREADSAFE}
  16548. end;
  16549. function TJclCardinalIntfSortedMap.KeyOfValue(const Value: IInterface): Cardinal;
  16550. var
  16551. Index: Integer;
  16552. Found: Boolean;
  16553. begin
  16554. {$IFDEF THREADSAFE}
  16555. if FThreadSafe then
  16556. SyncReaderWriter.BeginRead;
  16557. try
  16558. {$ENDIF THREADSAFE}
  16559. Found := False;
  16560. Result := 0;
  16561. for Index := 0 to FSize - 1 do
  16562. if ValuesCompare(FEntries[Index].Value, Value) = 0 then
  16563. begin
  16564. Result := FEntries[Index].Key;
  16565. Found := True;
  16566. Break;
  16567. end;
  16568. if (not Found) and (not FReturnDefaultElements) then
  16569. raise EJclNoSuchElementError.Create('');
  16570. {$IFDEF THREADSAFE}
  16571. finally
  16572. if FThreadSafe then
  16573. SyncReaderWriter.EndRead;
  16574. end;
  16575. {$ENDIF THREADSAFE}
  16576. end;
  16577. function TJclCardinalIntfSortedMap.KeySet: IJclCardinalSet;
  16578. var
  16579. Index: Integer;
  16580. begin
  16581. {$IFDEF THREADSAFE}
  16582. if FThreadSafe then
  16583. SyncReaderWriter.BeginRead;
  16584. try
  16585. {$ENDIF THREADSAFE}
  16586. Result := TJclCardinalArraySet.Create(FSize);
  16587. for Index := 0 to FSize - 1 do
  16588. Result.Add(FEntries[Index].Key);
  16589. {$IFDEF THREADSAFE}
  16590. finally
  16591. if FThreadSafe then
  16592. SyncReaderWriter.EndRead;
  16593. end;
  16594. {$ENDIF THREADSAFE}
  16595. end;
  16596. function TJclCardinalIntfSortedMap.LastKey: Cardinal;
  16597. begin
  16598. {$IFDEF THREADSAFE}
  16599. if FThreadSafe then
  16600. SyncReaderWriter.BeginRead;
  16601. try
  16602. {$ENDIF THREADSAFE}
  16603. Result := 0;
  16604. if FSize > 0 then
  16605. Result := FEntries[FSize - 1].Key
  16606. else
  16607. if not FReturnDefaultElements then
  16608. raise EJclNoSuchElementError.Create('');
  16609. {$IFDEF THREADSAFE}
  16610. finally
  16611. if FThreadSafe then
  16612. SyncReaderWriter.EndRead;
  16613. end;
  16614. {$ENDIF THREADSAFE}
  16615. end;
  16616. function TJclCardinalIntfSortedMap.MapEquals(const AMap: IJclCardinalIntfMap): Boolean;
  16617. var
  16618. It: IJclCardinalIterator;
  16619. Index: Integer;
  16620. AKey: Cardinal;
  16621. begin
  16622. {$IFDEF THREADSAFE}
  16623. if FThreadSafe then
  16624. SyncReaderWriter.BeginRead;
  16625. try
  16626. {$ENDIF THREADSAFE}
  16627. Result := False;
  16628. if AMap = nil then
  16629. Exit;
  16630. if FSize <> AMap.Size then
  16631. Exit;
  16632. It := AMap.KeySet.First;
  16633. Index := 0;
  16634. while It.HasNext do
  16635. begin
  16636. if Index >= FSize then
  16637. Exit;
  16638. AKey := It.Next;
  16639. if ValuesCompare(AMap.GetValue(AKey), FEntries[Index].Value) <> 0 then
  16640. Exit;
  16641. Inc(Index);
  16642. end;
  16643. Result := True;
  16644. {$IFDEF THREADSAFE}
  16645. finally
  16646. if FThreadSafe then
  16647. SyncReaderWriter.EndRead;
  16648. end;
  16649. {$ENDIF THREADSAFE}
  16650. end;
  16651. procedure TJclCardinalIntfSortedMap.FinalizeArrayBeforeMove(var List: TJclCardinalIntfSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  16652. begin
  16653. Assert(Count > 0);
  16654. if FromIndex < ToIndex then
  16655. begin
  16656. if Count > (ToIndex - FromIndex) then
  16657. Finalize(List[FromIndex + Count], ToIndex - FromIndex)
  16658. else
  16659. Finalize(List[ToIndex], Count);
  16660. end
  16661. else
  16662. if FromIndex > ToIndex then
  16663. begin
  16664. if Count > (FromIndex - ToIndex) then
  16665. Count := FromIndex - ToIndex;
  16666. Finalize(List[ToIndex], Count)
  16667. end;
  16668. end;
  16669. procedure TJclCardinalIntfSortedMap.InitializeArray(var List: TJclCardinalIntfSortedMapEntryArray; FromIndex, Count: SizeInt);
  16670. begin
  16671. {$IFDEF FPC}
  16672. while Count > 0 do
  16673. begin
  16674. Initialize(List[FromIndex]);
  16675. Inc(FromIndex);
  16676. Dec(Count);
  16677. end;
  16678. {$ELSE ~FPC}
  16679. Initialize(List[FromIndex], Count);
  16680. {$ENDIF ~FPC}
  16681. end;
  16682. procedure TJclCardinalIntfSortedMap.InitializeArrayAfterMove(var List: TJclCardinalIntfSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  16683. begin
  16684. { Keep reference counting working }
  16685. if FromIndex < ToIndex then
  16686. begin
  16687. if (ToIndex - FromIndex) < Count then
  16688. Count := ToIndex - FromIndex;
  16689. InitializeArray(List, FromIndex, Count);
  16690. end
  16691. else
  16692. if FromIndex > ToIndex then
  16693. begin
  16694. if (FromIndex - ToIndex) < Count then
  16695. InitializeArray(List, ToIndex + Count, FromIndex - ToIndex)
  16696. else
  16697. InitializeArray(List, FromIndex, Count);
  16698. end;
  16699. end;
  16700. procedure TJclCardinalIntfSortedMap.MoveArray(var List: TJclCardinalIntfSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt);
  16701. begin
  16702. if Count > 0 then
  16703. begin
  16704. FinalizeArrayBeforeMove(List, FromIndex, ToIndex, Count);
  16705. Move(List[FromIndex], List[ToIndex], Count * SizeOf(List[0]));
  16706. InitializeArrayAfterMove(List, FromIndex, ToIndex, Count);
  16707. end;
  16708. end;
  16709. procedure TJclCardinalIntfSortedMap.PutAll(const AMap: IJclCardinalIntfMap);
  16710. var
  16711. It: IJclCardinalIterator;
  16712. Key: Cardinal;
  16713. begin
  16714. if ReadOnly then
  16715. raise EJclReadOnlyError.Create;
  16716. {$IFDEF THREADSAFE}
  16717. if FThreadSafe then
  16718. SyncReaderWriter.BeginWrite;
  16719. try
  16720. {$ENDIF THREADSAFE}
  16721. if AMap = nil then
  16722. Exit;
  16723. It := AMap.KeySet.First;
  16724. while It.HasNext do
  16725. begin
  16726. Key := It.Next;
  16727. PutValue(Key, AMap.GetValue(Key));
  16728. end;
  16729. {$IFDEF THREADSAFE}
  16730. finally
  16731. if FThreadSafe then
  16732. SyncReaderWriter.EndWrite;
  16733. end;
  16734. {$ENDIF THREADSAFE}
  16735. end;
  16736. procedure TJclCardinalIntfSortedMap.PutValue(Key: Cardinal; const Value: IInterface);
  16737. var
  16738. Index: Integer;
  16739. begin
  16740. if ReadOnly then
  16741. raise EJclReadOnlyError.Create;
  16742. {$IFDEF THREADSAFE}
  16743. if FThreadSafe then
  16744. SyncReaderWriter.BeginWrite;
  16745. try
  16746. {$ENDIF THREADSAFE}
  16747. if FAllowDefaultElements or ((KeysCompare(Key, 0) <> 0) and (ValuesCompare(Value, nil) <> 0)) then
  16748. begin
  16749. Index := BinarySearch(Key);
  16750. if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then
  16751. begin
  16752. FreeValue(FEntries[Index].Value);
  16753. FEntries[Index].Value := Value;
  16754. end
  16755. else
  16756. begin
  16757. if FSize = FCapacity then
  16758. AutoGrow;
  16759. if FSize < FCapacity then
  16760. begin
  16761. Inc(Index);
  16762. if (Index < FSize) and (KeysCompare(FEntries[Index].Key, Key) <> 0) then
  16763. MoveArray(FEntries, Index, Index + 1, FSize - Index);
  16764. FEntries[Index].Key := Key;
  16765. FEntries[Index].Value := Value;
  16766. Inc(FSize);
  16767. end;
  16768. end;
  16769. end;
  16770. {$IFDEF THREADSAFE}
  16771. finally
  16772. if FThreadSafe then
  16773. SyncReaderWriter.EndWrite;
  16774. end;
  16775. {$ENDIF THREADSAFE}
  16776. end;
  16777. function TJclCardinalIntfSortedMap.Remove(Key: Cardinal): IInterface;
  16778. begin
  16779. if ReadOnly then
  16780. raise EJclReadOnlyError.Create;
  16781. {$IFDEF THREADSAFE}
  16782. if FThreadSafe then
  16783. SyncReaderWriter.BeginWrite;
  16784. try
  16785. {$ENDIF THREADSAFE}
  16786. Result := Extract(Key);
  16787. Result := FreeValue(Result);
  16788. {$IFDEF THREADSAFE}
  16789. finally
  16790. if FThreadSafe then
  16791. SyncReaderWriter.EndWrite;
  16792. end;
  16793. {$ENDIF THREADSAFE}
  16794. end;
  16795. procedure TJclCardinalIntfSortedMap.SetCapacity(Value: Integer);
  16796. begin
  16797. if ReadOnly then
  16798. raise EJclReadOnlyError.Create;
  16799. {$IFDEF THREADSAFE}
  16800. if FThreadSafe then
  16801. SyncReaderWriter.BeginWrite;
  16802. try
  16803. {$ENDIF THREADSAFE}
  16804. if FSize <= Value then
  16805. begin
  16806. SetLength(FEntries, Value);
  16807. inherited SetCapacity(Value);
  16808. end
  16809. else
  16810. raise EJclOperationNotSupportedError.Create;
  16811. {$IFDEF THREADSAFE}
  16812. finally
  16813. if FThreadSafe then
  16814. SyncReaderWriter.EndWrite;
  16815. end;
  16816. {$ENDIF THREADSAFE}
  16817. end;
  16818. function TJclCardinalIntfSortedMap.Size: Integer;
  16819. begin
  16820. Result := FSize;
  16821. end;
  16822. function TJclCardinalIntfSortedMap.SubMap(FromKey, ToKey: Cardinal): IJclCardinalIntfSortedMap;
  16823. var
  16824. FromIndex, ToIndex: Integer;
  16825. NewMap: TJclCardinalIntfSortedMap;
  16826. begin
  16827. {$IFDEF THREADSAFE}
  16828. if FThreadSafe then
  16829. SyncReaderWriter.BeginRead;
  16830. try
  16831. {$ENDIF THREADSAFE}
  16832. NewMap := CreateEmptyContainer as TJclCardinalIntfSortedMap;
  16833. FromIndex := BinarySearch(FromKey);
  16834. if (FromIndex = -1) or (KeysCompare(FEntries[FromIndex].Key, FromKey) < 0) then
  16835. Inc(FromIndex);
  16836. ToIndex := BinarySearch(ToKey);
  16837. if (FromIndex >= 0) and (FromIndex <= ToIndex) then
  16838. begin
  16839. NewMap.SetCapacity(ToIndex - FromIndex + 1);
  16840. NewMap.FSize := ToIndex - FromIndex + 1;
  16841. while ToIndex >= FromIndex do
  16842. begin
  16843. NewMap.FEntries[ToIndex - FromIndex] := FEntries[ToIndex];
  16844. Dec(ToIndex);
  16845. end;
  16846. end;
  16847. Result := NewMap;
  16848. {$IFDEF THREADSAFE}
  16849. finally
  16850. if FThreadSafe then
  16851. SyncReaderWriter.EndRead;
  16852. end;
  16853. {$ENDIF THREADSAFE}
  16854. end;
  16855. function TJclCardinalIntfSortedMap.TailMap(FromKey: Cardinal): IJclCardinalIntfSortedMap;
  16856. var
  16857. FromIndex, Index: Integer;
  16858. NewMap: TJclCardinalIntfSortedMap;
  16859. begin
  16860. {$IFDEF THREADSAFE}
  16861. if FThreadSafe then
  16862. SyncReaderWriter.BeginRead;
  16863. try
  16864. {$ENDIF THREADSAFE}
  16865. NewMap := CreateEmptyContainer as TJclCardinalIntfSortedMap;
  16866. FromIndex := BinarySearch(FromKey);
  16867. if (FromIndex = -1) or (KeysCompare(FEntries[FromIndex].Key, FromKey) < 0) then
  16868. Inc(FromIndex);
  16869. if (FromIndex >= 0) and (FromIndex < FSize) then
  16870. begin
  16871. NewMap.SetCapacity(FSize - FromIndex);
  16872. NewMap.FSize := FSize - FromIndex;
  16873. Index := FromIndex;
  16874. while Index < FSize do
  16875. begin
  16876. NewMap.FEntries[Index - FromIndex] := FEntries[Index];
  16877. Inc(Index);
  16878. end;
  16879. end;
  16880. Result := NewMap;
  16881. {$IFDEF THREADSAFE}
  16882. finally
  16883. if FThreadSafe then
  16884. SyncReaderWriter.EndRead;
  16885. end;
  16886. {$ENDIF THREADSAFE}
  16887. end;
  16888. function TJclCardinalIntfSortedMap.Values: IJclIntfCollection;
  16889. var
  16890. Index: Integer;
  16891. begin
  16892. {$IFDEF THREADSAFE}
  16893. if FThreadSafe then
  16894. SyncReaderWriter.BeginRead;
  16895. try
  16896. {$ENDIF THREADSAFE}
  16897. Result := TJclIntfArrayList.Create(FSize);
  16898. for Index := 0 to FSize - 1 do
  16899. Result.Add(FEntries[Index].Value);
  16900. {$IFDEF THREADSAFE}
  16901. finally
  16902. if FThreadSafe then
  16903. SyncReaderWriter.EndRead;
  16904. end;
  16905. {$ENDIF THREADSAFE}
  16906. end;
  16907. function TJclCardinalIntfSortedMap.CreateEmptyContainer: TJclAbstractContainerBase;
  16908. begin
  16909. Result := TJclCardinalIntfSortedMap.Create(FSize);
  16910. AssignPropertiesTo(Result);
  16911. end;
  16912. function TJclCardinalIntfSortedMap.FreeKey(var Key: Cardinal): Cardinal;
  16913. begin
  16914. Result := Key;
  16915. Key := 0;
  16916. end;
  16917. function TJclCardinalIntfSortedMap.FreeValue(var Value: IInterface): IInterface;
  16918. begin
  16919. Result := Value;
  16920. Value := nil;
  16921. end;
  16922. function TJclCardinalIntfSortedMap.KeysCompare(A, B: Cardinal): Integer;
  16923. begin
  16924. Result := ItemsCompare(A, B);
  16925. end;
  16926. function TJclCardinalIntfSortedMap.ValuesCompare(const A, B: IInterface): Integer;
  16927. begin
  16928. Result := IntfSimpleCompare(A, B);
  16929. end;
  16930. //=== { TJclIntfCardinalSortedMap } ==============================================
  16931. constructor TJclIntfCardinalSortedMap.Create(ACapacity: Integer);
  16932. begin
  16933. inherited Create();
  16934. SetCapacity(ACapacity);
  16935. end;
  16936. destructor TJclIntfCardinalSortedMap.Destroy;
  16937. begin
  16938. FReadOnly := False;
  16939. Clear;
  16940. inherited Destroy;
  16941. end;
  16942. procedure TJclIntfCardinalSortedMap.AssignDataTo(Dest: TJclAbstractContainerBase);
  16943. var
  16944. MyDest: TJclIntfCardinalSortedMap;
  16945. begin
  16946. inherited AssignDataTo(Dest);
  16947. if Dest is TJclIntfCardinalSortedMap then
  16948. begin
  16949. MyDest := TJclIntfCardinalSortedMap(Dest);
  16950. MyDest.SetCapacity(FSize);
  16951. MyDest.FEntries := FEntries;
  16952. MyDest.FSize := FSize;
  16953. end;
  16954. end;
  16955. function TJclIntfCardinalSortedMap.BinarySearch(const Key: IInterface): Integer;
  16956. var
  16957. HiPos, LoPos, CompPos: Integer;
  16958. Comp: Integer;
  16959. begin
  16960. {$IFDEF THREADSAFE}
  16961. if FThreadSafe then
  16962. SyncReaderWriter.BeginRead;
  16963. try
  16964. {$ENDIF THREADSAFE}
  16965. LoPos := 0;
  16966. HiPos := FSize - 1;
  16967. CompPos := (HiPos + LoPos) div 2;
  16968. while HiPos >= LoPos do
  16969. begin
  16970. Comp := KeysCompare(FEntries[CompPos].Key, Key);
  16971. if Comp < 0 then
  16972. LoPos := CompPos + 1
  16973. else
  16974. if Comp > 0 then
  16975. HiPos := CompPos - 1
  16976. else
  16977. begin
  16978. HiPos := CompPos;
  16979. LoPos := CompPos + 1;
  16980. end;
  16981. CompPos := (HiPos + LoPos) div 2;
  16982. end;
  16983. Result := HiPos;
  16984. {$IFDEF THREADSAFE}
  16985. finally
  16986. if FThreadSafe then
  16987. SyncReaderWriter.EndRead;
  16988. end;
  16989. {$ENDIF THREADSAFE}
  16990. end;
  16991. procedure TJclIntfCardinalSortedMap.Clear;
  16992. var
  16993. Index: Integer;
  16994. begin
  16995. if ReadOnly then
  16996. raise EJclReadOnlyError.Create;
  16997. {$IFDEF THREADSAFE}
  16998. if FThreadSafe then
  16999. SyncReaderWriter.BeginWrite;
  17000. try
  17001. {$ENDIF THREADSAFE}
  17002. for Index := 0 to FSize - 1 do
  17003. begin
  17004. FreeKey(FEntries[Index].Key);
  17005. FreeValue(FEntries[Index].Value);
  17006. end;
  17007. FSize := 0;
  17008. AutoPack;
  17009. {$IFDEF THREADSAFE}
  17010. finally
  17011. if FThreadSafe then
  17012. SyncReaderWriter.EndWrite;
  17013. end;
  17014. {$ENDIF THREADSAFE}
  17015. end;
  17016. function TJclIntfCardinalSortedMap.ContainsKey(const Key: IInterface): Boolean;
  17017. var
  17018. Index: Integer;
  17019. begin
  17020. {$IFDEF THREADSAFE}
  17021. if FThreadSafe then
  17022. SyncReaderWriter.BeginRead;
  17023. try
  17024. {$ENDIF THREADSAFE}
  17025. Index := BinarySearch(Key);
  17026. Result := (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0);
  17027. {$IFDEF THREADSAFE}
  17028. finally
  17029. if FThreadSafe then
  17030. SyncReaderWriter.EndRead;
  17031. end;
  17032. {$ENDIF THREADSAFE}
  17033. end;
  17034. function TJclIntfCardinalSortedMap.ContainsValue(Value: Cardinal): Boolean;
  17035. var
  17036. Index: Integer;
  17037. begin
  17038. {$IFDEF THREADSAFE}
  17039. if FThreadSafe then
  17040. SyncReaderWriter.BeginRead;
  17041. try
  17042. {$ENDIF THREADSAFE}
  17043. Result := False;
  17044. for Index := 0 to FSize - 1 do
  17045. if ValuesCompare(FEntries[Index].Value, Value) = 0 then
  17046. begin
  17047. Result := True;
  17048. Break;
  17049. end;
  17050. {$IFDEF THREADSAFE}
  17051. finally
  17052. if FThreadSafe then
  17053. SyncReaderWriter.EndRead;
  17054. end;
  17055. {$ENDIF THREADSAFE}
  17056. end;
  17057. function TJclIntfCardinalSortedMap.FirstKey: IInterface;
  17058. begin
  17059. {$IFDEF THREADSAFE}
  17060. if FThreadSafe then
  17061. SyncReaderWriter.BeginRead;
  17062. try
  17063. {$ENDIF THREADSAFE}
  17064. Result := nil;
  17065. if FSize > 0 then
  17066. Result := FEntries[0].Key
  17067. else
  17068. if not FReturnDefaultElements then
  17069. raise EJclNoSuchElementError.Create('');
  17070. {$IFDEF THREADSAFE}
  17071. finally
  17072. if FThreadSafe then
  17073. SyncReaderWriter.EndRead;
  17074. end;
  17075. {$ENDIF THREADSAFE}
  17076. end;
  17077. function TJclIntfCardinalSortedMap.Extract(const Key: IInterface): Cardinal;
  17078. var
  17079. Index: Integer;
  17080. begin
  17081. if ReadOnly then
  17082. raise EJclReadOnlyError.Create;
  17083. {$IFDEF THREADSAFE}
  17084. if FThreadSafe then
  17085. SyncReaderWriter.BeginWrite;
  17086. try
  17087. {$ENDIF THREADSAFE}
  17088. Index := BinarySearch(Key);
  17089. if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then
  17090. begin
  17091. Result := FEntries[Index].Value;
  17092. FEntries[Index].Value := 0;
  17093. FreeKey(FEntries[Index].Key);
  17094. if Index < (FSize - 1) then
  17095. MoveArray(FEntries, Index + 1, Index, FSize - Index - 1);
  17096. Dec(FSize);
  17097. AutoPack;
  17098. end
  17099. else
  17100. Result := 0;
  17101. {$IFDEF THREADSAFE}
  17102. finally
  17103. if FThreadSafe then
  17104. SyncReaderWriter.EndWrite;
  17105. end;
  17106. {$ENDIF THREADSAFE}
  17107. end;
  17108. function TJclIntfCardinalSortedMap.GetValue(const Key: IInterface): Cardinal;
  17109. var
  17110. Index: Integer;
  17111. begin
  17112. {$IFDEF THREADSAFE}
  17113. if FThreadSafe then
  17114. SyncReaderWriter.BeginRead;
  17115. try
  17116. {$ENDIF THREADSAFE}
  17117. Index := BinarySearch(Key);
  17118. Result := 0;
  17119. if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then
  17120. Result := FEntries[Index].Value
  17121. else if not FReturnDefaultElements then
  17122. raise EJclNoSuchElementError.Create('');
  17123. {$IFDEF THREADSAFE}
  17124. finally
  17125. if FThreadSafe then
  17126. SyncReaderWriter.EndRead;
  17127. end;
  17128. {$ENDIF THREADSAFE}
  17129. end;
  17130. function TJclIntfCardinalSortedMap.HeadMap(const ToKey: IInterface): IJclIntfCardinalSortedMap;
  17131. var
  17132. ToIndex: Integer;
  17133. NewMap: TJclIntfCardinalSortedMap;
  17134. begin
  17135. {$IFDEF THREADSAFE}
  17136. if FThreadSafe then
  17137. SyncReaderWriter.BeginRead;
  17138. try
  17139. {$ENDIF THREADSAFE}
  17140. NewMap := CreateEmptyContainer as TJclIntfCardinalSortedMap;
  17141. ToIndex := BinarySearch(ToKey);
  17142. if ToIndex >= 0 then
  17143. begin
  17144. NewMap.SetCapacity(ToIndex + 1);
  17145. NewMap.FSize := ToIndex + 1;
  17146. while ToIndex >= 0 do
  17147. begin
  17148. NewMap.FEntries[ToIndex] := FEntries[ToIndex];
  17149. Dec(ToIndex);
  17150. end;
  17151. end;
  17152. Result := NewMap;
  17153. {$IFDEF THREADSAFE}
  17154. finally
  17155. if FThreadSafe then
  17156. SyncReaderWriter.EndRead;
  17157. end;
  17158. {$ENDIF THREADSAFE}
  17159. end;
  17160. function TJclIntfCardinalSortedMap.IsEmpty: Boolean;
  17161. begin
  17162. {$