Quick.Value.pas 24 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869
  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.4
  7. Created : 07/01/2019
  8. Modified : 16/01/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. {$IFNDEF NEXTGEN}
  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. IValuePointer = interface
  115. ['{9FE4E499-C487-4D24-8190-14FF3F9FE86B}']
  116. function GetValue : Pointer;
  117. procedure SetValue(const Value : Pointer);
  118. property Value : Pointer read GetValue write SetValue;
  119. end;
  120. TValuePointer = class(TValueData,IValuePointer)
  121. strict private
  122. fData : Pointer;
  123. private
  124. function GetValue : Pointer;
  125. procedure SetValue(const Value : Pointer);
  126. public
  127. constructor Create(const Value : Pointer);
  128. property Value : Pointer read GetValue write SetValue;
  129. end;
  130. IValueVariant = interface
  131. ['{8B1F8469-B872-47AD-83BB-F51920012943}']
  132. function GetValue : Variant;
  133. procedure SetValue(const Value : Variant);
  134. property Value : Variant read GetValue write SetValue;
  135. end;
  136. TValueVariant = class(TValueData,IValueVariant)
  137. strict private
  138. fData : Variant;
  139. private
  140. function GetValue : Variant;
  141. procedure SetValue(const Value : Variant);
  142. public
  143. constructor Create(const Value : Variant);
  144. property Value : Variant read GetValue write SetValue;
  145. end;
  146. TFlexValue = record
  147. private
  148. {$IFNDEF FPC}
  149. fDataIntf : IInterface;
  150. {$ELSE}
  151. fDataIntf : TValueData;
  152. {$ENDIF}
  153. fDataType : TValueDataType;
  154. function CastToString : string;
  155. {$IFNDEF NEXTGEN}
  156. function CastToAnsiString : AnsiString;
  157. function CastToWideString : WideString;
  158. {$ENDIF}
  159. function CastToBoolean: Boolean;
  160. function CastToClass: TClass;
  161. function CastToExtended: Extended;
  162. function CastToInt64: Int64;
  163. function CastToInteger: Integer;
  164. function CastToDateTime : TDateTime;
  165. function CastToObject: TObject;
  166. function CastToPointer: Pointer;
  167. function CastToInterface: Pointer;
  168. function CastToVariant: Variant;
  169. function CastToCardinal : Cardinal;
  170. procedure SetAsString(const Value : string);
  171. {$IFNDEF NEXTGEN}
  172. procedure SetAsAnsiString(const Value : AnsiString);
  173. procedure SetAsWideString(const Value : WideString);
  174. {$ENDIF}
  175. procedure SetAsBoolean(const Value: Boolean);
  176. procedure SetAsClass(const Value: TClass);
  177. procedure SetAsExtended(const Value: Extended);
  178. procedure SetAsInt64(const Value: Int64);
  179. procedure SetAsInteger(const Value: Integer);
  180. procedure SetAsObject(const Value: TObject);
  181. procedure SetAsPointer(const Value: Pointer);
  182. procedure SetAsDateTime(const Value : TDateTime);
  183. procedure SetAsVariant(const Value: Variant);
  184. procedure SetAsCardinal(const Value : Cardinal);
  185. public
  186. constructor Create(const Value: TVarRec);
  187. property DataType : TValueDataType read fDataType;
  188. property AsString : string read CastToString write SetAsString;
  189. {$IFNDEF NEXTGEN}
  190. property AsAnsiString : AnsiString read CastToAnsiString write SetAsAnsiString;
  191. property AsWideString : WideString read CastToWideString write SetAsWideString;
  192. {$ENDIF}
  193. property AsInteger : Integer read CastToInteger write SetAsInteger;
  194. property AsInt64 : Int64 read CastToInt64 write SetAsInt64;
  195. property AsExtended : Extended read CastToExtended write SetAsExtended;
  196. property AsBoolean : Boolean read CastToBoolean write SetAsBoolean;
  197. property AsPointer : Pointer read CastToPointer write SetAsPointer;
  198. property AsClass : TClass read CastToClass write SetAsClass;
  199. property AsInterface : Pointer read CastToInterface write SetAsPointer;
  200. property AsObject : TObject read CastToObject write SetAsObject;
  201. property AsVariant : Variant read CastToVariant write SetAsVariant;
  202. property AsCardinal : Cardinal read CastToCardinal write SetAsCardinal;
  203. property AsDateTime : TDateTime read CastToDateTime write SetAsDateTime;
  204. //function AsType<T> : T;
  205. function IsNullOrEmpty : Boolean; inline;
  206. function IsString : Boolean; inline;
  207. function IsInteger : Boolean; inline;
  208. function IsFloating : Boolean; inline;
  209. function IsDateTime : Boolean; inline;
  210. function IsBoolean : Boolean; inline;
  211. function IsInterface : Boolean; inline;
  212. function IsObject : Boolean; inline;
  213. function IsPointer : Boolean; inline;
  214. function IsVariant : Boolean; inline;
  215. procedure Clear; inline;
  216. procedure _AddRef; inline;
  217. procedure _Release; inline;
  218. {$IFNDEF FPC}
  219. class operator Implicit(const Value : TFlexValue) : string;
  220. class operator Implicit(Value : TFlexValue) : Integer;
  221. class operator Implicit(Value : TFlexValue) : Int64;
  222. class operator Implicit(Value : TFlexValue) : Extended;
  223. class operator Implicit(Value : TFlexValue) : TDateTime;
  224. class operator Implicit(Value : TFlexValue) : Boolean;
  225. class operator Implicit(Value : TFlexValue) : TClass;
  226. class operator Implicit(Value : TFlexValue) : TObject;
  227. class operator Implicit(Value : TFlexValue) : Pointer;
  228. {$ENDIF}
  229. end;
  230. implementation
  231. function TFlexValue.CastToString: string;
  232. begin
  233. try
  234. case fDataType of
  235. dtNull : Result := '';
  236. dtString : Result := (fDataIntf as IValueString).Value;
  237. {$IFNDEF NEXTGEN}
  238. dtAnsiString : Result := string((fDataIntf as IValueAnsiString).Value);
  239. dtWideString : Result := (fDataIntf as IValueWideString).Value;
  240. {$ENDIF}
  241. dtInteger,
  242. dtInt64 : Result := IntToStr(AsInt64);
  243. dtBoolean : Result := BoolToStr(AsBoolean,True);
  244. dtDouble,
  245. dtExtended : Result := FloatToStr(AsExtended);
  246. dtDateTime : Result := DateTimeToStr(AsExtended);
  247. dtVariant : Result := string(AsVariant);
  248. dtClass : Result := AsClass.ClassName;
  249. else raise Exception.Create('DataType not supported');
  250. end;
  251. except
  252. on E : Exception do raise Exception.CreateFmt('TFlexValue conversion to String error: %s',[e.message]);
  253. end;
  254. end;
  255. {$IFNDEF NEXTGEN}
  256. function TFlexValue.CastToAnsiString: AnsiString;
  257. begin
  258. try
  259. case fDataType of
  260. dtNull : Result := '';
  261. dtString : Result := AnsiString((fDataIntf as IValueString).Value);
  262. dtAnsiString : Result := (fDataIntf as IValueAnsiString).Value;
  263. dtWideString : Result := AnsiString((fDataIntf as IValueWideString).Value);
  264. dtInteger,
  265. dtInt64 : Result := AnsiString(IntToStr(AsInt64));
  266. dtBoolean : Result := AnsiString(BoolToStr(AsBoolean,True));
  267. dtDouble,
  268. dtExtended : Result := AnsiString(FloatToStr(AsExtended));
  269. dtDateTime : Result := AnsiString(DateTimeToStr(AsExtended));
  270. dtVariant : Result := AnsiString(AsVariant);
  271. else raise Exception.Create('DataType not supported');
  272. end;
  273. except
  274. on E : Exception do raise Exception.CreateFmt('TFlexValue conversion to AnsiString error: %s',[e.message]);
  275. end;
  276. end;
  277. function TFlexValue.CastToWideString: WideString;
  278. begin
  279. try
  280. case fDataType of
  281. dtNull : Result := '';
  282. dtString : Result := Widestring((fDataIntf as IValueString).Value);
  283. {$IFNDEF NEXTGEN}
  284. dtAnsiString : Result := Widestring((fDataIntf as IValueAnsiString).Value);
  285. dtWideString : Result := (fDataIntf as IValueWideString).Value;
  286. {$ENDIF}
  287. dtInteger,
  288. dtInt64 : Result := Widestring(IntToStr(AsInt64));
  289. dtBoolean : Result := Widestring(BoolToStr(AsBoolean,True));
  290. dtDouble,
  291. dtExtended : Result := Widestring(FloatToStr(AsExtended));
  292. dtDateTime : Result := Widestring(DateTimeToStr(AsExtended));
  293. dtVariant : Result := Widestring(AsVariant);
  294. else raise Exception.Create('DataType not supported');
  295. end;
  296. except
  297. on E : Exception do raise Exception.CreateFmt('TFlexValue conversion to WideString error: %s',[e.message]);
  298. end;
  299. end;
  300. {$ENDIF}
  301. function TFlexValue.CastToBoolean: Boolean;
  302. begin
  303. try
  304. case fDataType of
  305. dtNull : Result := False;
  306. dtString : Result := StrToBool((fDataIntf as IValueString).Value);
  307. {$IFNDEF NEXTGEN}
  308. dtAnsiString : Result := StrToBool(string((fDataIntf as IValueAnsiString).Value));
  309. dtWideString : Result := StrToBool((fDataIntf as IValueWideString).Value);
  310. {$ENDIF}
  311. dtInteger,
  312. dtInt64 :
  313. begin
  314. if (fDataIntf as IValueInteger).Value = 1 then Result := True
  315. else if (fDataIntf as IValueInteger).Value = 0 then Result := False
  316. else raise Exception.Create('Integer value not in 0-1 range');
  317. end;
  318. dtBoolean : Result := Boolean((fDataIntf as IValueInteger).Value);
  319. dtVariant : Result := Boolean(AsVariant);
  320. else raise Exception.Create('DataType not supported');
  321. end;
  322. except
  323. on E : Exception do raise Exception.CreateFmt('TFlexValue conversion to Boolean error: %s',[e.message]);
  324. end;
  325. end;
  326. function TFlexValue.CastToCardinal: Cardinal;
  327. begin
  328. Result := AsInt64;
  329. end;
  330. function TFlexValue.CastToClass: TClass;
  331. begin
  332. try
  333. case fDataType of
  334. dtNull : Result := nil;
  335. dtClass : Result := (fDataIntf as TValuePointer).Value;
  336. else raise Exception.Create('DataType not supported');
  337. end;
  338. except
  339. on E : Exception do raise Exception.CreateFmt('TFlexValue conversion to TClass error: %s',[e.message]);
  340. end;
  341. end;
  342. function TFlexValue.CastToDateTime: TDateTime;
  343. begin
  344. try
  345. case fDataType of
  346. dtNull : Result := 0.0;
  347. dtString : Result := StrToDateTime((fDataIntf as IValueString).Value);
  348. {$IFNDEF NEXTGEN}
  349. dtAnsiString : Result := StrToDateTime(string((fDataIntf as IValueAnsiString).Value));
  350. dtWideString : Result := StrToDateTime((fDataIntf as IValueWideString).Value);
  351. {$ENDIF}
  352. dtInteger,
  353. dtInt64 : Result := FileDateToDateTime(AsInt64);
  354. dtDouble,
  355. dtExtended,
  356. dtDateTime : Result := (fDataIntf as IValueExtended).Value;
  357. dtVariant : Result := Extended(AsVariant);
  358. else raise Exception.Create('DataType not supported');
  359. end;
  360. except
  361. on E : Exception do raise Exception.CreateFmt('TFlexValue conversion to Extended error: %s',[e.message]);
  362. end;
  363. end;
  364. function TFlexValue.CastToExtended: Extended;
  365. begin
  366. try
  367. case fDataType of
  368. dtNull : Result := 0.0;
  369. dtString : Result := StrToFloat((fDataIntf as IValueString).Value);
  370. {$IFNDEF NEXTGEN}
  371. dtAnsiString : Result := StrToFloat(string((fDataIntf as IValueAnsiString).Value));
  372. dtWideString : Result := StrToFloat((fDataIntf as IValueWideString).Value);
  373. {$ENDIF}
  374. dtInteger,
  375. dtInt64 : Result := AsInt64;
  376. dtBoolean : Result := AsInt64;
  377. dtDouble,
  378. dtExtended,
  379. dtDateTime : Result := (fDataIntf as IValueExtended).Value;
  380. dtVariant : Result := Extended(AsVariant);
  381. else raise Exception.Create('DataType not supported');
  382. end;
  383. except
  384. on E : Exception do raise Exception.CreateFmt('TFlexValue conversion to Extended error: %s',[e.message]);
  385. end;
  386. end;
  387. function TFlexValue.CastToInt64: Int64;
  388. begin
  389. try
  390. case fDataType of
  391. dtNull : Result := 0;
  392. dtString : Result := StrToInt((fDataIntf as IValueString).Value);
  393. {$IFNDEF NEXTGEN}
  394. dtAnsiString : Result := StrToInt(string((fDataIntf as IValueAnsiString).Value));
  395. dtWideString : Result := StrToInt((fDataIntf as IValueWideString).Value);
  396. {$ENDIF}
  397. dtInteger,
  398. dtInt64 : Result := (fDataIntf as IValueInteger).Value;
  399. dtBoolean : Result := Integer(AsBoolean);
  400. dtDateTime : Result := DateTimeToFileDate((fDataIntf as IValueExtended).Value);
  401. dtVariant : Result := Integer(AsVariant);
  402. else raise Exception.Create('DataType not supported');
  403. end;
  404. except
  405. on E : Exception do raise Exception.CreateFmt('TFlexValue conversion to Integer error: %s',[e.message]);
  406. end;
  407. end;
  408. function TFlexValue.CastToInteger: Integer;
  409. begin
  410. Result := AsInt64;
  411. end;
  412. function TFlexValue.CastToObject: TObject;
  413. begin
  414. try
  415. case fDataType of
  416. dtObject,
  417. dtOwnedObject : Result := (fDataIntf as IValuePointer).Value;
  418. dtNull : Result := nil;
  419. else raise Exception.Create('DataType not supported');
  420. end;
  421. except
  422. on E : Exception do raise Exception.CreateFmt('TFlexValue conversion to Object error: %s',[e.message]);
  423. end;
  424. end;
  425. function TFlexValue.CastToPointer: Pointer;
  426. begin
  427. try
  428. case fDataType of
  429. dtObject,
  430. dtOwnedObject : Result := (fDataIntf as IValuePointer).Value;
  431. dtNull : Result := nil;
  432. else raise Exception.Create('DataType not supported');
  433. end;
  434. except
  435. on E : Exception do raise Exception.CreateFmt('TFlexValue conversion to Pointer error: %s',[e.message]);
  436. end;
  437. end;
  438. function TFlexValue.CastToVariant: Variant;
  439. begin
  440. try
  441. case fDataType of
  442. dtNull : Result := Variants.Null;
  443. dtBoolean : Result := AsVariant;
  444. dtVariant : Result := (fDataIntf as IValueVariant).Value;
  445. else raise Exception.Create('DataType not supported');
  446. end;
  447. except
  448. on E : Exception do raise Exception.CreateFmt('TFlexValue conversion to Variant error: %s',[e.message]);
  449. end;
  450. end;
  451. function TFlexValue.CastToInterface: Pointer;
  452. begin
  453. try
  454. case fDataType of
  455. dtNull : Result := nil;
  456. dtInterface : Result := IInterface(fDataIntf);
  457. else raise Exception.Create('DataType not supported');
  458. end;
  459. except
  460. on E : Exception do raise Exception.CreateFmt('TFlexValue conversion to Interface error: %s',[e.message]);
  461. end;
  462. end;
  463. procedure TFlexValue.Clear;
  464. begin
  465. if Pointer(fDataIntf) <> nil then fDataIntf := nil;
  466. fDataType := dtNull;
  467. end;
  468. constructor TFlexValue.Create(const Value: TVarRec);
  469. begin
  470. case Value.VType of
  471. {$IFNDEF NEXTGEN}
  472. vtString : AsString := string(Value.VString^);
  473. {$ENDIF}
  474. vtChar : AsString := string(Value.VChar);
  475. {$IFNDEF NEXTGEN}
  476. vtAnsiString : AsAnsiString := AnsiString(Value.VAnsiString);
  477. vtWideString : AsWideString := WideString(Value.VWideString);
  478. {$ENDIF}
  479. vtUnicodeString: AsString := string(Value.VUnicodeString);
  480. vtInteger : AsInteger := Value.VInteger;
  481. vtInt64 : AsInt64 := Value.VInt64^;
  482. vtExtended : AsExtended := Value.VExtended^;
  483. vtBoolean : AsBoolean := Value.VBoolean;
  484. vtVariant : AsVariant := Value.VVariant^;
  485. vtInterface : AsInterface := IInterface(Value.VInterface);
  486. vtClass : AsClass := Value.VClass;
  487. vtObject : AsObject := Value.VObject;
  488. vtPointer : AsPointer := Value.VPointer;
  489. else raise Exception.Create('DataType not supported by TFlexValue');
  490. end;
  491. {$IFDEF FPC}
  492. fDataIntf._AddRef;
  493. {$ENDIF}
  494. end;
  495. {$IFNDEF FPC}
  496. class operator TFlexValue.Implicit(Value: TFlexValue): Boolean;
  497. begin
  498. Result := Value.AsBoolean;
  499. end;
  500. class operator TFlexValue.Implicit(const Value: TFlexValue): string;
  501. begin
  502. Result := Value.AsString;
  503. end;
  504. class operator TFlexValue.Implicit(Value: TFlexValue): TObject;
  505. begin
  506. Result := Value.AsObject;
  507. end;
  508. class operator TFlexValue.Implicit(Value: TFlexValue): Pointer;
  509. begin
  510. Result := Value.AsPointer;
  511. end;
  512. class operator TFlexValue.Implicit(Value: TFlexValue): TDateTime;
  513. begin
  514. Result := Value.AsDateTime;
  515. end;
  516. class operator TFlexValue.Implicit(Value: TFlexValue): TClass;
  517. begin
  518. Result := Value.AsClass;
  519. end;
  520. class operator TFlexValue.Implicit(Value: TFlexValue): Int64;
  521. begin
  522. Result := Value.AsInt64;
  523. end;
  524. class operator TFlexValue.Implicit(Value: TFlexValue): Integer;
  525. begin
  526. Result := Value.AsInteger;
  527. end;
  528. class operator TFlexValue.Implicit(Value: TFlexValue): Extended;
  529. begin
  530. Result := Value.AsExtended;
  531. end;
  532. {$ENDIF}
  533. function TFlexValue.IsBoolean: Boolean;
  534. begin
  535. Result := fDataType = dtBoolean;
  536. end;
  537. function TFlexValue.IsDateTime: Boolean;
  538. begin
  539. Result := fDataType = dtDateTime;
  540. end;
  541. function TFlexValue.IsFloating: Boolean;
  542. begin
  543. Result := fDataType in [dtDouble,dtExtended];
  544. end;
  545. function TFlexValue.IsInteger: Boolean;
  546. begin
  547. Result := fDataType in [dtInteger,dtInt64];
  548. end;
  549. function TFlexValue.IsInterface: Boolean;
  550. begin
  551. Result := fDataType = dtInterface;
  552. end;
  553. function TFlexValue.IsNullOrEmpty: Boolean;
  554. begin
  555. Result := fDataIntf = nil;
  556. end;
  557. function TFlexValue.IsObject: Boolean;
  558. begin
  559. Result := fDataType = dtObject;
  560. end;
  561. function TFlexValue.IsPointer: Boolean;
  562. begin
  563. Result := fDataType = dtPointer;
  564. end;
  565. function TFlexValue.IsString: Boolean;
  566. begin
  567. Result := fDataType in [dtString,dtAnsiString,dtWideString];
  568. end;
  569. function TFlexValue.IsVariant: Boolean;
  570. begin
  571. Result := fDataType = dtVariant;
  572. end;
  573. {$IFNDEF NEXTGEN}
  574. procedure TFlexValue.SetAsAnsiString(const Value: AnsiString);
  575. begin
  576. Clear;
  577. fDataIntf := TValueAnsiString.Create(Value);
  578. fDataType := TValueDataType.dtAnsiString;
  579. end;
  580. {$ENDIF}
  581. procedure TFlexValue.SetAsBoolean(const Value: Boolean);
  582. begin
  583. Clear;
  584. fDataIntf := TValueInteger.Create(Value.ToInteger);
  585. fDataType := TValueDataType.dtBoolean;
  586. end;
  587. procedure TFlexValue.SetAsCardinal(const Value: Cardinal);
  588. begin
  589. Clear;
  590. fDataIntf := TValueInteger.Create(Value);
  591. fDataType := TValueDataType.dtInt64;
  592. end;
  593. procedure TFlexValue.SetAsClass(const Value: TClass);
  594. begin
  595. Clear;
  596. fDataIntf := TValuePointer.Create(Value);
  597. fDataType := TValueDataType.dtClass;
  598. end;
  599. procedure TFlexValue.SetAsDateTime(const Value: TDateTime);
  600. begin
  601. Clear;
  602. fDataIntf := TValueExtended.Create(Value);
  603. fDataType := TValueDataType.dtDateTime;
  604. end;
  605. procedure TFlexValue.SetAsExtended(const Value: Extended);
  606. begin
  607. Clear;
  608. fDataIntf := TValueExtended.Create(Value);
  609. fDataType := TValueDataType.dtExtended;
  610. end;
  611. procedure TFlexValue.SetAsInt64(const Value: Int64);
  612. begin
  613. Clear;
  614. fDataIntf := TValueInteger.Create(Value);
  615. fDataType := TValueDataType.dtInt64;
  616. end;
  617. procedure TFlexValue.SetAsInteger(const Value: Integer);
  618. begin
  619. Clear;
  620. fDataIntf := TValueInteger.Create(Value);
  621. fDataType := TValueDataType.dtInteger;
  622. end;
  623. procedure TFlexValue.SetAsObject(const Value: TObject);
  624. begin
  625. Clear;
  626. fDataIntf := TValuePointer.Create(Value);
  627. fDataType := TValueDataType.dtObject;
  628. end;
  629. procedure TFlexValue.SetAsPointer(const Value: Pointer);
  630. begin
  631. Clear;
  632. fDataIntf := TValuePointer.Create(Value);
  633. fDataType := TValueDataType.dtPointer;
  634. end;
  635. procedure TFlexValue.SetAsString(const Value: string);
  636. begin
  637. Clear;
  638. fDataIntf := TValueString.Create(Value);
  639. fDataType := TValueDataType.dtString;
  640. end;
  641. procedure TFlexValue.SetAsVariant(const Value: Variant);
  642. begin
  643. Clear;
  644. fDataIntf := TValueVariant.Create(Value);
  645. fDataType := TValueDataType.dtVariant;
  646. end;
  647. {$IFNDEF NEXTGEN}
  648. procedure TFlexValue.SetAsWideString(const Value: WideString);
  649. begin
  650. Clear;
  651. fDataIntf := TValueWideString.Create(Value);
  652. fDataType := TValueDataType.dtWideString;
  653. end;
  654. {$ENDIF}
  655. procedure TFlexValue._AddRef;
  656. begin
  657. if Assigned(fDataIntf) then fDataIntf._AddRef;
  658. end;
  659. procedure TFlexValue._Release;
  660. begin
  661. if Assigned(fDataIntf) then fDataIntf._Release;
  662. end;
  663. { TValueStringData }
  664. constructor TValueString.Create(const Value: string);
  665. begin
  666. fData := Value;
  667. end;
  668. function TValueString.GetValue: string;
  669. begin
  670. Result := fData;
  671. end;
  672. procedure TValueString.SetValue(const Value: string);
  673. begin
  674. fData := Value;
  675. end;
  676. { TValueVariantData }
  677. constructor TValueVariant.Create(const Value: Variant);
  678. begin
  679. fData := Value;
  680. end;
  681. function TValueVariant.GetValue: Variant;
  682. begin
  683. Result := fData;
  684. end;
  685. procedure TValueVariant.SetValue(const Value: Variant);
  686. begin
  687. fData := Value;
  688. end;
  689. { TValueAnsiStringData }
  690. {$IFNDEF NEXTGEN}
  691. constructor TValueAnsiString.Create(const Value: AnsiString);
  692. begin
  693. fData := Value;
  694. end;
  695. function TValueAnsiString.GetValue: AnsiString;
  696. begin
  697. Result := fData;
  698. end;
  699. procedure TValueAnsiString.SetValue(const Value: AnsiString);
  700. begin
  701. fData := Value;
  702. end;
  703. { TValueWideStringData }
  704. constructor TValueWideString.Create(const Value: WideString);
  705. begin
  706. fData := Value;
  707. end;
  708. function TValueWideString.GetValue: WideString;
  709. begin
  710. Result := fData;
  711. end;
  712. procedure TValueWideString.SetValue(const Value: WideString);
  713. begin
  714. fData := Value;
  715. end;
  716. {$ENDIF}
  717. { TValueInteger }
  718. constructor TValueInteger.Create(const Value: Int64);
  719. begin
  720. fData := Value;
  721. end;
  722. function TValueInteger.GetValue: Int64;
  723. begin
  724. Result := fData;
  725. end;
  726. procedure TValueInteger.SetValue(const Value: Int64);
  727. begin
  728. fData := Value;
  729. end;
  730. { TValuePointer }
  731. constructor TValuePointer.Create(const Value: Pointer);
  732. begin
  733. fData := Value;
  734. end;
  735. function TValuePointer.GetValue: Pointer;
  736. begin
  737. Result := fData;
  738. end;
  739. procedure TValuePointer.SetValue(const Value: Pointer);
  740. begin
  741. fData := Value;
  742. end;
  743. { TValueExtended }
  744. constructor TValueExtended.Create(const Value: Extended);
  745. begin
  746. fData := Value;
  747. end;
  748. function TValueExtended.GetValue: Extended;
  749. begin
  750. Result := fData;
  751. end;
  752. procedure TValueExtended.SetValue(const Value: Extended);
  753. begin
  754. fData := Value;
  755. end;
  756. end.