Quick.Value.pas 29 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057
  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 : 03/04/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. procedure SetAsString(const Value : string);
  188. {$IFDEF MSWINDOWS}
  189. procedure SetAsAnsiString(const Value : AnsiString);
  190. procedure SetAsWideString(const Value : WideString);
  191. {$ENDIF}
  192. procedure SetAsBoolean(const Value: Boolean);
  193. procedure SetAsClass(const Value: TClass);
  194. procedure SetAsExtended(const Value: Extended);
  195. procedure SetAsInt64(const Value: Int64);
  196. procedure SetAsInteger(const Value: Integer);
  197. procedure SetAsObject(const Value: TObject);
  198. procedure SetAsPointer(const Value: Pointer);
  199. procedure SetAsDateTime(const Value : TDateTime);
  200. procedure SetAsVariant(const Value: Variant);
  201. procedure SetAsCardinal(const Value : Cardinal);
  202. procedure SetAsInterface(const Value: IInterface);
  203. public
  204. constructor Create(const Value: TVarRec);
  205. property DataType : TValueDataType read fDataType;
  206. property AsString : string read CastToString write SetAsString;
  207. {$IFDEF MSWINDOWS}
  208. property AsAnsiString : AnsiString read CastToAnsiString write SetAsAnsiString;
  209. property AsWideString : WideString read CastToWideString write SetAsWideString;
  210. {$ENDIF}
  211. property AsInteger : Integer read CastToInteger write SetAsInteger;
  212. property AsInt64 : Int64 read CastToInt64 write SetAsInt64;
  213. property AsExtended : Extended read CastToExtended write SetAsExtended;
  214. property AsBoolean : Boolean read CastToBoolean write SetAsBoolean;
  215. property AsPointer : Pointer read CastToPointer write SetAsPointer;
  216. property AsClass : TClass read CastToClass write SetAsClass;
  217. property AsInterface : IInterface read CastToInterface write SetAsInterface;
  218. property AsObject : TObject read CastToObject write SetAsObject;
  219. property AsVariant : Variant read CastToVariant write SetAsVariant;
  220. property AsCardinal : Cardinal read CastToCardinal write SetAsCardinal;
  221. property AsDateTime : TDateTime read CastToDateTime write SetAsDateTime;
  222. //function AsType<T> : T;
  223. function IsNullOrEmpty : Boolean; inline;
  224. function IsString : Boolean; inline;
  225. function IsInteger : Boolean; inline;
  226. function IsFloating : Boolean; inline;
  227. function IsDateTime : Boolean; inline;
  228. function IsBoolean : Boolean; inline;
  229. function IsInterface : Boolean; inline;
  230. function IsObject : Boolean; inline;
  231. function IsPointer : Boolean; inline;
  232. function IsVariant : Boolean; inline;
  233. procedure Clear; inline;
  234. procedure _AddRef; inline;
  235. procedure _Release; inline;
  236. class operator Implicit(const Value : TFlexValue) : string;
  237. class operator Implicit(Value : TFlexValue) : Integer;
  238. class operator Implicit(Value : TFlexValue) : Int64;
  239. class operator Implicit(Value : TFlexValue) : Extended;
  240. class operator Implicit(Value : TFlexValue) : TDateTime;
  241. class operator Implicit(Value : TFlexValue) : Boolean;
  242. class operator Implicit(Value : TFlexValue) : TClass;
  243. class operator Implicit(Value : TFlexValue) : TObject;
  244. class operator Implicit(Value : TFlexValue) : Pointer;
  245. class operator Implicit(Value : TFlexValue) : Variant;
  246. class operator Implicit(const Value : string) : TFlexValue;
  247. class operator Implicit(Value : Integer) : TFlexValue;
  248. class operator Implicit(Value : Int64) : TFlexValue;
  249. class operator Implicit(Value : Extended) : TFlexValue;
  250. class operator Implicit(Value : TDateTime) : TFlexValue;
  251. class operator Implicit(Value : Boolean) : TFlexValue;
  252. class operator Implicit(Value : TClass) : TFlexValue;
  253. class operator Implicit(Value : TObject) : TFlexValue;
  254. class operator Implicit(Value : Pointer) : TFlexValue;
  255. class operator Implicit(Value : Variant) : TFlexValue;
  256. end;
  257. TFlexPair = record
  258. Name : string;
  259. Value : TFlexValue;
  260. constructor Create(const aName : string; aValue : TFlexValue);
  261. end;
  262. implementation
  263. function TFlexValue.CastToString: string;
  264. begin
  265. try
  266. case fDataType of
  267. dtNull : Result := '';
  268. dtString : Result := (fDataIntf as IValueString).Value;
  269. {$IFDEF MSWINDOWS}
  270. dtAnsiString : Result := string((fDataIntf as IValueAnsiString).Value);
  271. dtWideString : Result := (fDataIntf as IValueWideString).Value;
  272. {$ENDIF}
  273. dtInteger,
  274. dtInt64 : Result := IntToStr(AsInt64);
  275. dtBoolean : Result := BoolToStr(AsBoolean,True);
  276. dtDouble,
  277. dtExtended : Result := FloatToStr(AsExtended);
  278. dtDateTime : Result := DateTimeToStr(AsExtended);
  279. dtVariant : Result := string(AsVariant);
  280. dtClass : Result := AsClass.ClassName;
  281. else raise Exception.Create('DataType not supported');
  282. end;
  283. except
  284. on E : Exception do raise Exception.CreateFmt('TFlexValue conversion to String error: %s',[e.message]);
  285. end;
  286. end;
  287. {$IFDEF MSWINDOWS}
  288. function TFlexValue.CastToAnsiString: AnsiString;
  289. begin
  290. try
  291. case fDataType of
  292. dtNull : Result := '';
  293. dtString : Result := AnsiString((fDataIntf as IValueString).Value);
  294. dtAnsiString : Result := (fDataIntf as IValueAnsiString).Value;
  295. dtWideString : Result := AnsiString((fDataIntf as IValueWideString).Value);
  296. dtInteger,
  297. dtInt64 : Result := AnsiString(IntToStr(AsInt64));
  298. dtBoolean : Result := AnsiString(BoolToStr(AsBoolean,True));
  299. dtDouble,
  300. dtExtended : Result := AnsiString(FloatToStr(AsExtended));
  301. dtDateTime : Result := AnsiString(DateTimeToStr(AsExtended));
  302. dtVariant : Result := AnsiString(AsVariant);
  303. else raise Exception.Create('DataType not supported');
  304. end;
  305. except
  306. on E : Exception do raise Exception.CreateFmt('TFlexValue conversion to AnsiString error: %s',[e.message]);
  307. end;
  308. end;
  309. function TFlexValue.CastToWideString: WideString;
  310. begin
  311. try
  312. case fDataType of
  313. dtNull : Result := '';
  314. dtString : Result := Widestring((fDataIntf as IValueString).Value);
  315. {$IFDEF MSWINDOWS}
  316. dtAnsiString : Result := Widestring((fDataIntf as IValueAnsiString).Value);
  317. dtWideString : Result := (fDataIntf as IValueWideString).Value;
  318. {$ENDIF}
  319. dtInteger,
  320. dtInt64 : Result := Widestring(IntToStr(AsInt64));
  321. dtBoolean : Result := Widestring(BoolToStr(AsBoolean,True));
  322. dtDouble,
  323. dtExtended : Result := Widestring(FloatToStr(AsExtended));
  324. dtDateTime : Result := Widestring(DateTimeToStr(AsExtended));
  325. dtVariant : Result := Widestring(AsVariant);
  326. else raise Exception.Create('DataType not supported');
  327. end;
  328. except
  329. on E : Exception do raise Exception.CreateFmt('TFlexValue conversion to WideString error: %s',[e.message]);
  330. end;
  331. end;
  332. {$ENDIF}
  333. function TFlexValue.CastToBoolean: Boolean;
  334. begin
  335. try
  336. case fDataType of
  337. dtNull : Result := False;
  338. dtString : Result := StrToBool((fDataIntf as IValueString).Value);
  339. {$IFDEF MSWINDOWS}
  340. dtAnsiString : Result := StrToBool(string((fDataIntf as IValueAnsiString).Value));
  341. dtWideString : Result := StrToBool((fDataIntf as IValueWideString).Value);
  342. {$ENDIF}
  343. dtInteger,
  344. dtInt64 :
  345. begin
  346. if (fDataIntf as IValueInteger).Value = 1 then Result := True
  347. else if (fDataIntf as IValueInteger).Value = 0 then Result := False
  348. else raise Exception.Create('Integer value not in 0-1 range');
  349. end;
  350. dtBoolean : Result := Boolean((fDataIntf as IValueInteger).Value);
  351. dtVariant : Result := Boolean(AsVariant);
  352. else raise Exception.Create('DataType not supported');
  353. end;
  354. except
  355. on E : Exception do raise Exception.CreateFmt('TFlexValue conversion to Boolean error: %s',[e.message]);
  356. end;
  357. end;
  358. function TFlexValue.CastToCardinal: Cardinal;
  359. begin
  360. Result := AsInt64;
  361. end;
  362. function TFlexValue.CastToClass: TClass;
  363. begin
  364. try
  365. case fDataType of
  366. dtNull : Result := nil;
  367. dtClass : Result := (fDataIntf as TValuePointer).Value;
  368. else raise Exception.Create('DataType not supported');
  369. end;
  370. except
  371. on E : Exception do raise Exception.CreateFmt('TFlexValue conversion to TClass error: %s',[e.message]);
  372. end;
  373. end;
  374. function TFlexValue.CastToDateTime: TDateTime;
  375. begin
  376. try
  377. case fDataType of
  378. dtNull : Result := 0.0;
  379. dtString : Result := StrToDateTime((fDataIntf as IValueString).Value);
  380. {$IFDEF MSWINDOWS}
  381. dtAnsiString : Result := StrToDateTime(string((fDataIntf as IValueAnsiString).Value));
  382. dtWideString : Result := StrToDateTime((fDataIntf as IValueWideString).Value);
  383. {$ENDIF}
  384. dtInteger,
  385. dtInt64 : Result := FileDateToDateTime(AsInt64);
  386. dtDouble,
  387. dtExtended,
  388. dtDateTime : Result := (fDataIntf as IValueExtended).Value;
  389. dtVariant : Result := Extended(AsVariant);
  390. else raise Exception.Create('DataType not supported');
  391. end;
  392. except
  393. on E : Exception do raise Exception.CreateFmt('TFlexValue conversion to Extended error: %s',[e.message]);
  394. end;
  395. end;
  396. function TFlexValue.CastToExtended: Extended;
  397. begin
  398. try
  399. case fDataType of
  400. dtNull : Result := 0.0;
  401. dtString : Result := StrToFloat((fDataIntf as IValueString).Value);
  402. {$IFDEF MSWINDOWS}
  403. dtAnsiString : Result := StrToFloat(string((fDataIntf as IValueAnsiString).Value));
  404. dtWideString : Result := StrToFloat((fDataIntf as IValueWideString).Value);
  405. {$ENDIF}
  406. dtInteger,
  407. dtInt64 : Result := AsInt64;
  408. dtBoolean : Result := AsInt64;
  409. dtDouble,
  410. dtExtended,
  411. dtDateTime : Result := (fDataIntf as IValueExtended).Value;
  412. dtVariant : Result := Extended(AsVariant);
  413. else raise Exception.Create('DataType not supported');
  414. end;
  415. except
  416. on E : Exception do raise Exception.CreateFmt('TFlexValue conversion to Extended error: %s',[e.message]);
  417. end;
  418. end;
  419. function TFlexValue.CastToInt64: Int64;
  420. begin
  421. try
  422. case fDataType of
  423. dtNull : Result := 0;
  424. dtString : Result := StrToInt((fDataIntf as IValueString).Value);
  425. {$IFDEF MSWINDOWS}
  426. dtAnsiString : Result := StrToInt(string((fDataIntf as IValueAnsiString).Value));
  427. dtWideString : Result := StrToInt((fDataIntf as IValueWideString).Value);
  428. {$ENDIF}
  429. dtInteger,
  430. dtInt64 : Result := (fDataIntf as IValueInteger).Value;
  431. dtBoolean : Result := Integer(AsBoolean);
  432. dtDateTime : Result := DateTimeToFileDate((fDataIntf as IValueExtended).Value);
  433. dtVariant : Result := Integer(AsVariant);
  434. else raise Exception.Create('DataType not supported');
  435. end;
  436. except
  437. on E : Exception do raise Exception.CreateFmt('TFlexValue conversion to Integer error: %s',[e.message]);
  438. end;
  439. end;
  440. function TFlexValue.CastToInteger: Integer;
  441. begin
  442. Result := AsInt64;
  443. end;
  444. function TFlexValue.CastToObject: TObject;
  445. begin
  446. try
  447. case fDataType of
  448. dtObject,
  449. dtOwnedObject : Result := (fDataIntf as IValueObject).Value;
  450. {$IFNDEF FPC}
  451. dtPointer : Result := TObject((fDataIntf as IValueObject).Value);
  452. {$ELSE}
  453. dtPointer : Result := TObject((fDataIntf as IValuePointer).Value);
  454. {$ENDIF}
  455. dtNull : Result := nil;
  456. else raise Exception.Create('DataType not supported');
  457. end;
  458. except
  459. on E : Exception do raise Exception.CreateFmt('TFlexValue conversion to Object error: %s',[e.message]);
  460. end;
  461. end;
  462. function TFlexValue.CastToPointer: Pointer;
  463. begin
  464. try
  465. case fDataType of
  466. dtObject,
  467. dtOwnedObject : Result := Pointer((fDataIntf as IValueObject).Value);
  468. dtPointer : Result := (fDataIntf as IValuePointer).Value;
  469. dtNull : Result := nil;
  470. else raise Exception.Create('DataType not supported');
  471. end;
  472. except
  473. on E : Exception do raise Exception.CreateFmt('TFlexValue conversion to Pointer error: %s',[e.message]);
  474. end;
  475. end;
  476. function TFlexValue.CastToVariant: Variant;
  477. begin
  478. try
  479. case fDataType of
  480. dtNull : Result := Variants.Null;
  481. dtBoolean : Result := AsVariant;
  482. {$IFDEF MSWINDOWS}
  483. dtAnsiString : Result := StrToInt(string((fDataIntf as IValueAnsiString).Value));
  484. dtWideString : Result := StrToInt((fDataIntf as IValueWideString).Value);
  485. {$ENDIF}
  486. dtInteger,
  487. dtInt64 : Result := (fDataIntf as IValueInteger).Value;
  488. dtVariant : Result := (fDataIntf as IValueVariant).Value;
  489. else raise Exception.Create('DataType not supported');
  490. end;
  491. except
  492. on E : Exception do raise Exception.CreateFmt('TFlexValue conversion to Variant error: %s',[e.message]);
  493. end;
  494. end;
  495. function TFlexValue.CastToInterface: IInterface;
  496. begin
  497. try
  498. case fDataType of
  499. dtNull : Result := nil;
  500. dtInterface : Result := fDataIntf;
  501. dtPointer : Result := IInterface(fDataIntf);
  502. else raise Exception.Create('DataType not supported');
  503. end;
  504. except
  505. on E : Exception do raise Exception.CreateFmt('TFlexValue conversion to Interface error: %s',[e.message]);
  506. end;
  507. end;
  508. procedure TFlexValue.Clear;
  509. begin
  510. if Pointer(fDataIntf) <> nil then fDataIntf := nil;
  511. fDataType := dtNull;
  512. end;
  513. constructor TFlexValue.Create(const Value: TVarRec);
  514. begin
  515. case Value.VType of
  516. {$IFNDEF NEXTGEN}
  517. vtString : AsString := string(Value.VString^);
  518. vtChar : AsString := string(Value.VChar);
  519. {$ENDIF}
  520. {$IFDEF MSWINDOWS}
  521. vtAnsiString : AsAnsiString := AnsiString(Value.VAnsiString);
  522. vtWideString : AsWideString := WideString(Value.VWideString);
  523. {$ENDIF}
  524. {$IFDEF UNICODE}
  525. vtUnicodeString: AsString := string(Value.VUnicodeString);
  526. {$ENDIF UNICODE}
  527. vtInteger : AsInteger := Value.VInteger;
  528. vtInt64 : AsInt64 := Value.VInt64^;
  529. vtExtended : AsExtended := Value.VExtended^;
  530. vtBoolean : AsBoolean := Value.VBoolean;
  531. vtVariant : AsVariant := Value.VVariant^;
  532. vtInterface : AsInterface := IInterface(Value.VInterface);
  533. vtClass : AsClass := Value.VClass;
  534. vtObject : AsObject := Value.VObject;
  535. vtPointer : AsPointer := Value.VPointer;
  536. else raise Exception.Create('DataType not supported by TFlexValue');
  537. end;
  538. {$IFDEF FPC}
  539. fDataIntf._AddRef;
  540. {$ENDIF}
  541. end;
  542. {$IFNDEF FPCS}
  543. class operator TFlexValue.Implicit(Value: TFlexValue): Boolean;
  544. begin
  545. Result := Value.AsBoolean;
  546. end;
  547. class operator TFlexValue.Implicit(const Value: TFlexValue): string;
  548. begin
  549. Result := Value.AsString;
  550. end;
  551. class operator TFlexValue.Implicit(Value: TFlexValue): TObject;
  552. begin
  553. Result := Value.AsObject;
  554. end;
  555. class operator TFlexValue.Implicit(Value: TFlexValue): Pointer;
  556. begin
  557. Result := Value.AsPointer;
  558. end;
  559. class operator TFlexValue.Implicit(Value: TFlexValue): TDateTime;
  560. begin
  561. Result := Value.AsDateTime;
  562. end;
  563. class operator TFlexValue.Implicit(Value: TFlexValue): TClass;
  564. begin
  565. Result := Value.AsClass;
  566. end;
  567. class operator TFlexValue.Implicit(Value: TFlexValue): Int64;
  568. begin
  569. Result := Value.AsInt64;
  570. end;
  571. class operator TFlexValue.Implicit(Value: TFlexValue): Integer;
  572. begin
  573. Result := Value.AsInteger;
  574. end;
  575. class operator TFlexValue.Implicit(Value: TFlexValue): Extended;
  576. begin
  577. Result := Value.AsExtended;
  578. end;
  579. class operator TFlexValue.Implicit(Value: TFlexValue): Variant;
  580. begin
  581. Result := Value.AsVariant;
  582. end;
  583. class operator TFlexValue.Implicit(Value: Variant): TFlexValue;
  584. begin
  585. Result.AsVariant := Value;
  586. end;
  587. class operator TFlexValue.Implicit(const Value : string) : TFlexValue;
  588. begin
  589. Result.AsString := Value;
  590. end;
  591. class operator TFlexValue.Implicit(Value : Integer) : TFlexValue;
  592. begin
  593. Result.AsInteger := Value;
  594. end;
  595. class operator TFlexValue.Implicit(Value : Int64) : TFlexValue;
  596. begin
  597. Result.AsInt64 := Value;
  598. end;
  599. class operator TFlexValue.Implicit(Value : Extended) : TFlexValue;
  600. begin
  601. Result.AsExtended := Value;
  602. end;
  603. class operator TFlexValue.Implicit(Value : TDateTime) : TFlexValue;
  604. begin
  605. Result.AsDateTime := Value;
  606. end;
  607. class operator TFlexValue.Implicit(Value : Boolean) : TFlexValue;
  608. begin
  609. Result.AsBoolean := Value;
  610. end;
  611. class operator TFlexValue.Implicit(Value : TClass) : TFlexValue;
  612. begin
  613. Result.AsClass := Value;
  614. end;
  615. class operator TFlexValue.Implicit(Value : TObject) : TFlexValue;
  616. begin
  617. Result.AsObject := Value;
  618. end;
  619. class operator TFlexValue.Implicit(Value : Pointer) : TFlexValue;
  620. begin
  621. Result.AsPointer := Value;
  622. end;
  623. {$ENDIF}
  624. function TFlexValue.IsBoolean: Boolean;
  625. begin
  626. Result := fDataType = dtBoolean;
  627. end;
  628. function TFlexValue.IsDateTime: Boolean;
  629. begin
  630. Result := fDataType = dtDateTime;
  631. end;
  632. function TFlexValue.IsFloating: Boolean;
  633. begin
  634. Result := fDataType in [dtDouble,dtExtended];
  635. end;
  636. function TFlexValue.IsInteger: Boolean;
  637. begin
  638. Result := fDataType in [dtInteger,dtInt64];
  639. end;
  640. function TFlexValue.IsInterface: Boolean;
  641. begin
  642. Result := fDataType = dtInterface;
  643. end;
  644. function TFlexValue.IsNullOrEmpty: Boolean;
  645. begin
  646. Result := fDataIntf = nil;
  647. end;
  648. function TFlexValue.IsObject: Boolean;
  649. begin
  650. Result := fDataType = dtObject;
  651. end;
  652. function TFlexValue.IsPointer: Boolean;
  653. begin
  654. Result := fDataType = dtPointer;
  655. end;
  656. function TFlexValue.IsString: Boolean;
  657. begin
  658. Result := fDataType in [dtString,dtAnsiString,dtWideString];
  659. end;
  660. function TFlexValue.IsVariant: Boolean;
  661. begin
  662. Result := fDataType = dtVariant;
  663. end;
  664. {$IFDEF MSWINDOWS}
  665. procedure TFlexValue.SetAsAnsiString(const Value: AnsiString);
  666. begin
  667. Clear;
  668. fDataIntf := TValueAnsiString.Create(Value);
  669. fDataType := TValueDataType.dtAnsiString;
  670. end;
  671. {$ENDIF}
  672. procedure TFlexValue.SetAsBoolean(const Value: Boolean);
  673. begin
  674. Clear;
  675. fDataIntf := TValueInteger.Create(Value.ToInteger);
  676. fDataType := TValueDataType.dtBoolean;
  677. end;
  678. procedure TFlexValue.SetAsCardinal(const Value: Cardinal);
  679. begin
  680. Clear;
  681. fDataIntf := TValueInteger.Create(Value);
  682. fDataType := TValueDataType.dtInt64;
  683. end;
  684. procedure TFlexValue.SetAsClass(const Value: TClass);
  685. begin
  686. Clear;
  687. fDataIntf := TValuePointer.Create(Value);
  688. fDataType := TValueDataType.dtClass;
  689. end;
  690. procedure TFlexValue.SetAsDateTime(const Value: TDateTime);
  691. begin
  692. Clear;
  693. fDataIntf := TValueExtended.Create(Value);
  694. fDataType := TValueDataType.dtDateTime;
  695. end;
  696. procedure TFlexValue.SetAsExtended(const Value: Extended);
  697. begin
  698. Clear;
  699. fDataIntf := TValueExtended.Create(Value);
  700. fDataType := TValueDataType.dtExtended;
  701. end;
  702. procedure TFlexValue.SetAsInt64(const Value: Int64);
  703. begin
  704. Clear;
  705. fDataIntf := TValueInteger.Create(Value);
  706. fDataType := TValueDataType.dtInt64;
  707. end;
  708. procedure TFlexValue.SetAsInteger(const Value: Integer);
  709. begin
  710. Clear;
  711. fDataIntf := TValueInteger.Create(Value);
  712. fDataType := TValueDataType.dtInteger;
  713. end;
  714. procedure TFlexValue.SetAsInterface(const Value: IInterface);
  715. begin
  716. {$IFNDEF FPC}
  717. fDataIntf := Value;
  718. {$ELSE}
  719. fDataIntf := Pointer(Value);
  720. {$ENDIF}
  721. fDataType := TValueDataType.dtInterface;
  722. end;
  723. procedure TFlexValue.SetAsObject(const Value: TObject);
  724. begin
  725. Clear;
  726. fDataIntf := TValueObject.Create(Value);
  727. fDataType := TValueDataType.dtObject;
  728. end;
  729. procedure TFlexValue.SetAsPointer(const Value: Pointer);
  730. begin
  731. Clear;
  732. fDataIntf := TValuePointer.Create(Value);
  733. fDataType := TValueDataType.dtPointer;
  734. end;
  735. procedure TFlexValue.SetAsString(const Value: string);
  736. begin
  737. Clear;
  738. fDataIntf := TValueString.Create(Value);
  739. fDataType := TValueDataType.dtString;
  740. end;
  741. function TryVarAsType(aValue : Variant; aVarType : Word) : Boolean;
  742. begin
  743. try
  744. VarAsType(aValue,aVarType);
  745. Result := True;
  746. except
  747. Result := False;
  748. end;
  749. end;
  750. procedure TFlexValue.SetAsVariant(const Value: Variant);
  751. begin
  752. Clear;
  753. case VarType(Value) and varTypeMask of
  754. varEmpty,
  755. varNull : Clear;
  756. varSmallInt,
  757. varInteger,
  758. varByte,
  759. varWord,
  760. varLongWord,
  761. varInt64 : SetAsInt64(Value);
  762. varSingle,
  763. varDouble,
  764. varCurrency : SetAsExtended(Value);
  765. varDate : SetAsDateTime(Value);
  766. varOleStr : SetAsString(Value);
  767. varDispatch : begin
  768. if TryVarAsType(Value,varInt64) then SetAsInt64(Value)
  769. else if TryVarAsType(Value,varDouble) then SetAsExtended(Value)
  770. else if TryVarAsType(Value,varBoolean) then SetAsBoolean(Value)
  771. else if TryVarAsType(Value,varString) then SetAsString(Value)
  772. else
  773. begin
  774. fDataIntf := TValueVariant.Create(Value);
  775. fDataType := TValueDataType.dtVariant;
  776. end;
  777. end;
  778. //varError : typeString := 'varError';
  779. varBoolean : SetAsBoolean(Value);
  780. //varStrArg : typeString := 'varStrArg';
  781. varString : SetAsString(Value);
  782. //varAny : typeString := 'varAny';
  783. //varTypeMask : typeString := 'varTypeMask';
  784. else
  785. begin
  786. fDataIntf := TValueVariant.Create(Value);
  787. fDataType := TValueDataType.dtVariant;
  788. end;
  789. end;
  790. end;
  791. {$IFDEF MSWINDOWS}
  792. procedure TFlexValue.SetAsWideString(const Value: WideString);
  793. begin
  794. Clear;
  795. fDataIntf := TValueWideString.Create(Value);
  796. fDataType := TValueDataType.dtWideString;
  797. end;
  798. {$ENDIF}
  799. procedure TFlexValue._AddRef;
  800. begin
  801. if Assigned(fDataIntf) then fDataIntf._AddRef;
  802. end;
  803. procedure TFlexValue._Release;
  804. begin
  805. if Assigned(fDataIntf) then fDataIntf._Release;
  806. end;
  807. { TValueStringData }
  808. constructor TValueString.Create(const Value: string);
  809. begin
  810. fData := Value;
  811. end;
  812. function TValueString.GetValue: string;
  813. begin
  814. Result := fData;
  815. end;
  816. procedure TValueString.SetValue(const Value: string);
  817. begin
  818. fData := Value;
  819. end;
  820. { TValueVariantData }
  821. constructor TValueVariant.Create(const Value: Variant);
  822. begin
  823. fData := Value;
  824. end;
  825. function TValueVariant.GetValue: Variant;
  826. begin
  827. Result := fData;
  828. end;
  829. procedure TValueVariant.SetValue(const Value: Variant);
  830. begin
  831. fData := Value;
  832. end;
  833. { TValueAnsiStringData }
  834. {$IFDEF MSWINDOWS}
  835. constructor TValueAnsiString.Create(const Value: AnsiString);
  836. begin
  837. fData := Value;
  838. end;
  839. function TValueAnsiString.GetValue: AnsiString;
  840. begin
  841. Result := fData;
  842. end;
  843. procedure TValueAnsiString.SetValue(const Value: AnsiString);
  844. begin
  845. fData := Value;
  846. end;
  847. { TValueWideStringData }
  848. constructor TValueWideString.Create(const Value: WideString);
  849. begin
  850. fData := Value;
  851. end;
  852. function TValueWideString.GetValue: WideString;
  853. begin
  854. Result := fData;
  855. end;
  856. procedure TValueWideString.SetValue(const Value: WideString);
  857. begin
  858. fData := Value;
  859. end;
  860. {$ENDIF}
  861. { TValueInteger }
  862. constructor TValueInteger.Create(const Value: Int64);
  863. begin
  864. fData := Value;
  865. end;
  866. function TValueInteger.GetValue: Int64;
  867. begin
  868. Result := fData;
  869. end;
  870. procedure TValueInteger.SetValue(const Value: Int64);
  871. begin
  872. fData := Value;
  873. end;
  874. { TValuePointer }
  875. constructor TValuePointer.Create(const Value: Pointer);
  876. begin
  877. fData := Value;
  878. end;
  879. function TValuePointer.GetValue: Pointer;
  880. begin
  881. Result := fData;
  882. end;
  883. procedure TValuePointer.SetValue(const Value: Pointer);
  884. begin
  885. fData := Value;
  886. end;
  887. { TValueExtended }
  888. constructor TValueExtended.Create(const Value: Extended);
  889. begin
  890. fData := Value;
  891. end;
  892. function TValueExtended.GetValue: Extended;
  893. begin
  894. Result := fData;
  895. end;
  896. procedure TValueExtended.SetValue(const Value: Extended);
  897. begin
  898. fData := Value;
  899. end;
  900. { TValueObject }
  901. constructor TValueObject.Create(const Value: TObject);
  902. begin
  903. fData := Value;
  904. end;
  905. function TValueObject.GetValue: TObject;
  906. begin
  907. Result := fData;
  908. end;
  909. procedure TValueObject.SetValue(const Value: TObject);
  910. begin
  911. fData := Value;
  912. end;
  913. { TFlexPair }
  914. constructor TFlexPair.Create(const aName: string; aValue: TFlexValue);
  915. begin
  916. Name := aName;
  917. Value := aValue;
  918. end;
  919. end.