Quick.Value.pas 27 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996
  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 = record
  163. private
  164. {$IFNDEF FPC}
  165. fDataIntf : IInterface;
  166. {$ELSE}
  167. fDataIntf : TValueData;
  168. {$ENDIF}
  169. fDataType : TValueDataType;
  170. function CastToString : string;
  171. {$IFDEF MSWINDOWS}
  172. function CastToAnsiString : AnsiString;
  173. function CastToWideString : WideString;
  174. {$ENDIF}
  175. function CastToBoolean: Boolean;
  176. function CastToClass: TClass;
  177. function CastToExtended: Extended;
  178. function CastToInt64: Int64;
  179. function CastToInteger: Integer;
  180. function CastToDateTime : TDateTime;
  181. function CastToObject: TObject;
  182. function CastToPointer: Pointer;
  183. function CastToInterface: IInterface;
  184. function CastToVariant: Variant;
  185. function CastToCardinal : Cardinal;
  186. procedure SetAsString(const Value : string);
  187. {$IFDEF MSWINDOWS}
  188. procedure SetAsAnsiString(const Value : AnsiString);
  189. procedure SetAsWideString(const Value : WideString);
  190. {$ENDIF}
  191. procedure SetAsBoolean(const Value: Boolean);
  192. procedure SetAsClass(const Value: TClass);
  193. procedure SetAsExtended(const Value: Extended);
  194. procedure SetAsInt64(const Value: Int64);
  195. procedure SetAsInteger(const Value: Integer);
  196. procedure SetAsObject(const Value: TObject);
  197. procedure SetAsPointer(const Value: Pointer);
  198. procedure SetAsDateTime(const Value : TDateTime);
  199. procedure SetAsVariant(const Value: Variant);
  200. procedure SetAsCardinal(const Value : Cardinal);
  201. procedure SetAsInterface(const Value: IInterface);
  202. public
  203. constructor Create(const Value: TVarRec);
  204. property DataType : TValueDataType read fDataType;
  205. property AsString : string read CastToString write SetAsString;
  206. {$IFDEF MSWINDOWS}
  207. property AsAnsiString : AnsiString read CastToAnsiString write SetAsAnsiString;
  208. property AsWideString : WideString read CastToWideString write SetAsWideString;
  209. {$ENDIF}
  210. property AsInteger : Integer read CastToInteger write SetAsInteger;
  211. property AsInt64 : Int64 read CastToInt64 write SetAsInt64;
  212. property AsExtended : Extended read CastToExtended write SetAsExtended;
  213. property AsBoolean : Boolean read CastToBoolean write SetAsBoolean;
  214. property AsPointer : Pointer read CastToPointer write SetAsPointer;
  215. property AsClass : TClass read CastToClass write SetAsClass;
  216. property AsInterface : IInterface read CastToInterface write SetAsInterface;
  217. property AsObject : TObject read CastToObject write SetAsObject;
  218. property AsVariant : Variant read CastToVariant write SetAsVariant;
  219. property AsCardinal : Cardinal read CastToCardinal write SetAsCardinal;
  220. property AsDateTime : TDateTime read CastToDateTime write SetAsDateTime;
  221. //function AsType<T> : T;
  222. function IsNullOrEmpty : Boolean; inline;
  223. function IsString : Boolean; inline;
  224. function IsInteger : Boolean; inline;
  225. function IsFloating : Boolean; inline;
  226. function IsDateTime : Boolean; inline;
  227. function IsBoolean : Boolean; inline;
  228. function IsInterface : Boolean; inline;
  229. function IsObject : Boolean; inline;
  230. function IsPointer : Boolean; inline;
  231. function IsVariant : Boolean; inline;
  232. procedure Clear; inline;
  233. procedure _AddRef; inline;
  234. procedure _Release; inline;
  235. {$IFNDEF FPCS}
  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. {$ENDIF}
  257. end;
  258. TFlexPair = record
  259. Name : string;
  260. Value : 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. dtVariant : Result := (fDataIntf as IValueVariant).Value;
  483. else raise Exception.Create('DataType not supported');
  484. end;
  485. except
  486. on E : Exception do raise Exception.CreateFmt('TFlexValue conversion to Variant error: %s',[e.message]);
  487. end;
  488. end;
  489. function TFlexValue.CastToInterface: IInterface;
  490. begin
  491. try
  492. case fDataType of
  493. dtNull : Result := nil;
  494. dtInterface : Result := fDataIntf;
  495. dtPointer : Result := IInterface(fDataIntf);
  496. else raise Exception.Create('DataType not supported');
  497. end;
  498. except
  499. on E : Exception do raise Exception.CreateFmt('TFlexValue conversion to Interface error: %s',[e.message]);
  500. end;
  501. end;
  502. procedure TFlexValue.Clear;
  503. begin
  504. if Pointer(fDataIntf) <> nil then fDataIntf := nil;
  505. fDataType := dtNull;
  506. end;
  507. constructor TFlexValue.Create(const Value: TVarRec);
  508. begin
  509. case Value.VType of
  510. {$IFNDEF NEXTGEN}
  511. vtString : AsString := string(Value.VString^);
  512. vtChar : AsString := string(Value.VChar);
  513. {$ENDIF}
  514. {$IFDEF MSWINDOWS}
  515. vtAnsiString : AsAnsiString := AnsiString(Value.VAnsiString);
  516. vtWideString : AsWideString := WideString(Value.VWideString);
  517. {$ENDIF}
  518. {$IFDEF UNICODE}
  519. vtUnicodeString: AsString := string(Value.VUnicodeString);
  520. {$ENDIF UNICODE}
  521. vtInteger : AsInteger := Value.VInteger;
  522. vtInt64 : AsInt64 := Value.VInt64^;
  523. vtExtended : AsExtended := Value.VExtended^;
  524. vtBoolean : AsBoolean := Value.VBoolean;
  525. vtVariant : AsVariant := Value.VVariant^;
  526. vtInterface : AsInterface := IInterface(Value.VInterface);
  527. vtClass : AsClass := Value.VClass;
  528. vtObject : AsObject := Value.VObject;
  529. vtPointer : AsPointer := Value.VPointer;
  530. else raise Exception.Create('DataType not supported by TFlexValue');
  531. end;
  532. {$IFDEF FPC}
  533. fDataIntf._AddRef;
  534. {$ENDIF}
  535. end;
  536. {$IFNDEF FPCS}
  537. class operator TFlexValue.Implicit(Value: TFlexValue): Boolean;
  538. begin
  539. Result := Value.AsBoolean;
  540. end;
  541. class operator TFlexValue.Implicit(const Value: TFlexValue): string;
  542. begin
  543. Result := Value.AsString;
  544. end;
  545. class operator TFlexValue.Implicit(Value: TFlexValue): TObject;
  546. begin
  547. Result := Value.AsObject;
  548. end;
  549. class operator TFlexValue.Implicit(Value: TFlexValue): Pointer;
  550. begin
  551. Result := Value.AsPointer;
  552. end;
  553. class operator TFlexValue.Implicit(Value: TFlexValue): TDateTime;
  554. begin
  555. Result := Value.AsDateTime;
  556. end;
  557. class operator TFlexValue.Implicit(Value: TFlexValue): TClass;
  558. begin
  559. Result := Value.AsClass;
  560. end;
  561. class operator TFlexValue.Implicit(Value: TFlexValue): Int64;
  562. begin
  563. Result := Value.AsInt64;
  564. end;
  565. class operator TFlexValue.Implicit(Value: TFlexValue): Integer;
  566. begin
  567. Result := Value.AsInteger;
  568. end;
  569. class operator TFlexValue.Implicit(Value: TFlexValue): Extended;
  570. begin
  571. Result := Value.AsExtended;
  572. end;
  573. class operator TFlexValue.Implicit(Value: TFlexValue): Variant;
  574. begin
  575. Result := Value.AsVariant;
  576. end;
  577. class operator TFlexValue.Implicit(Value: Variant): TFlexValue;
  578. begin
  579. Result.AsVariant := Value;
  580. end;
  581. class operator TFlexValue.Implicit(const Value : string) : TFlexValue;
  582. begin
  583. Result.AsString := Value;
  584. end;
  585. class operator TFlexValue.Implicit(Value : Integer) : TFlexValue;
  586. begin
  587. Result.AsInteger := Value;
  588. end;
  589. class operator TFlexValue.Implicit(Value : Int64) : TFlexValue;
  590. begin
  591. Result.AsInt64 := Value;
  592. end;
  593. class operator TFlexValue.Implicit(Value : Extended) : TFlexValue;
  594. begin
  595. Result.AsExtended := Value;
  596. end;
  597. class operator TFlexValue.Implicit(Value : TDateTime) : TFlexValue;
  598. begin
  599. Result.AsDateTime := Value;
  600. end;
  601. class operator TFlexValue.Implicit(Value : Boolean) : TFlexValue;
  602. begin
  603. Result.AsBoolean := Value;
  604. end;
  605. class operator TFlexValue.Implicit(Value : TClass) : TFlexValue;
  606. begin
  607. Result.AsClass := Value;
  608. end;
  609. class operator TFlexValue.Implicit(Value : TObject) : TFlexValue;
  610. begin
  611. Result.AsObject := Value;
  612. end;
  613. class operator TFlexValue.Implicit(Value : Pointer) : TFlexValue;
  614. begin
  615. Result.AsPointer := Value;
  616. end;
  617. {$ENDIF}
  618. function TFlexValue.IsBoolean: Boolean;
  619. begin
  620. Result := fDataType = dtBoolean;
  621. end;
  622. function TFlexValue.IsDateTime: Boolean;
  623. begin
  624. Result := fDataType = dtDateTime;
  625. end;
  626. function TFlexValue.IsFloating: Boolean;
  627. begin
  628. Result := fDataType in [dtDouble,dtExtended];
  629. end;
  630. function TFlexValue.IsInteger: Boolean;
  631. begin
  632. Result := fDataType in [dtInteger,dtInt64];
  633. end;
  634. function TFlexValue.IsInterface: Boolean;
  635. begin
  636. Result := fDataType = dtInterface;
  637. end;
  638. function TFlexValue.IsNullOrEmpty: Boolean;
  639. begin
  640. Result := fDataIntf = nil;
  641. end;
  642. function TFlexValue.IsObject: Boolean;
  643. begin
  644. Result := fDataType = dtObject;
  645. end;
  646. function TFlexValue.IsPointer: Boolean;
  647. begin
  648. Result := fDataType = dtPointer;
  649. end;
  650. function TFlexValue.IsString: Boolean;
  651. begin
  652. Result := fDataType in [dtString,dtAnsiString,dtWideString];
  653. end;
  654. function TFlexValue.IsVariant: Boolean;
  655. begin
  656. Result := fDataType = dtVariant;
  657. end;
  658. {$IFDEF MSWINDOWS}
  659. procedure TFlexValue.SetAsAnsiString(const Value: AnsiString);
  660. begin
  661. Clear;
  662. fDataIntf := TValueAnsiString.Create(Value);
  663. fDataType := TValueDataType.dtAnsiString;
  664. end;
  665. {$ENDIF}
  666. procedure TFlexValue.SetAsBoolean(const Value: Boolean);
  667. begin
  668. Clear;
  669. fDataIntf := TValueInteger.Create(Value.ToInteger);
  670. fDataType := TValueDataType.dtBoolean;
  671. end;
  672. procedure TFlexValue.SetAsCardinal(const Value: Cardinal);
  673. begin
  674. Clear;
  675. fDataIntf := TValueInteger.Create(Value);
  676. fDataType := TValueDataType.dtInt64;
  677. end;
  678. procedure TFlexValue.SetAsClass(const Value: TClass);
  679. begin
  680. Clear;
  681. fDataIntf := TValuePointer.Create(Value);
  682. fDataType := TValueDataType.dtClass;
  683. end;
  684. procedure TFlexValue.SetAsDateTime(const Value: TDateTime);
  685. begin
  686. Clear;
  687. fDataIntf := TValueExtended.Create(Value);
  688. fDataType := TValueDataType.dtDateTime;
  689. end;
  690. procedure TFlexValue.SetAsExtended(const Value: Extended);
  691. begin
  692. Clear;
  693. fDataIntf := TValueExtended.Create(Value);
  694. fDataType := TValueDataType.dtExtended;
  695. end;
  696. procedure TFlexValue.SetAsInt64(const Value: Int64);
  697. begin
  698. Clear;
  699. fDataIntf := TValueInteger.Create(Value);
  700. fDataType := TValueDataType.dtInt64;
  701. end;
  702. procedure TFlexValue.SetAsInteger(const Value: Integer);
  703. begin
  704. Clear;
  705. fDataIntf := TValueInteger.Create(Value);
  706. fDataType := TValueDataType.dtInteger;
  707. end;
  708. procedure TFlexValue.SetAsInterface(const Value: IInterface);
  709. begin
  710. {$IFNDEF FPC}
  711. fDataIntf := Value;
  712. {$ELSE}
  713. fDataIntf := Pointer(Value);
  714. {$ENDIF}
  715. fDataType := TValueDataType.dtInterface;
  716. end;
  717. procedure TFlexValue.SetAsObject(const Value: TObject);
  718. begin
  719. Clear;
  720. fDataIntf := TValueObject.Create(Value);
  721. fDataType := TValueDataType.dtObject;
  722. end;
  723. procedure TFlexValue.SetAsPointer(const Value: Pointer);
  724. begin
  725. Clear;
  726. fDataIntf := TValuePointer.Create(Value);
  727. fDataType := TValueDataType.dtPointer;
  728. end;
  729. procedure TFlexValue.SetAsString(const Value: string);
  730. begin
  731. Clear;
  732. fDataIntf := TValueString.Create(Value);
  733. fDataType := TValueDataType.dtString;
  734. end;
  735. procedure TFlexValue.SetAsVariant(const Value: Variant);
  736. begin
  737. Clear;
  738. fDataIntf := TValueVariant.Create(Value);
  739. fDataType := TValueDataType.dtVariant;
  740. end;
  741. {$IFDEF MSWINDOWS}
  742. procedure TFlexValue.SetAsWideString(const Value: WideString);
  743. begin
  744. Clear;
  745. fDataIntf := TValueWideString.Create(Value);
  746. fDataType := TValueDataType.dtWideString;
  747. end;
  748. {$ENDIF}
  749. procedure TFlexValue._AddRef;
  750. begin
  751. if Assigned(fDataIntf) then fDataIntf._AddRef;
  752. end;
  753. procedure TFlexValue._Release;
  754. begin
  755. if Assigned(fDataIntf) then fDataIntf._Release;
  756. end;
  757. { TValueStringData }
  758. constructor TValueString.Create(const Value: string);
  759. begin
  760. fData := Value;
  761. end;
  762. function TValueString.GetValue: string;
  763. begin
  764. Result := fData;
  765. end;
  766. procedure TValueString.SetValue(const Value: string);
  767. begin
  768. fData := Value;
  769. end;
  770. { TValueVariantData }
  771. constructor TValueVariant.Create(const Value: Variant);
  772. begin
  773. fData := Value;
  774. end;
  775. function TValueVariant.GetValue: Variant;
  776. begin
  777. Result := fData;
  778. end;
  779. procedure TValueVariant.SetValue(const Value: Variant);
  780. begin
  781. fData := Value;
  782. end;
  783. { TValueAnsiStringData }
  784. {$IFDEF MSWINDOWS}
  785. constructor TValueAnsiString.Create(const Value: AnsiString);
  786. begin
  787. fData := Value;
  788. end;
  789. function TValueAnsiString.GetValue: AnsiString;
  790. begin
  791. Result := fData;
  792. end;
  793. procedure TValueAnsiString.SetValue(const Value: AnsiString);
  794. begin
  795. fData := Value;
  796. end;
  797. { TValueWideStringData }
  798. constructor TValueWideString.Create(const Value: WideString);
  799. begin
  800. fData := Value;
  801. end;
  802. function TValueWideString.GetValue: WideString;
  803. begin
  804. Result := fData;
  805. end;
  806. procedure TValueWideString.SetValue(const Value: WideString);
  807. begin
  808. fData := Value;
  809. end;
  810. {$ENDIF}
  811. { TValueInteger }
  812. constructor TValueInteger.Create(const Value: Int64);
  813. begin
  814. fData := Value;
  815. end;
  816. function TValueInteger.GetValue: Int64;
  817. begin
  818. Result := fData;
  819. end;
  820. procedure TValueInteger.SetValue(const Value: Int64);
  821. begin
  822. fData := Value;
  823. end;
  824. { TValuePointer }
  825. constructor TValuePointer.Create(const Value: Pointer);
  826. begin
  827. fData := Value;
  828. end;
  829. function TValuePointer.GetValue: Pointer;
  830. begin
  831. Result := fData;
  832. end;
  833. procedure TValuePointer.SetValue(const Value: Pointer);
  834. begin
  835. fData := Value;
  836. end;
  837. { TValueExtended }
  838. constructor TValueExtended.Create(const Value: Extended);
  839. begin
  840. fData := Value;
  841. end;
  842. function TValueExtended.GetValue: Extended;
  843. begin
  844. Result := fData;
  845. end;
  846. procedure TValueExtended.SetValue(const Value: Extended);
  847. begin
  848. fData := Value;
  849. end;
  850. { TValueObject }
  851. constructor TValueObject.Create(const Value: TObject);
  852. begin
  853. fData := Value;
  854. end;
  855. function TValueObject.GetValue: TObject;
  856. begin
  857. Result := fData;
  858. end;
  859. procedure TValueObject.SetValue(const Value: TObject);
  860. begin
  861. fData := Value;
  862. end;
  863. end.