Quick.Value.pas 36 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261
  1. { ***************************************************************************
  2. Copyright (c) 2016-2019 Kike Pérez
  3. Unit : Quick.Value
  4. Description : Autofree value record
  5. Author : Kike Pérez
  6. Version : 1.5
  7. Created : 07/01/2019
  8. Modified : 27/08/2019
  9. This file is part of QuickLib: https://github.com/exilon/QuickLib
  10. ***************************************************************************
  11. Licensed under the Apache License, Version 2.0 (the "License");
  12. you may not use this file except in compliance with the License.
  13. You may obtain a copy of the License at
  14. http://www.apache.org/licenses/LICENSE-2.0
  15. Unless required by applicable law or agreed to in writing, software
  16. distributed under the License is distributed on an "AS IS" BASIS,
  17. WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
  18. See the License for the specific language governing permissions and
  19. limitations under the License.
  20. *************************************************************************** }
  21. unit Quick.Value;
  22. {$i QuickLib.inc}
  23. interface
  24. uses
  25. SysUtils,
  26. Variants;
  27. type
  28. TValueDataType = (dtNull, dtString, dtAnsiString, dtWideString, dtInteger, dtInt64, dtDouble, dtExtended, dtDateTime, dtBoolean, dtObject, dtOwnedObject,
  29. dtPointer, dtClass, dtInterface, dtRecord, dtArray, dtVariant);
  30. TValueData = class(TInterfacedObject);
  31. IValueString = interface
  32. ['{CECEF8BB-5C77-4291-8927-FB090577F27D}']
  33. function GetValue : string;
  34. procedure SetValue(const Value : string);
  35. property Value : string read GetValue write SetValue;
  36. end;
  37. TValueString = class(TValueData,IValueString)
  38. strict private
  39. fData : string;
  40. private
  41. function GetValue : string;
  42. procedure SetValue(const Value : string);
  43. public
  44. constructor Create(const Value : string);
  45. property Value : string read GetValue write SetValue;
  46. end;
  47. {$IFDEF MSWINDOWS}
  48. IValueAnsiString = interface
  49. ['{75775F25-6F7A-49F0-A1E0-BDE1F55EC378}']
  50. function GetValue : AnsiString;
  51. procedure SetValue(const Value : AnsiString);
  52. property Value : AnsiString read GetValue write SetValue;
  53. end;
  54. TValueAnsiString = class(TValueData,IValueAnsiString)
  55. strict private
  56. fData : AnsiString;
  57. private
  58. function GetValue : AnsiString;
  59. procedure SetValue(const Value : AnsiString);
  60. public
  61. constructor Create(const Value : AnsiString);
  62. property Value : AnsiString read GetValue write SetValue;
  63. end;
  64. IValueWideString = interface
  65. ['{9094B9CF-46AE-4FE0-AE1D-6E6CDABDAF36}']
  66. function GetValue : WideString;
  67. procedure SetValue(const Value : WideString);
  68. property Value : WideString read GetValue write SetValue;
  69. end;
  70. TValueWideString = class(TValueData,IValueWideString)
  71. strict private
  72. fData : WideString;
  73. private
  74. function GetValue : WideString;
  75. procedure SetValue(const Value : WideString);
  76. public
  77. constructor Create(const Value : WideString);
  78. property Value : WideString read GetValue write SetValue;
  79. end;
  80. {$ENDIF}
  81. IValueInteger = interface
  82. ['{5AB05017-C6F3-49BA-A92C-ECCA252B3E1D}']
  83. function GetValue : Int64;
  84. procedure SetValue(const Value : Int64);
  85. property Value : Int64 read GetValue write SetValue;
  86. end;
  87. { TValueInteger }
  88. TValueInteger= class(TValueData,IValueInteger)
  89. strict private
  90. fData : Int64;
  91. private
  92. function GetValue : Int64;
  93. procedure SetValue(const Value : Int64);
  94. public
  95. constructor Create(const Value : Int64);
  96. property Value : Int64 read GetValue write SetValue;
  97. end;
  98. IValueExtended = interface
  99. ['{D341182F-D4E5-4C07-9E03-68DA118B90B1}']
  100. function GetValue : Extended;
  101. procedure SetValue(const Value : Extended);
  102. property Value : Extended read GetValue write SetValue;
  103. end;
  104. TValueExtended = class(TValueData,IValueExtended)
  105. strict private
  106. fData : Extended;
  107. private
  108. function GetValue : Extended;
  109. procedure SetValue(const Value : Extended);
  110. public
  111. constructor Create(const Value : Extended);
  112. property Value : Extended read GetValue write SetValue;
  113. end;
  114. IValueObject = interface
  115. ['{5828FABC-6C5D-4954-941E-B3580F918A8B}']
  116. function GetValue : TObject;
  117. procedure SetValue(const Value : TObject);
  118. property Value : TObject read GetValue write SetValue;
  119. end;
  120. TValueObject = class(TValueData,IValueObject)
  121. strict private
  122. fData : TObject;
  123. private
  124. function GetValue : TObject;
  125. procedure SetValue(const Value : TObject);
  126. public
  127. constructor Create(const Value : TObject);
  128. property Value : TObject read GetValue write SetValue;
  129. end;
  130. IValuePointer = interface
  131. ['{9FE4E499-C487-4D24-8190-14FF3F9FE86B}']
  132. function GetValue : Pointer;
  133. procedure SetValue(const Value : Pointer);
  134. property Value : Pointer read GetValue write SetValue;
  135. end;
  136. TValuePointer = class(TValueData,IValuePointer)
  137. strict private
  138. fData : Pointer;
  139. private
  140. function GetValue : Pointer;
  141. procedure SetValue(const Value : Pointer);
  142. public
  143. constructor Create(const Value : Pointer);
  144. property Value : Pointer read GetValue write SetValue;
  145. end;
  146. IValueVariant = interface
  147. ['{8B1F8469-B872-47AD-83BB-F51920012943}']
  148. function GetValue : Variant;
  149. procedure SetValue(const Value : Variant);
  150. property Value : Variant read GetValue write SetValue;
  151. end;
  152. TValueVariant = class(TValueData,IValueVariant)
  153. strict private
  154. fData : Variant;
  155. private
  156. function GetValue : Variant;
  157. procedure SetValue(const Value : Variant);
  158. public
  159. constructor Create(const Value : Variant);
  160. property Value : Variant read GetValue write SetValue;
  161. end;
  162. { TFlexValue }
  163. TFlexValue = record
  164. private
  165. {$IFNDEF FPC}
  166. fDataIntf : IInterface;
  167. {$ELSE}
  168. fDataIntf : TValueData;
  169. {$ENDIF}
  170. fDataType : TValueDataType;
  171. function CastToString : string;
  172. {$IFDEF MSWINDOWS}
  173. function CastToAnsiString : AnsiString;
  174. function CastToWideString : WideString;
  175. {$ENDIF}
  176. function CastToBoolean: Boolean;
  177. function CastToClass: TClass;
  178. function CastToExtended: Extended;
  179. function CastToInt64: Int64;
  180. function CastToInteger: Integer;
  181. function CastToDateTime : TDateTime;
  182. function CastToObject: TObject;
  183. function CastToPointer: Pointer;
  184. function CastToInterface: IInterface;
  185. function CastToVariant: Variant;
  186. function CastToCardinal : Cardinal;
  187. function CastToVarRec: TVarRec;
  188. procedure SetAsString(const Value : string);
  189. procedure SetAsVarRec(const Value: TVarRec);
  190. {$IFDEF MSWINDOWS}
  191. procedure SetAsAnsiString(const Value : AnsiString);
  192. procedure SetAsWideString(const Value : WideString);
  193. {$ENDIF}
  194. procedure SetAsBoolean(const Value: Boolean);
  195. procedure SetAsClass(const Value: TClass);
  196. procedure SetAsExtended(const Value: Extended);
  197. procedure SetAsInt64(const Value: Int64);
  198. procedure SetAsInteger(const Value: Integer);
  199. procedure SetAsObject(const Value: TObject);
  200. procedure SetAsPointer(const Value: Pointer);
  201. procedure SetAsDateTime(const Value : TDateTime);
  202. procedure SetAsVariant(const Value: Variant);
  203. procedure SetAsCardinal(const Value : Cardinal);
  204. procedure SetAsInterface(const Value: IInterface);
  205. public
  206. constructor Create(const Value: TVarRec);
  207. property DataType : TValueDataType read fDataType;
  208. property AsString : string read CastToString write SetAsString;
  209. {$IFDEF MSWINDOWS}
  210. property AsAnsiString : AnsiString read CastToAnsiString write SetAsAnsiString;
  211. property AsWideString : WideString read CastToWideString write SetAsWideString;
  212. {$ENDIF}
  213. property AsInteger : Integer read CastToInteger write SetAsInteger;
  214. property AsInt64 : Int64 read CastToInt64 write SetAsInt64;
  215. property AsExtended : Extended read CastToExtended write SetAsExtended;
  216. property AsBoolean : Boolean read CastToBoolean write SetAsBoolean;
  217. property AsPointer : Pointer read CastToPointer write SetAsPointer;
  218. property AsClass : TClass read CastToClass write SetAsClass;
  219. property AsInterface : IInterface read CastToInterface write SetAsInterface;
  220. property AsObject : TObject read CastToObject write SetAsObject;
  221. property AsVariant : Variant read CastToVariant write SetAsVariant;
  222. property AsCardinal : Cardinal read CastToCardinal write SetAsCardinal;
  223. property AsDateTime : TDateTime read CastToDateTime write SetAsDateTime;
  224. property AsVarRec : TVarRec read CastToVarRec write SetAsVarRec;
  225. //function AsType<T> : T;
  226. function IsNullOrEmpty : Boolean; inline;
  227. function IsString : Boolean; inline;
  228. function IsInteger : Boolean; inline;
  229. function IsFloating : Boolean; inline;
  230. function IsDateTime : Boolean; inline;
  231. function IsBoolean : Boolean; inline;
  232. function IsInterface : Boolean; inline;
  233. function IsObject : Boolean; inline;
  234. function IsPointer : Boolean; inline;
  235. function IsVariant : Boolean; inline;
  236. procedure Clear; inline;
  237. procedure _AddRef; inline;
  238. procedure _Release; inline;
  239. class operator Implicit(const Value : TFlexValue) : string;
  240. class operator Implicit(Value : TFlexValue) : Integer;
  241. class operator Implicit(Value : TFlexValue) : Int64;
  242. class operator Implicit(Value : TFlexValue) : Extended;
  243. class operator Implicit(Value : TFlexValue) : TDateTime;
  244. class operator Implicit(Value : TFlexValue) : Boolean;
  245. class operator Implicit(Value : TFlexValue) : TClass;
  246. class operator Implicit(Value : TFlexValue) : TObject;
  247. class operator Implicit(Value : TFlexValue) : Pointer;
  248. class operator Implicit(Value : TFlexValue) : Variant;
  249. class operator Implicit(Value : TFlexValue) : TVarRec;
  250. class operator Implicit(const Value : string) : TFlexValue;
  251. class operator Implicit(Value : Integer) : TFlexValue;
  252. class operator Implicit(Value : Int64) : TFlexValue;
  253. class operator Implicit(Value : Extended) : TFlexValue;
  254. class operator Implicit(Value : TDateTime) : TFlexValue;
  255. class operator Implicit(Value : Boolean) : TFlexValue;
  256. class operator Implicit(Value : TClass) : TFlexValue;
  257. class operator Implicit(Value : TObject) : TFlexValue;
  258. class operator Implicit(Value : Pointer) : TFlexValue;
  259. class operator Implicit(Value : Variant) : TFlexValue;
  260. class operator Implicit(Value : TVarRec) : TFlexValue;
  261. class operator Equal(a : TFlexValue; b : string) : Boolean;
  262. class operator Equal(a : TFlexValue; b : Integer) : Boolean;
  263. class operator Equal(a : TFlexValue; b : Int64) : Boolean;
  264. class operator Equal(a : TFlexValue; b : Extended) : Boolean;
  265. class operator Equal(a : TFlexValue; b : Boolean) : Boolean;
  266. class operator NotEqual(a : TFlexValue; b : string) : Boolean;
  267. class operator NotEqual(a : TFlexValue; b : Integer) : Boolean;
  268. class operator NotEqual(a : TFlexValue; b : Int64) : Boolean;
  269. class operator NotEqual(a : TFlexValue; b : Extended) : Boolean;
  270. class operator NotEqual(a : TFlexValue; b : Boolean) : Boolean;
  271. class operator GreaterThan(a : TFlexValue; b : Integer) : Boolean;
  272. class operator GreaterThan(a : TFlexValue; b : Int64) : Boolean;
  273. class operator GreaterThan(a : TFlexValue; b : Extended) : Boolean;
  274. class operator GreaterThanOrEqual(a : TFlexValue; b : Integer) : Boolean;
  275. class operator GreaterThanOrEqual(a : TFlexValue; b : Int64) : Boolean;
  276. class operator GreaterThanOrEqual(a : TFlexValue; b : Extended) : Boolean;
  277. class operator LessThan(a : TFlexValue; b : Integer) : Boolean;
  278. class operator LessThan(a : TFlexValue; b : Int64) : Boolean;
  279. class operator LessThan(a : TFlexValue; b : Extended) : Boolean;
  280. class operator LessThanOrEqual(a : TFlexValue; b : Integer) : Boolean;
  281. class operator LessThanOrEqual(a : TFlexValue; b : Int64) : Boolean;
  282. class operator LessThanOrEqual(a : TFlexValue; b : Extended) : Boolean;
  283. end;
  284. PFlexValue = ^TFlexValue;
  285. TFlexPair = record
  286. Name : string;
  287. Value : TFlexValue;
  288. constructor Create(const aName : string; aValue : TFlexValue);
  289. end;
  290. implementation
  291. function TFlexValue.CastToString: string;
  292. begin
  293. try
  294. case fDataType of
  295. dtNull : Result := '';
  296. dtString : Result := (fDataIntf as IValueString).Value;
  297. {$IFDEF MSWINDOWS}
  298. dtAnsiString : Result := string((fDataIntf as IValueAnsiString).Value);
  299. dtWideString : Result := (fDataIntf as IValueWideString).Value;
  300. {$ENDIF}
  301. dtInteger,
  302. dtInt64 : Result := IntToStr(AsInt64);
  303. dtBoolean : Result := BoolToStr(AsBoolean,True);
  304. dtDouble,
  305. dtExtended : Result := FloatToStr(AsExtended);
  306. dtDateTime : Result := DateTimeToStr(AsExtended);
  307. dtVariant : Result := string(AsVariant);
  308. dtClass : Result := AsClass.ClassName;
  309. else raise Exception.Create('DataType not supported');
  310. end;
  311. except
  312. on E : Exception do raise Exception.CreateFmt('TFlexValue conversion to String error: %s',[e.message]);
  313. end;
  314. end;
  315. {$IFDEF MSWINDOWS}
  316. function TFlexValue.CastToAnsiString: AnsiString;
  317. begin
  318. try
  319. case fDataType of
  320. dtNull : Result := '';
  321. dtString : Result := AnsiString((fDataIntf as IValueString).Value);
  322. dtAnsiString : Result := (fDataIntf as IValueAnsiString).Value;
  323. dtWideString : Result := AnsiString((fDataIntf as IValueWideString).Value);
  324. dtInteger,
  325. dtInt64 : Result := AnsiString(IntToStr(AsInt64));
  326. dtBoolean : Result := AnsiString(BoolToStr(AsBoolean,True));
  327. dtDouble,
  328. dtExtended : Result := AnsiString(FloatToStr(AsExtended));
  329. dtDateTime : Result := AnsiString(DateTimeToStr(AsExtended));
  330. dtVariant : Result := AnsiString(AsVariant);
  331. else raise Exception.Create('DataType not supported');
  332. end;
  333. except
  334. on E : Exception do raise Exception.CreateFmt('TFlexValue conversion to AnsiString error: %s',[e.message]);
  335. end;
  336. end;
  337. function TFlexValue.CastToWideString: WideString;
  338. begin
  339. try
  340. case fDataType of
  341. dtNull : Result := '';
  342. dtString : Result := Widestring((fDataIntf as IValueString).Value);
  343. {$IFDEF MSWINDOWS}
  344. dtAnsiString : Result := Widestring((fDataIntf as IValueAnsiString).Value);
  345. dtWideString : Result := (fDataIntf as IValueWideString).Value;
  346. {$ENDIF}
  347. dtInteger,
  348. dtInt64 : Result := Widestring(IntToStr(AsInt64));
  349. dtBoolean : Result := Widestring(BoolToStr(AsBoolean,True));
  350. dtDouble,
  351. dtExtended : Result := Widestring(FloatToStr(AsExtended));
  352. dtDateTime : Result := Widestring(DateTimeToStr(AsExtended));
  353. dtVariant : Result := Widestring(AsVariant);
  354. else raise Exception.Create('DataType not supported');
  355. end;
  356. except
  357. on E : Exception do raise Exception.CreateFmt('TFlexValue conversion to WideString error: %s',[e.message]);
  358. end;
  359. end;
  360. {$ENDIF}
  361. function TFlexValue.CastToBoolean: Boolean;
  362. begin
  363. try
  364. case fDataType of
  365. dtNull : Result := False;
  366. dtString : Result := StrToBool((fDataIntf as IValueString).Value);
  367. {$IFDEF MSWINDOWS}
  368. dtAnsiString : Result := StrToBool(string((fDataIntf as IValueAnsiString).Value));
  369. dtWideString : Result := StrToBool((fDataIntf as IValueWideString).Value);
  370. {$ENDIF}
  371. dtInteger,
  372. dtInt64 :
  373. begin
  374. if (fDataIntf as IValueInteger).Value = 1 then Result := True
  375. else if (fDataIntf as IValueInteger).Value = 0 then Result := False
  376. else raise Exception.Create('Integer value not in 0-1 range');
  377. end;
  378. dtBoolean : Result := Boolean((fDataIntf as IValueInteger).Value);
  379. dtVariant : Result := Boolean(AsVariant);
  380. else raise Exception.Create('DataType not supported');
  381. end;
  382. except
  383. on E : Exception do raise Exception.CreateFmt('TFlexValue conversion to Boolean error: %s',[e.message]);
  384. end;
  385. end;
  386. function TFlexValue.CastToCardinal: Cardinal;
  387. begin
  388. Result := AsInt64;
  389. end;
  390. function TFlexValue.CastToClass: TClass;
  391. begin
  392. try
  393. case fDataType of
  394. dtNull : Result := nil;
  395. dtClass : Result := (fDataIntf as TValuePointer).Value;
  396. else raise Exception.Create('DataType not supported');
  397. end;
  398. except
  399. on E : Exception do raise Exception.CreateFmt('TFlexValue conversion to TClass error: %s',[e.message]);
  400. end;
  401. end;
  402. function TFlexValue.CastToDateTime: TDateTime;
  403. begin
  404. try
  405. case fDataType of
  406. dtNull : Result := 0.0;
  407. dtString : Result := StrToDateTime((fDataIntf as IValueString).Value);
  408. {$IFDEF MSWINDOWS}
  409. dtAnsiString : Result := StrToDateTime(string((fDataIntf as IValueAnsiString).Value));
  410. dtWideString : Result := StrToDateTime((fDataIntf as IValueWideString).Value);
  411. {$ENDIF}
  412. dtInteger,
  413. dtInt64 : Result := FileDateToDateTime(AsInt64);
  414. dtDouble,
  415. dtExtended,
  416. dtDateTime : Result := (fDataIntf as IValueExtended).Value;
  417. dtVariant : Result := Extended(AsVariant);
  418. else raise Exception.Create('DataType not supported');
  419. end;
  420. except
  421. on E : Exception do raise Exception.CreateFmt('TFlexValue conversion to Extended error: %s',[e.message]);
  422. end;
  423. end;
  424. function TFlexValue.CastToExtended: Extended;
  425. begin
  426. try
  427. case fDataType of
  428. dtNull : Result := 0.0;
  429. dtString : Result := StrToFloat((fDataIntf as IValueString).Value);
  430. {$IFDEF MSWINDOWS}
  431. dtAnsiString : Result := StrToFloat(string((fDataIntf as IValueAnsiString).Value));
  432. dtWideString : Result := StrToFloat((fDataIntf as IValueWideString).Value);
  433. {$ENDIF}
  434. dtInteger,
  435. dtInt64 : Result := AsInt64;
  436. dtBoolean : Result := AsInt64;
  437. dtDouble,
  438. dtExtended,
  439. dtDateTime : Result := (fDataIntf as IValueExtended).Value;
  440. dtVariant : Result := Extended(AsVariant);
  441. else raise Exception.Create('DataType not supported');
  442. end;
  443. except
  444. on E : Exception do raise Exception.CreateFmt('TFlexValue conversion to Extended error: %s',[e.message]);
  445. end;
  446. end;
  447. function TFlexValue.CastToInt64: Int64;
  448. begin
  449. try
  450. case fDataType of
  451. dtNull : Result := 0;
  452. dtString : Result := StrToInt((fDataIntf as IValueString).Value);
  453. {$IFDEF MSWINDOWS}
  454. dtAnsiString : Result := StrToInt(string((fDataIntf as IValueAnsiString).Value));
  455. dtWideString : Result := StrToInt((fDataIntf as IValueWideString).Value);
  456. {$ENDIF}
  457. dtInteger,
  458. dtInt64 : Result := (fDataIntf as IValueInteger).Value;
  459. dtBoolean : Result := Integer(AsBoolean);
  460. dtDateTime : Result := DateTimeToFileDate((fDataIntf as IValueExtended).Value);
  461. dtVariant : Result := Integer(AsVariant);
  462. else raise Exception.Create('DataType not supported');
  463. end;
  464. except
  465. on E : Exception do raise Exception.CreateFmt('TFlexValue conversion to Integer error: %s',[e.message]);
  466. end;
  467. end;
  468. function TFlexValue.CastToInteger: Integer;
  469. begin
  470. Result := AsInt64;
  471. end;
  472. function TFlexValue.CastToObject: TObject;
  473. begin
  474. try
  475. case fDataType of
  476. dtObject,
  477. dtOwnedObject : Result := (fDataIntf as IValueObject).Value;
  478. {$IFNDEF FPC}
  479. dtPointer : Result := TObject((fDataIntf as IValueObject).Value);
  480. {$ELSE}
  481. dtPointer : Result := TObject((fDataIntf as IValuePointer).Value);
  482. {$ENDIF}
  483. dtNull : Result := nil;
  484. else raise Exception.Create('DataType not supported');
  485. end;
  486. except
  487. on E : Exception do raise Exception.CreateFmt('TFlexValue conversion to Object error: %s',[e.message]);
  488. end;
  489. end;
  490. function TFlexValue.CastToPointer: Pointer;
  491. begin
  492. try
  493. case fDataType of
  494. dtObject,
  495. dtOwnedObject : Result := Pointer((fDataIntf as IValueObject).Value);
  496. dtPointer : Result := (fDataIntf as IValuePointer).Value;
  497. dtNull : Result := nil;
  498. else raise Exception.Create('DataType not supported');
  499. end;
  500. except
  501. on E : Exception do raise Exception.CreateFmt('TFlexValue conversion to Pointer error: %s',[e.message]);
  502. end;
  503. end;
  504. function TFlexValue.CastToVariant: Variant;
  505. begin
  506. try
  507. case fDataType of
  508. dtNull : Result := Variants.Null;
  509. dtBoolean : Result := AsVariant;
  510. {$IFDEF MSWINDOWS}
  511. dtAnsiString : Result := string((fDataIntf as IValueAnsiString).Value);
  512. dtWideString : Result := (fDataIntf as IValueWideString).Value;
  513. {$ENDIF}
  514. dtString : Result := (fDataIntf as IValueString).Value;
  515. dtInteger,
  516. dtInt64 : Result := (fDataIntf as IValueInteger).Value;
  517. dtVariant : Result := (fDataIntf as IValueVariant).Value;
  518. else raise Exception.Create('DataType not supported');
  519. end;
  520. except
  521. on E : Exception do raise Exception.CreateFmt('TFlexValue conversion to Variant error: %s',[e.message]);
  522. end;
  523. end;
  524. function TFlexValue.CastToVarRec: TVarRec;
  525. begin
  526. try
  527. case fDataType of
  528. dtNull : Result.VPointer := nil;
  529. dtBoolean : Result.VBoolean := AsBoolean;
  530. {$IFDEF MSWINDOWS}
  531. dtAnsiString : Result.VAnsiString := Pointer((fDataIntf as IValueAnsiString).Value);
  532. dtWideString : Result.VWideString := Pointer((fDataIntf as IValueWideString).Value);
  533. {$ENDIF}
  534. {$IFNDEF NEXTGEN}
  535. dtString : Result.VString := Pointer((fDataIntf as IValueString).Value);
  536. {$ELSE}
  537. dtString : Result.VUnicodeString := Pointer((fDataIntf as IValueString));
  538. {$ENDIF}
  539. dtInteger : Result.VInteger := (fDataIntf as IValueInteger).Value;
  540. dtInt64 : Result.VInt64 := Pointer((fDataIntf as IValueInteger).Value);
  541. //dtVariant : Result.VVariant := ^fDataIntf as IValueVariant).Value;
  542. dtObject : Result.VObject := AsObject;
  543. dtPointer : Result.VPointer := AsPointer;
  544. else raise Exception.Create('DataType not supported');
  545. end;
  546. except
  547. on E : Exception do raise Exception.CreateFmt('TFlexValue conversion to TVarRec error: %s',[e.message]);
  548. end;
  549. end;
  550. function TFlexValue.CastToInterface: IInterface;
  551. begin
  552. try
  553. case fDataType of
  554. dtNull : Result := nil;
  555. dtInterface : Result := fDataIntf;
  556. dtPointer : Result := IInterface(fDataIntf);
  557. else raise Exception.Create('DataType not supported');
  558. end;
  559. except
  560. on E : Exception do raise Exception.CreateFmt('TFlexValue conversion to Interface error: %s',[e.message]);
  561. end;
  562. end;
  563. procedure TFlexValue.Clear;
  564. begin
  565. if Pointer(fDataIntf) <> nil then fDataIntf := nil;
  566. fDataType := dtNull;
  567. end;
  568. constructor TFlexValue.Create(const Value: TVarRec);
  569. begin
  570. case Value.VType of
  571. {$IFNDEF NEXTGEN}
  572. vtString : AsString := string(Value.VString^);
  573. vtChar : AsString := string(Value.VChar);
  574. {$ENDIF}
  575. {$IFDEF MSWINDOWS}
  576. vtAnsiString : AsAnsiString := AnsiString(Value.VAnsiString);
  577. vtWideString : AsWideString := WideString(Value.VWideString);
  578. {$ENDIF}
  579. {$IFDEF UNICODE}
  580. vtUnicodeString: AsString := string(Value.VUnicodeString);
  581. {$ENDIF UNICODE}
  582. vtInteger : AsInteger := Value.VInteger;
  583. vtInt64 : AsInt64 := Value.VInt64^;
  584. vtExtended : AsExtended := Value.VExtended^;
  585. vtBoolean : AsBoolean := Value.VBoolean;
  586. vtVariant : AsVariant := Value.VVariant^;
  587. vtInterface : AsInterface := IInterface(Value.VInterface);
  588. vtClass : AsClass := Value.VClass;
  589. vtObject : AsObject := Value.VObject;
  590. vtPointer : AsPointer := Value.VPointer;
  591. else raise Exception.Create('DataType not supported by TFlexValue');
  592. end;
  593. {$IFDEF FPC}
  594. fDataIntf._AddRef;
  595. {$ENDIF}
  596. end;
  597. class operator TFlexValue.Implicit(Value: TFlexValue): Boolean;
  598. begin
  599. Result := Value.AsBoolean;
  600. end;
  601. class operator TFlexValue.Implicit(const Value: TFlexValue): string;
  602. begin
  603. Result := Value.AsString;
  604. end;
  605. class operator TFlexValue.Implicit(Value: TFlexValue): TObject;
  606. begin
  607. Result := Value.AsObject;
  608. end;
  609. class operator TFlexValue.Implicit(Value: TFlexValue): Pointer;
  610. begin
  611. Result := Value.AsPointer;
  612. end;
  613. class operator TFlexValue.Implicit(Value: TFlexValue): TDateTime;
  614. begin
  615. Result := Value.AsDateTime;
  616. end;
  617. class operator TFlexValue.Implicit(Value: TFlexValue): TClass;
  618. begin
  619. Result := Value.AsClass;
  620. end;
  621. class operator TFlexValue.Implicit(Value: TFlexValue): Int64;
  622. begin
  623. Result := Value.AsInt64;
  624. end;
  625. class operator TFlexValue.Implicit(Value: TFlexValue): Integer;
  626. begin
  627. Result := Value.AsInteger;
  628. end;
  629. class operator TFlexValue.Implicit(Value: TFlexValue): Extended;
  630. begin
  631. Result := Value.AsExtended;
  632. end;
  633. class operator TFlexValue.Implicit(Value: TFlexValue): Variant;
  634. begin
  635. Result := Value.AsVariant;
  636. end;
  637. class operator TFlexValue.Implicit(Value: TFlexValue): TVarRec;
  638. begin
  639. Result := Value.AsVarRec;
  640. end;
  641. class operator TFlexValue.Implicit(Value: Variant): TFlexValue;
  642. begin
  643. Result.AsVariant := Value;
  644. end;
  645. class operator TFlexValue.Implicit(const Value : string) : TFlexValue;
  646. begin
  647. Result.AsString := Value;
  648. end;
  649. class operator TFlexValue.Implicit(Value : Integer) : TFlexValue;
  650. begin
  651. Result.AsInteger := Value;
  652. end;
  653. class operator TFlexValue.Implicit(Value : Int64) : TFlexValue;
  654. begin
  655. Result.AsInt64 := Value;
  656. end;
  657. class operator TFlexValue.Implicit(Value : Extended) : TFlexValue;
  658. begin
  659. Result.AsExtended := Value;
  660. end;
  661. class operator TFlexValue.Implicit(Value : TDateTime) : TFlexValue;
  662. begin
  663. Result.AsDateTime := Value;
  664. end;
  665. class operator TFlexValue.Implicit(Value : Boolean) : TFlexValue;
  666. begin
  667. Result.AsBoolean := Value;
  668. end;
  669. class operator TFlexValue.Implicit(Value : TClass) : TFlexValue;
  670. begin
  671. Result.AsClass := Value;
  672. end;
  673. class operator TFlexValue.Implicit(Value : TObject) : TFlexValue;
  674. begin
  675. Result.AsObject := Value;
  676. end;
  677. class operator TFlexValue.Implicit(Value : Pointer) : TFlexValue;
  678. begin
  679. Result.AsPointer := Value;
  680. end;
  681. class operator TFlexValue.Implicit(Value: TVarRec): TFlexValue;
  682. begin
  683. Result.AsVarRec := Value;
  684. end;
  685. class operator TFlexValue.Equal(a: TFlexValue; b: string): Boolean;
  686. begin
  687. Result := a.AsString = b;
  688. end;
  689. class operator TFlexValue.Equal(a: TFlexValue; b: Int64): Boolean;
  690. begin
  691. Result := a.AsInt64 = b;
  692. end;
  693. class operator TFlexValue.Equal(a: TFlexValue; b: Extended): Boolean;
  694. begin
  695. Result := a.AsExtended = b;
  696. end;
  697. class operator TFlexValue.Equal(a: TFlexValue; b: Boolean): Boolean;
  698. begin
  699. Result := a.AsBoolean = b;
  700. end;
  701. class operator TFlexValue.Equal(a : TFlexValue; b : Integer) : Boolean;
  702. begin
  703. Result := a.AsInteger = b;
  704. end;
  705. class operator TFlexValue.NotEqual(a: TFlexValue; b: Int64): Boolean;
  706. begin
  707. Result := a.AsInt64 <> b;
  708. end;
  709. class operator TFlexValue.NotEqual(a: TFlexValue; b: Integer): Boolean;
  710. begin
  711. Result := a.AsInteger <> b;
  712. end;
  713. class operator TFlexValue.NotEqual(a: TFlexValue; b: string): Boolean;
  714. begin
  715. Result := a.AsString <> b;
  716. end;
  717. class operator TFlexValue.NotEqual(a: TFlexValue; b: Boolean): Boolean;
  718. begin
  719. Result := a.AsBoolean <> b;
  720. end;
  721. class operator TFlexValue.NotEqual(a: TFlexValue; b: Extended): Boolean;
  722. begin
  723. Result := a.AsExtended <> b;
  724. end;
  725. class operator TFlexValue.GreaterThan(a: TFlexValue; b: Integer): Boolean;
  726. begin
  727. Result := a.AsInteger > b;
  728. end;
  729. class operator TFlexValue.GreaterThan(a: TFlexValue; b: Int64): Boolean;
  730. begin
  731. Result := a.AsInt64 > b;
  732. end;
  733. class operator TFlexValue.GreaterThan(a: TFlexValue; b: Extended): Boolean;
  734. begin
  735. Result := a.AsExtended > b;
  736. end;
  737. class operator TFlexValue.GreaterThanOrEqual(a: TFlexValue; b: Integer): Boolean;
  738. begin
  739. Result := a.AsInteger >= b;
  740. end;
  741. class operator TFlexValue.GreaterThanOrEqual(a: TFlexValue; b: Int64): Boolean;
  742. begin
  743. Result := a.AsInt64 >= b;
  744. end;
  745. class operator TFlexValue.GreaterThanOrEqual(a: TFlexValue; b: Extended): Boolean;
  746. begin
  747. Result := a.AsExtended >= b;
  748. end;
  749. class operator TFlexValue.LessThan(a: TFlexValue; b: Integer): Boolean;
  750. begin
  751. Result := a.AsInteger < b;
  752. end;
  753. class operator TFlexValue.LessThan(a: TFlexValue; b: Int64): Boolean;
  754. begin
  755. Result := a.AsInt64 < b;
  756. end;
  757. class operator TFlexValue.LessThan(a: TFlexValue; b: Extended): Boolean;
  758. begin
  759. Result := a.AsExtended < b;
  760. end;
  761. class operator TFlexValue.LessThanOrEqual(a: TFlexValue; b : Integer): Boolean;
  762. begin
  763. Result := a.AsInteger <= b;
  764. end;
  765. class operator TFlexValue.LessThanOrEqual(a: TFlexValue; b : Int64): Boolean;
  766. begin
  767. Result := a.AsInt64 <= b;
  768. end;
  769. class operator TFlexValue.LessThanOrEqual(a: TFlexValue; b: Extended): Boolean;
  770. begin
  771. Result := a.AsExtended <= b;
  772. end;
  773. function TFlexValue.IsBoolean: Boolean;
  774. begin
  775. Result := fDataType = dtBoolean;
  776. end;
  777. function TFlexValue.IsDateTime: Boolean;
  778. begin
  779. Result := fDataType = dtDateTime;
  780. end;
  781. function TFlexValue.IsFloating: Boolean;
  782. begin
  783. Result := fDataType in [dtDouble,dtExtended];
  784. end;
  785. function TFlexValue.IsInteger: Boolean;
  786. begin
  787. Result := fDataType in [dtInteger,dtInt64];
  788. end;
  789. function TFlexValue.IsInterface: Boolean;
  790. begin
  791. Result := fDataType = dtInterface;
  792. end;
  793. function TFlexValue.IsNullOrEmpty: Boolean;
  794. begin
  795. Result := fDataIntf = nil;
  796. end;
  797. function TFlexValue.IsObject: Boolean;
  798. begin
  799. Result := fDataType = dtObject;
  800. end;
  801. function TFlexValue.IsPointer: Boolean;
  802. begin
  803. Result := fDataType = dtPointer;
  804. end;
  805. function TFlexValue.IsString: Boolean;
  806. begin
  807. Result := fDataType in [dtString,dtAnsiString,dtWideString];
  808. end;
  809. function TFlexValue.IsVariant: Boolean;
  810. begin
  811. Result := fDataType = dtVariant;
  812. end;
  813. {$IFDEF MSWINDOWS}
  814. procedure TFlexValue.SetAsAnsiString(const Value: AnsiString);
  815. begin
  816. Clear;
  817. fDataIntf := TValueAnsiString.Create(Value);
  818. fDataType := TValueDataType.dtAnsiString;
  819. end;
  820. {$ENDIF}
  821. procedure TFlexValue.SetAsBoolean(const Value: Boolean);
  822. begin
  823. Clear;
  824. fDataIntf := TValueInteger.Create(Value.ToInteger);
  825. fDataType := TValueDataType.dtBoolean;
  826. end;
  827. procedure TFlexValue.SetAsCardinal(const Value: Cardinal);
  828. begin
  829. Clear;
  830. fDataIntf := TValueInteger.Create(Value);
  831. fDataType := TValueDataType.dtInt64;
  832. end;
  833. procedure TFlexValue.SetAsClass(const Value: TClass);
  834. begin
  835. Clear;
  836. fDataIntf := TValuePointer.Create(Value);
  837. fDataType := TValueDataType.dtClass;
  838. end;
  839. procedure TFlexValue.SetAsDateTime(const Value: TDateTime);
  840. begin
  841. Clear;
  842. fDataIntf := TValueExtended.Create(Value);
  843. fDataType := TValueDataType.dtDateTime;
  844. end;
  845. procedure TFlexValue.SetAsExtended(const Value: Extended);
  846. begin
  847. Clear;
  848. fDataIntf := TValueExtended.Create(Value);
  849. fDataType := TValueDataType.dtExtended;
  850. end;
  851. procedure TFlexValue.SetAsInt64(const Value: Int64);
  852. begin
  853. Clear;
  854. fDataIntf := TValueInteger.Create(Value);
  855. fDataType := TValueDataType.dtInt64;
  856. end;
  857. procedure TFlexValue.SetAsInteger(const Value: Integer);
  858. begin
  859. Clear;
  860. fDataIntf := TValueInteger.Create(Value);
  861. fDataType := TValueDataType.dtInteger;
  862. end;
  863. procedure TFlexValue.SetAsInterface(const Value: IInterface);
  864. begin
  865. {$IFNDEF FPC}
  866. fDataIntf := Value;
  867. {$ELSE}
  868. fDataIntf := Pointer(Value);
  869. {$ENDIF}
  870. fDataType := TValueDataType.dtInterface;
  871. end;
  872. procedure TFlexValue.SetAsObject(const Value: TObject);
  873. begin
  874. Clear;
  875. fDataIntf := TValueObject.Create(Value);
  876. fDataType := TValueDataType.dtObject;
  877. end;
  878. procedure TFlexValue.SetAsPointer(const Value: Pointer);
  879. begin
  880. Clear;
  881. fDataIntf := TValuePointer.Create(Value);
  882. fDataType := TValueDataType.dtPointer;
  883. end;
  884. procedure TFlexValue.SetAsString(const Value: string);
  885. begin
  886. Clear;
  887. fDataIntf := TValueString.Create(Value);
  888. fDataType := TValueDataType.dtString;
  889. end;
  890. function TryVarAsType(aValue : Variant; aVarType : Word) : Boolean;
  891. begin
  892. try
  893. VarAsType(aValue,aVarType);
  894. Result := True;
  895. except
  896. Result := False;
  897. end;
  898. end;
  899. procedure TFlexValue.SetAsVariant(const Value: Variant);
  900. begin
  901. Clear;
  902. case VarType(Value) and varTypeMask of
  903. varEmpty,
  904. varNull : Clear;
  905. varSmallInt,
  906. varInteger,
  907. varByte,
  908. varWord,
  909. varLongWord,
  910. varInt64 : SetAsInt64(Value);
  911. varSingle,
  912. varDouble,
  913. varCurrency : SetAsExtended(Value);
  914. varDate : SetAsDateTime(Value);
  915. varOleStr : SetAsString(Value);
  916. varDispatch : begin
  917. if TryVarAsType(Value,varInt64) then SetAsInt64(Value)
  918. else if TryVarAsType(Value,varDouble) then SetAsExtended(Value)
  919. else if TryVarAsType(Value,varBoolean) then SetAsBoolean(Value)
  920. else if TryVarAsType(Value,varString) then SetAsString(Value)
  921. else
  922. begin
  923. fDataIntf := TValueVariant.Create(Value);
  924. fDataType := TValueDataType.dtVariant;
  925. end;
  926. end;
  927. //varError : typeString := 'varError';
  928. varBoolean : SetAsBoolean(Value);
  929. //varStrArg : typeString := 'varStrArg';
  930. varString : SetAsString(Value);
  931. //varAny : typeString := 'varAny';
  932. //varTypeMask : typeString := 'varTypeMask';
  933. else
  934. begin
  935. fDataIntf := TValueVariant.Create(Value);
  936. fDataType := TValueDataType.dtVariant;
  937. end;
  938. end;
  939. end;
  940. {$IFDEF MSWINDOWS}
  941. procedure TFlexValue.SetAsWideString(const Value: WideString);
  942. begin
  943. Clear;
  944. fDataIntf := TValueWideString.Create(Value);
  945. fDataType := TValueDataType.dtWideString;
  946. end;
  947. {$ENDIF}
  948. procedure TFlexValue.SetAsVarRec(const Value: TVarRec);
  949. begin
  950. case Value.VType of
  951. {$IFNDEF NEXTGEN}
  952. vtString : AsString := string(Value.VString^);
  953. vtChar : AsString := string(Value.VChar);
  954. {$ENDIF}
  955. {$IFDEF MSWINDOWS}
  956. vtAnsiString : AsAnsiString := AnsiString(Value.VAnsiString);
  957. vtWideString : AsWideString := WideString(Value.VWideString);
  958. {$ENDIF}
  959. {$IFDEF UNICODE}
  960. vtUnicodeString: AsString := string(Value.VUnicodeString);
  961. {$ENDIF UNICODE}
  962. vtInteger : AsInteger := Value.VInteger;
  963. vtInt64 : AsInt64 := Value.VInt64^;
  964. vtExtended : AsExtended := Value.VExtended^;
  965. vtBoolean : AsBoolean := Value.VBoolean;
  966. vtVariant : AsVariant := Value.VVariant^;
  967. vtInterface : AsInterface := IInterface(Value.VInterface);
  968. vtClass : AsClass := Value.VClass;
  969. vtObject : AsObject := Value.VObject;
  970. vtPointer : AsPointer := Value.VPointer;
  971. else raise Exception.Create('DataType not supported by TFlexValue');
  972. end;
  973. {$IFDEF FPC}
  974. fDataIntf._AddRef;
  975. {$ENDIF}
  976. end;
  977. procedure TFlexValue._AddRef;
  978. begin
  979. if Assigned(fDataIntf) then fDataIntf._AddRef;
  980. end;
  981. procedure TFlexValue._Release;
  982. begin
  983. if Assigned(fDataIntf) then fDataIntf._Release;
  984. end;
  985. { TValueStringData }
  986. constructor TValueString.Create(const Value: string);
  987. begin
  988. fData := Value;
  989. end;
  990. function TValueString.GetValue: string;
  991. begin
  992. Result := fData;
  993. end;
  994. procedure TValueString.SetValue(const Value: string);
  995. begin
  996. fData := Value;
  997. end;
  998. { TValueVariantData }
  999. constructor TValueVariant.Create(const Value: Variant);
  1000. begin
  1001. fData := Value;
  1002. end;
  1003. function TValueVariant.GetValue: Variant;
  1004. begin
  1005. Result := fData;
  1006. end;
  1007. procedure TValueVariant.SetValue(const Value: Variant);
  1008. begin
  1009. fData := Value;
  1010. end;
  1011. { TValueAnsiStringData }
  1012. {$IFDEF MSWINDOWS}
  1013. constructor TValueAnsiString.Create(const Value: AnsiString);
  1014. begin
  1015. fData := Value;
  1016. end;
  1017. function TValueAnsiString.GetValue: AnsiString;
  1018. begin
  1019. Result := fData;
  1020. end;
  1021. procedure TValueAnsiString.SetValue(const Value: AnsiString);
  1022. begin
  1023. fData := Value;
  1024. end;
  1025. { TValueWideStringData }
  1026. constructor TValueWideString.Create(const Value: WideString);
  1027. begin
  1028. fData := Value;
  1029. end;
  1030. function TValueWideString.GetValue: WideString;
  1031. begin
  1032. Result := fData;
  1033. end;
  1034. procedure TValueWideString.SetValue(const Value: WideString);
  1035. begin
  1036. fData := Value;
  1037. end;
  1038. {$ENDIF}
  1039. { TValueInteger }
  1040. constructor TValueInteger.Create(const Value: Int64);
  1041. begin
  1042. fData := Value;
  1043. end;
  1044. function TValueInteger.GetValue: Int64;
  1045. begin
  1046. Result := fData;
  1047. end;
  1048. procedure TValueInteger.SetValue(const Value: Int64);
  1049. begin
  1050. fData := Value;
  1051. end;
  1052. { TValuePointer }
  1053. constructor TValuePointer.Create(const Value: Pointer);
  1054. begin
  1055. fData := Value;
  1056. end;
  1057. function TValuePointer.GetValue: Pointer;
  1058. begin
  1059. Result := fData;
  1060. end;
  1061. procedure TValuePointer.SetValue(const Value: Pointer);
  1062. begin
  1063. fData := Value;
  1064. end;
  1065. { TValueExtended }
  1066. constructor TValueExtended.Create(const Value: Extended);
  1067. begin
  1068. fData := Value;
  1069. end;
  1070. function TValueExtended.GetValue: Extended;
  1071. begin
  1072. Result := fData;
  1073. end;
  1074. procedure TValueExtended.SetValue(const Value: Extended);
  1075. begin
  1076. fData := Value;
  1077. end;
  1078. { TValueObject }
  1079. constructor TValueObject.Create(const Value: TObject);
  1080. begin
  1081. fData := Value;
  1082. end;
  1083. function TValueObject.GetValue: TObject;
  1084. begin
  1085. Result := fData;
  1086. end;
  1087. procedure TValueObject.SetValue(const Value: TObject);
  1088. begin
  1089. fData := Value;
  1090. end;
  1091. { TFlexPair }
  1092. constructor TFlexPair.Create(const aName: string; aValue: TFlexValue);
  1093. begin
  1094. Name := aName;
  1095. Value := aValue;
  1096. end;
  1097. end.