Quick.Value.pas 35 KB

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