variant.inc 25 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984
  1. {
  2. This file is part of the Free Pascal run time library.
  3. Copyright (c) 2001 by the Free Pascal development team
  4. This include file contains the implementation for variants
  5. support in FPC as far as it is part of the system unit
  6. See the file COPYING.FPC, included in this distribution,
  7. for details about the copyright.
  8. This program is distributed in the hope that it will be useful,
  9. but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  11. **********************************************************************}
  12. var
  13. variantmanager : tvariantmanager;
  14. procedure printmissingvariantunit;
  15. begin
  16. writeln(stderr);
  17. writeln(stderr,'Program needs probably the variants unit.');
  18. writeln(stderr,'Include the variants unit in your uses statements');
  19. writeln(stderr,'as one of the first units.');
  20. writeln(stderr);
  21. end;
  22. procedure invalidvariantop;
  23. begin
  24. printmissingvariantunit;
  25. HandleErrorFrame(221,get_frame);
  26. end;
  27. procedure invalidvariantopnovariants;
  28. begin
  29. printmissingvariantunit;
  30. HandleErrorFrame(221,get_frame);
  31. end;
  32. procedure vardisperror;
  33. begin
  34. printmissingvariantunit;
  35. HandleErrorFrame(222,get_frame);
  36. end;
  37. { ---------------------------------------------------------------------
  38. Compiler helper routines.
  39. ---------------------------------------------------------------------}
  40. procedure varclear(var v : tvardata);
  41. begin
  42. if not(v.vtype in [varempty,varerror,varnull]) then
  43. invalidvariantop;
  44. end;
  45. procedure variant_init(var v : tvardata);[Public,Alias:'FPC_VARIANT_INIT'];
  46. begin
  47. { calling the variant manager here is a problem because the static/global variants
  48. are initialized while the variant manager isn't assigned }
  49. fillchar(v,sizeof(variant),0);
  50. end;
  51. procedure variant_clear(var v : tvardata);[Public,Alias:'FPC_VARIANT_CLEAR'];
  52. begin
  53. if assigned(VarClearProc) then
  54. VarClearProc(v);
  55. end;
  56. procedure variant_addref(var v : tvardata);[Public,Alias:'FPC_VARIANT_ADDREF'];
  57. begin
  58. if assigned(VarAddRefProc) then
  59. VarAddRefProc(v);
  60. end;
  61. { using pointers as argument here makes life for the compiler easier }
  62. procedure fpc_variant_copy(d,s : pointer);compilerproc;
  63. begin
  64. if assigned(VarCopyProc) then
  65. VarCopyProc(tvardata(d^),tvardata(s^));
  66. end;
  67. Procedure fpc_write_text_variant(Len : Longint;var f : Text;const v : variant); iocheck; [Public,Alias:'FPC_WRITE_TEXT_VARIANT']; compilerproc;
  68. begin
  69. if (InOutRes<>0) then
  70. exit;
  71. case TextRec(f).mode of
  72. { fmAppend gets changed to fmOutPut in do_open (JM) }
  73. fmOutput:
  74. if len=-1 then
  75. variantmanager.write0variant(f,v)
  76. else
  77. variantmanager.writevariant(f,v,len);
  78. fmInput:
  79. InOutRes:=105
  80. else InOutRes:=103;
  81. end;
  82. end;
  83. procedure fpc_vararray_get(var d : variant;const s : variant;indices : psizeint;len : sizeint);compilerproc;
  84. begin
  85. d:=variantmanager.vararrayget(s,len,indices);
  86. end;
  87. procedure fpc_vararray_put(var d : variant;const s : variant;indices : psizeint;len : sizeint);compilerproc;
  88. begin
  89. variantmanager.vararrayput(d,s,len,indices);
  90. end;
  91. function fpc_variant_to_dynarray(const v : variant;typeinfo : pointer) : pointer;compilerproc;
  92. begin
  93. result:=nil;
  94. variantmanager.vartodynarray(result,v,typeinfo);
  95. end;
  96. function fpc_dynarray_to_variant(dynarr : pointer;typeinfo : pointer) : variant;compilerproc;
  97. begin
  98. variantmanager.varfromdynarray(result,dynarr,typeinfo);
  99. end;
  100. function fpc_variant_to_interface(const v : variant) : iinterface;compilerproc;
  101. begin
  102. variantmanager.vartointf(result,v);
  103. end;
  104. function fpc_interface_to_variant(const i : iinterface) : variant;compilerproc;
  105. begin
  106. variantmanager.varfromintf(result,i);
  107. end;
  108. { ---------------------------------------------------------------------
  109. Overloaded operators.
  110. ---------------------------------------------------------------------}
  111. { Integer }
  112. operator :=(const source : byte) dest : variant;{$ifdef SYSTEMINLINE}inline;{$endif}
  113. begin
  114. Variantmanager.varfromInt(Dest,Source,1);
  115. end;
  116. operator :=(const source : shortint) dest : variant;{$ifdef SYSTEMINLINE}inline;{$endif}
  117. begin
  118. Variantmanager.varfromInt(Dest,Source,-1);
  119. end;
  120. operator :=(const source : word) dest : variant;{$ifdef SYSTEMINLINE}inline;{$endif}
  121. begin
  122. Variantmanager.varfromInt(Dest,Source,2);
  123. end;
  124. operator :=(const source : smallint) dest : variant;{$ifdef SYSTEMINLINE}inline;{$endif}
  125. begin
  126. Variantmanager.varfromInt(Dest,Source,-2);
  127. end;
  128. operator :=(const source : dword) dest : variant;{$ifdef SYSTEMINLINE}inline;{$endif}
  129. begin
  130. Variantmanager.varfromInt(Dest,Source,4);
  131. end;
  132. operator :=(const source : longint) dest : variant;{$ifdef SYSTEMINLINE}inline;{$endif}
  133. begin
  134. Variantmanager.varfromInt(Dest,Source,-4);
  135. end;
  136. operator :=(const source : qword) dest : variant;{$ifdef SYSTEMINLINE}inline;{$endif}
  137. begin
  138. Variantmanager.varfromWord64(Dest,Source);
  139. end;
  140. operator :=(const source : int64) dest : variant;{$ifdef SYSTEMINLINE}inline;{$endif}
  141. begin
  142. Variantmanager.varfromInt64(Dest,Source);
  143. end;
  144. { Boolean }
  145. operator :=(const source : boolean) dest : variant;{$ifdef SYSTEMINLINE}inline;{$endif}
  146. begin
  147. Variantmanager.varfromBool(Dest,Source);
  148. end;
  149. operator :=(const source : wordbool) dest : variant;{$ifdef SYSTEMINLINE}inline;{$endif}
  150. begin
  151. Variantmanager.varfromBool(Dest,Boolean(Source));
  152. end;
  153. operator :=(const source : longbool) dest : variant;{$ifdef SYSTEMINLINE}inline;{$endif}
  154. begin
  155. Variantmanager.varfromBool(Dest,Boolean(Source));
  156. end;
  157. { Chars }
  158. operator :=(const source : char) dest : variant;{$ifdef SYSTEMINLINE}inline;{$endif}
  159. begin
  160. VariantManager.VarFromPStr(Dest,Source);
  161. end;
  162. operator :=(const source : widechar) dest : variant;{$ifdef SYSTEMINLINE}inline;{$endif}
  163. begin
  164. VariantManager.VarFromWStr(Dest,Source);
  165. end;
  166. { Strings }
  167. operator :=(const source : shortstring) dest : variant;{$ifdef SYSTEMINLINE}inline;{$endif}
  168. begin
  169. VariantManager.VarFromPStr(Dest,Source);
  170. end;
  171. operator :=(const source : ansistring) dest : variant;{$ifdef SYSTEMINLINE}inline;{$endif}
  172. begin
  173. VariantManager.VarFromLStr(Dest,Source);
  174. end;
  175. operator :=(const source : widestring) dest : variant;{$ifdef SYSTEMINLINE}inline;{$endif}
  176. begin
  177. VariantManager.VarFromWStr(Dest,Source);
  178. end;
  179. { Floats }
  180. {$ifdef SUPPORT_SINGLE}
  181. operator :=(const source : single) dest : variant;{$ifdef SYSTEMINLINE}inline;{$endif}
  182. begin
  183. VariantManager.VarFromReal(Dest,Source);
  184. end;
  185. {$endif SUPPORT_SINGLE}
  186. {$ifdef SUPPORT_DOUBLE}
  187. operator :=(const source : double) dest : variant;{$ifdef SYSTEMINLINE}inline;{$endif}
  188. begin
  189. VariantManager.VarFromReal(Dest,Source);
  190. end;
  191. {$endif SUPPORT_DOUBLE}
  192. {$ifdef SUPPORT_EXTENDED}
  193. operator :=(const source : extended) dest : variant;{$ifdef SYSTEMINLINE}inline;{$endif}
  194. begin
  195. VariantManager.VarFromReal(Dest,Source);
  196. end;
  197. {$endif SUPPORT_EXTENDED}
  198. {$ifdef SUPPORT_COMP}
  199. Operator :=(const source : comp) dest : variant;{$ifdef SYSTEMINLINE}inline;{$endif}
  200. begin
  201. VariantManager.VarFromReal(Dest,Source);
  202. end;
  203. {$endif SUPPORT_COMP}
  204. { Misc. }
  205. operator :=(const source : currency) dest : variant;{$ifdef SYSTEMINLINE}inline;{$endif}
  206. begin
  207. VariantManager.VarFromCurr(Dest,Source);
  208. end;
  209. operator :=(const source : tdatetime) dest : variant;{$ifdef SYSTEMINLINE}inline;{$endif}
  210. begin
  211. VariantManager.VarFromTDateTime(Dest,Source);
  212. end;
  213. operator :=(const source : error) dest : variant;{$ifdef SYSTEMINLINE}inline;{$endif}
  214. begin
  215. Variantmanager.varfromInt(Dest,Source,-sizeof(error));
  216. end;
  217. {**********************************************************************
  218. from Variant assignments
  219. **********************************************************************}
  220. { Integer }
  221. operator :=(const source : variant) dest : byte;{$ifdef SYSTEMINLINE}inline;{$endif}
  222. begin
  223. dest:=variantmanager.vartoint(source);
  224. end;
  225. operator :=(const source : variant) dest : shortint;{$ifdef SYSTEMINLINE}inline;{$endif}
  226. begin
  227. dest:=variantmanager.vartoint(source);
  228. end;
  229. operator :=(const source : variant) dest : word;{$ifdef SYSTEMINLINE}inline;{$endif}
  230. begin
  231. dest:=variantmanager.vartoint(source);
  232. end;
  233. operator :=(const source : variant) dest : smallint;{$ifdef SYSTEMINLINE}inline;{$endif}
  234. begin
  235. dest:=variantmanager.vartoint(source);
  236. end;
  237. operator :=(const source : variant) dest : dword;{$ifdef SYSTEMINLINE}inline;{$endif}
  238. begin
  239. dest:=variantmanager.vartoint(source);
  240. end;
  241. operator :=(const source : variant) dest : longint;{$ifdef SYSTEMINLINE}inline;{$endif}
  242. begin
  243. dest:=variantmanager.vartoint(source);
  244. end;
  245. operator :=(const source : variant) dest : qword;{$ifdef SYSTEMINLINE}inline;{$endif}
  246. begin
  247. dest:=variantmanager.vartoword64(source);
  248. end;
  249. operator :=(const source : variant) dest : int64;{$ifdef SYSTEMINLINE}inline;{$endif}
  250. begin
  251. dest:=variantmanager.vartoint64(source);
  252. end;
  253. { Boolean }
  254. operator :=(const source : variant) dest : boolean;{$ifdef SYSTEMINLINE}inline;{$endif}
  255. begin
  256. dest:=variantmanager.vartobool(source);
  257. end;
  258. operator :=(const source : variant) dest : wordbool;{$ifdef SYSTEMINLINE}inline;{$endif}
  259. begin
  260. dest:=variantmanager.vartobool(source);
  261. end;
  262. operator :=(const source : variant) dest : longbool;{$ifdef SYSTEMINLINE}inline;{$endif}
  263. begin
  264. dest:=variantmanager.vartobool(source);
  265. end;
  266. { Chars }
  267. operator :=(const source : variant) dest : char;{$ifdef SYSTEMINLINE}inline;{$endif}
  268. Var
  269. S : String;
  270. begin
  271. VariantManager.VarToPStr(S,Source);
  272. If Length(S)>0 then
  273. Dest:=S[1];
  274. end;
  275. operator :=(const source : variant) dest : widechar;{$ifdef SYSTEMINLINE}inline;{$endif}
  276. Var
  277. WS : WideString;
  278. begin
  279. VariantManager.VarToWStr(WS,Source);
  280. If Length(WS)>0 then
  281. Dest:=WS[1];
  282. end;
  283. { Strings }
  284. operator :=(const source : variant) dest : shortstring;{$ifdef SYSTEMINLINE}inline;{$endif}
  285. begin
  286. VariantManager.VarToPStr(Dest,Source);
  287. end;
  288. operator :=(const source : variant) dest : ansistring;{$ifdef SYSTEMINLINE}inline;{$endif}
  289. begin
  290. VariantManager.vartolstr(dest,source);
  291. end;
  292. operator :=(const source : variant) dest : widestring;{$ifdef SYSTEMINLINE}inline;{$endif}
  293. begin
  294. variantmanager.vartowstr(dest,source);
  295. end;
  296. { Floats }
  297. {$ifdef SUPPORT_SINGLE}
  298. operator :=(const source : variant) dest : single;{$ifdef SYSTEMINLINE}inline;{$endif}
  299. begin
  300. dest:=variantmanager.vartoreal(source);
  301. end;
  302. {$endif SUPPORT_SINGLE}
  303. {$ifdef SUPPORT_DOUBLE}
  304. operator :=(const source : variant) dest : double;{$ifdef SYSTEMINLINE}inline;{$endif}
  305. begin
  306. dest:=variantmanager.vartoreal(source);
  307. end;
  308. {$endif SUPPORT_DOUBLE}
  309. {$ifdef SUPPORT_EXTENDED}
  310. operator :=(const source : variant) dest : extended;{$ifdef SYSTEMINLINE}inline;{$endif}
  311. begin
  312. dest:=variantmanager.vartoreal(source);
  313. end;
  314. {$endif SUPPORT_EXTENDED}
  315. {$ifdef SUPPORT_COMP}
  316. operator :=(const source : variant) dest : comp;{$ifdef SYSTEMINLINE}inline;{$endif}
  317. begin
  318. dest:=comp(variantmanager.vartoreal(source));
  319. end;
  320. {$endif SUPPORT_COMP}
  321. { Misc. }
  322. operator :=(const source : variant) dest : currency;{$ifdef SYSTEMINLINE}inline;{$endif}
  323. begin
  324. dest:=variantmanager.vartocurr(source);
  325. end;
  326. operator :=(const source : variant) dest : tdatetime;{$ifdef SYSTEMINLINE}inline;{$endif}
  327. begin
  328. dest:=variantmanager.vartotdatetime(source);
  329. end;
  330. operator :=(const source : olevariant) dest : variant;{$ifdef SYSTEMINLINE}inline;{$endif}
  331. begin
  332. tvardata(result):=tvardata(source);
  333. end;
  334. operator :=(const source : variant) dest : olevariant;{$ifdef SYSTEMINLINE}inline;{$endif}
  335. begin
  336. variantmanager.olevarfromvar(dest,source);
  337. end;
  338. operator :=(const source : variant) dest : error;{$ifdef SYSTEMINLINE}inline;{$endif}
  339. begin
  340. dest:=variantmanager.vartoint(source);
  341. end;
  342. {**********************************************************************
  343. Operators
  344. **********************************************************************}
  345. operator or(const op1,op2 : variant) dest : variant;{$ifdef SYSTEMINLINE}inline;{$endif}
  346. begin
  347. dest:=op1;
  348. variantmanager.varop(dest,op2,opor);
  349. end;
  350. operator and(const op1,op2 : variant) dest : variant;{$ifdef SYSTEMINLINE}inline;{$endif}
  351. begin
  352. dest:=op1;
  353. variantmanager.varop(dest,op2,opand);
  354. end;
  355. operator xor(const op1,op2 : variant) dest : variant;{$ifdef SYSTEMINLINE}inline;{$endif}
  356. begin
  357. dest:=op1;
  358. variantmanager.varop(dest,op2,opxor);
  359. end;
  360. operator not(const op : variant) dest : variant;{$ifdef SYSTEMINLINE}inline;{$endif}
  361. begin
  362. dest:=op;
  363. variantmanager.varnot(dest);
  364. end;
  365. operator shl(const op1,op2 : variant) dest : variant;{$ifdef SYSTEMINLINE}inline;{$endif}
  366. begin
  367. dest:=op1;
  368. variantmanager.varop(dest,op2,opshiftleft);
  369. end;
  370. operator shr(const op1,op2 : variant) dest : variant;{$ifdef SYSTEMINLINE}inline;{$endif}
  371. begin
  372. dest:=op1;
  373. variantmanager.varop(dest,op2,opshiftright);
  374. end;
  375. operator +(const op1,op2 : variant) dest : variant;{$ifdef SYSTEMINLINE}inline;{$endif}
  376. begin
  377. dest:=op1;
  378. variantmanager.varop(dest,op2,opadd);
  379. end;
  380. operator -(const op1,op2 : variant) dest : variant;{$ifdef SYSTEMINLINE}inline;{$endif}
  381. begin
  382. dest:=op1;
  383. variantmanager.varop(dest,op2,opsubtract);
  384. end;
  385. operator *(const op1,op2 : variant) dest : variant;{$ifdef SYSTEMINLINE}inline;{$endif}
  386. begin
  387. dest:=op1;
  388. variantmanager.varop(dest,op2,opmultiply);
  389. end;
  390. operator /(const op1,op2 : variant) dest : variant;{$ifdef SYSTEMINLINE}inline;{$endif}
  391. begin
  392. dest:=op1;
  393. variantmanager.varop(dest,op2,opdivide);
  394. end;
  395. operator **(const op1,op2 : variant) dest : variant;{$ifdef SYSTEMINLINE}inline;{$endif}
  396. begin
  397. dest:=op1;
  398. variantmanager.varop(dest,op2,oppower);
  399. end;
  400. operator div(const op1,op2 : variant) dest : variant;{$ifdef SYSTEMINLINE}inline;{$endif}
  401. begin
  402. dest:=op1;
  403. variantmanager.varop(dest,op2,opintdivide);
  404. end;
  405. operator mod(const op1,op2 : variant) dest : variant;{$ifdef SYSTEMINLINE}inline;{$endif}
  406. begin
  407. dest:=op1;
  408. variantmanager.varop(dest,op2,opmodulus);
  409. end;
  410. operator -(const op : variant) dest : variant;{$ifdef SYSTEMINLINE}inline;{$endif}
  411. begin
  412. dest:=op;
  413. variantmanager.varneg(dest);
  414. end;
  415. operator =(const op1,op2 : variant) dest : boolean;{$ifdef SYSTEMINLINE}inline;{$endif}
  416. begin
  417. dest:=variantmanager.cmpop(op1,op2,opcmpeq);
  418. end;
  419. operator <(const op1,op2 : variant) dest : boolean;{$ifdef SYSTEMINLINE}inline;{$endif}
  420. begin
  421. dest:=variantmanager.cmpop(op1,op2,opcmplt);
  422. end;
  423. operator >(const op1,op2 : variant) dest : boolean;{$ifdef SYSTEMINLINE}inline;{$endif}
  424. begin
  425. dest:=variantmanager.cmpop(op1,op2,opcmpgt);
  426. end;
  427. operator >=(const op1,op2 : variant) dest : boolean;{$ifdef SYSTEMINLINE}inline;{$endif}
  428. begin
  429. dest:=variantmanager.cmpop(op1,op2,opcmpge);
  430. end;
  431. operator <=(const op1,op2 : variant) dest : boolean;{$ifdef SYSTEMINLINE}inline;{$endif}
  432. begin
  433. dest:=variantmanager.cmpop(op1,op2,opcmplt);
  434. end;
  435. procedure VarArrayRedim(var A: Variant; HighBound: SizeInt);
  436. begin
  437. variantmanager.vararrayredim(a,highbound);
  438. end;
  439. procedure VarCast(var dest : variant;const source : variant;vartype : longint);
  440. begin
  441. variantmanager.varcast(dest,source,vartype);
  442. end;
  443. {**********************************************************************
  444. from OLEVariant assignments
  445. **********************************************************************}
  446. { Integer }
  447. operator :=(const source : olevariant) dest : byte;{$ifdef SYSTEMINLINE}inline;{$endif}
  448. begin
  449. { cast away olevar to var conversion and avoid
  450. endless recursion }
  451. dest:=variantmanager.vartoint(variant(tvardata(source)));
  452. end;
  453. operator :=(const source : olevariant) dest : shortint;{$ifdef SYSTEMINLINE}inline;{$endif}
  454. begin
  455. dest:=variantmanager.vartoint(variant(tvardata(source)));
  456. end;
  457. operator :=(const source : olevariant) dest : word;{$ifdef SYSTEMINLINE}inline;{$endif}
  458. begin
  459. dest:=variantmanager.vartoint(variant(tvardata(source)));
  460. end;
  461. operator :=(const source : olevariant) dest : smallint;{$ifdef SYSTEMINLINE}inline;{$endif}
  462. begin
  463. dest:=variantmanager.vartoint(variant(tvardata(source)));
  464. end;
  465. operator :=(const source : olevariant) dest : dword;{$ifdef SYSTEMINLINE}inline;{$endif}
  466. begin
  467. dest:=variantmanager.vartoint(variant(tvardata(source)));
  468. end;
  469. operator :=(const source : olevariant) dest : longint;{$ifdef SYSTEMINLINE}inline;{$endif}
  470. begin
  471. dest:=variantmanager.vartoint(variant(tvardata(source)));
  472. end;
  473. operator :=(const source : olevariant) dest : qword;{$ifdef SYSTEMINLINE}inline;{$endif}
  474. begin
  475. dest:=variantmanager.vartoint64(variant(tvardata(source)));
  476. end;
  477. operator :=(const source : olevariant) dest : int64;{$ifdef SYSTEMINLINE}inline;{$endif}
  478. begin
  479. dest:=variantmanager.vartoword64(variant(tvardata(source)));
  480. end;
  481. { Boolean }
  482. operator :=(const source : olevariant) dest : boolean;{$ifdef SYSTEMINLINE}inline;{$endif}
  483. begin
  484. dest:=variantmanager.vartobool(variant(tvardata(source)));
  485. end;
  486. operator :=(const source : olevariant) dest : wordbool;{$ifdef SYSTEMINLINE}inline;{$endif}
  487. begin
  488. dest:=variantmanager.vartobool(variant(tvardata(source)));
  489. end;
  490. operator :=(const source : olevariant) dest : longbool;{$ifdef SYSTEMINLINE}inline;{$endif}
  491. begin
  492. dest:=variantmanager.vartobool(variant(tvardata(source)));
  493. end;
  494. { Chars }
  495. operator :=(const source : olevariant) dest : char;{$ifdef SYSTEMINLINE}inline;{$endif}
  496. var
  497. S : String;
  498. begin
  499. VariantManager.VarToPStr(S,Source);
  500. If Length(S)>0 then
  501. Dest:=S[1]
  502. else
  503. Dest:=#0;
  504. end;
  505. operator :=(const source : olevariant) dest : widechar;{$ifdef SYSTEMINLINE}inline;{$endif}
  506. Var
  507. WS : WideString;
  508. begin
  509. VariantManager.VarToWStr(WS,Source);
  510. If Length(WS)>0 then
  511. Dest:=WS[1]
  512. else
  513. Dest:=#0;
  514. end;
  515. { Strings }
  516. operator :=(const source : olevariant) dest : shortstring;{$ifdef SYSTEMINLINE}inline;{$endif}
  517. begin
  518. variantmanager.vartopstr(dest,variant(tvardata(source)));
  519. end;
  520. operator :=(const source : olevariant) dest : ansistring;{$ifdef SYSTEMINLINE}inline;{$endif}
  521. begin
  522. variantmanager.vartolstr(dest,variant(tvardata(source)));
  523. end;
  524. operator :=(const source : olevariant) dest : widestring;{$ifdef SYSTEMINLINE}inline;{$endif}
  525. begin
  526. variantmanager.vartowstr(dest,variant(tvardata(source)));
  527. end;
  528. { Floats }
  529. {$ifdef SUPPORT_SINGLE}
  530. operator :=(const source : olevariant) dest : single;{$ifdef SYSTEMINLINE}inline;{$endif}
  531. begin
  532. dest:=variantmanager.vartoreal(variant(tvardata(source)));
  533. end;
  534. {$endif SUPPORT_SINGLE}
  535. {$ifdef SUPPORT_DOUBLE}
  536. operator :=(const source : olevariant) dest : double;{$ifdef SYSTEMINLINE}inline;{$endif}
  537. begin
  538. dest:=variantmanager.vartoreal(variant(tvardata(source)));
  539. end;
  540. {$endif SUPPORT_DOUBLE}
  541. {$ifdef SUPPORT_EXTENDED}
  542. operator :=(const source : olevariant) dest : extended;{$ifdef SYSTEMINLINE}inline;{$endif}
  543. begin
  544. dest:=variantmanager.vartoreal(variant(tvardata(source)));
  545. end;
  546. {$endif SUPPORT_EXTENDED}
  547. {$ifdef SUPPORT_COMP}
  548. operator :=(const source : olevariant) dest : comp;{$ifdef SYSTEMINLINE}inline;{$endif}
  549. begin
  550. dest:=variantmanager.vartoreal(variant(tvardata(source)));
  551. end;
  552. {$endif SUPPORT_COMP}
  553. { Misc. }
  554. operator :=(const source : olevariant) dest : currency;{$ifdef SYSTEMINLINE}inline;{$endif}
  555. begin
  556. dest:=variantmanager.vartocurr(variant(tvardata(source)));
  557. end;
  558. operator :=(const source : olevariant) dest : tdatetime;{$ifdef SYSTEMINLINE}inline;{$endif}
  559. begin
  560. dest:=variantmanager.vartotdatetime(variant(tvardata(source)));
  561. end;
  562. operator :=(const source : olevariant) dest : error;{$ifdef SYSTEMINLINE}inline;{$endif}
  563. begin
  564. dest:=variantmanager.vartoint(variant(tvardata(source)));
  565. end;
  566. {**********************************************************************
  567. to OLEVariant assignments
  568. **********************************************************************}
  569. operator :=(const source : byte) dest : olevariant;{$ifdef SYSTEMINLINE}inline;{$endif}
  570. begin
  571. variantmanager.olevarfromint(dest,source,1);
  572. end;
  573. operator :=(const source : shortint) dest : olevariant;{$ifdef SYSTEMINLINE}inline;{$endif}
  574. begin
  575. variantmanager.olevarfromint(dest,source,-1);
  576. end;
  577. operator :=(const source : word) dest : olevariant;{$ifdef SYSTEMINLINE}inline;{$endif}
  578. begin
  579. variantmanager.olevarfromint(dest,source,2);
  580. end;
  581. operator :=(const source : smallint) dest : olevariant;{$ifdef SYSTEMINLINE}inline;{$endif}
  582. begin
  583. variantmanager.olevarfromint(dest,source,-2);
  584. end;
  585. operator :=(const source : dword) dest : olevariant;{$ifdef SYSTEMINLINE}inline;{$endif}
  586. begin
  587. variantmanager.olevarfromint(dest,source,4);
  588. end;
  589. operator :=(const source : longint) dest : olevariant;{$ifdef SYSTEMINLINE}inline;{$endif}
  590. begin
  591. variantmanager.olevarfromint(dest,source,-4);
  592. end;
  593. operator :=(const source : qword) dest : olevariant;{$ifdef SYSTEMINLINE}inline;{$endif}
  594. begin
  595. variantmanager.olevarfromint(dest,source,8);
  596. end;
  597. operator :=(const source : int64) dest : olevariant;{$ifdef SYSTEMINLINE}inline;{$endif}
  598. begin
  599. variantmanager.olevarfromint(dest,source,-8);
  600. end;
  601. { Boolean }
  602. operator :=(const source : boolean) dest : olevariant;{$ifdef SYSTEMINLINE}inline;{$endif}
  603. begin
  604. variantmanager.varfromBool(variant(tvardata(dest)),Source);
  605. end;
  606. operator :=(const source : wordbool) dest : olevariant;{$ifdef SYSTEMINLINE}inline;{$endif}
  607. begin
  608. variantmanager.varfromBool(variant(tvardata(Dest)),Source);
  609. end;
  610. operator :=(const source : longbool) dest : olevariant;{$ifdef SYSTEMINLINE}inline;{$endif}
  611. begin
  612. variantmanager.varfromBool(variant(tvardata(Dest)),Source);
  613. end;
  614. { Chars }
  615. operator :=(const source : char) dest : olevariant;{$ifdef SYSTEMINLINE}inline;{$endif}
  616. begin
  617. variantmanager.olevarfrompstr(dest,source);
  618. end;
  619. operator :=(const source : widechar) dest : olevariant;{$ifdef SYSTEMINLINE}inline;{$endif}
  620. begin
  621. variantmanager.varfromwstr(variant(tvardata(dest)),source);
  622. end;
  623. { Strings }
  624. operator :=(const source : shortstring) dest : olevariant;{$ifdef SYSTEMINLINE}inline;{$endif}
  625. begin
  626. variantmanager.olevarfrompstr(dest,source);
  627. end;
  628. operator :=(const source : ansistring) dest : olevariant;{$ifdef SYSTEMINLINE}inline;{$endif}
  629. begin
  630. variantmanager.olevarfromlstr(dest,source);
  631. end;
  632. operator :=(const source : widestring) dest : olevariant;{$ifdef SYSTEMINLINE}inline;{$endif}
  633. begin
  634. variantmanager.varfromwstr(variant(tvardata(dest)),source);
  635. end;
  636. { Floats }
  637. {$ifdef SUPPORT_SINGLE}
  638. operator :=(const source : single) dest : olevariant;{$ifdef SYSTEMINLINE}inline;{$endif}
  639. begin
  640. variantmanager.varfromreal(variant(tvardata(dest)),source);
  641. end;
  642. {$endif SUPPORT_SINGLE}
  643. {$ifdef SUPPORT_DOUBLE}
  644. operator :=(const source : double) dest : olevariant;{$ifdef SYSTEMINLINE}inline;{$endif}
  645. begin
  646. variantmanager.varfromreal(variant(tvardata(dest)),source);
  647. end;
  648. {$endif SUPPORT_DOUBLE}
  649. {$ifdef SUPPORT_EXTENDED}
  650. operator :=(const source : extended) dest : olevariant;{$ifdef SYSTEMINLINE}inline;{$endif}
  651. begin
  652. variantmanager.varfromreal(variant(tvardata(dest)),source);
  653. end;
  654. {$endif SUPPORT_EXTENDED}
  655. {$ifdef SUPPORT_COMP}
  656. operator :=(const source : comp) dest : olevariant;{$ifdef SYSTEMINLINE}inline;{$endif}
  657. begin
  658. variantmanager.varfromreal(variant(tvardata(dest)),source);
  659. end;
  660. {$endif SUPPORT_COMP}
  661. { Misc. }
  662. operator :=(const source : currency) dest : olevariant;{$ifdef SYSTEMINLINE}inline;{$endif}
  663. begin
  664. variantmanager.varfromcurr(variant(tvardata(dest)),source);
  665. end;
  666. operator :=(const source : tdatetime) dest : olevariant;{$ifdef SYSTEMINLINE}inline;{$endif}
  667. begin
  668. variantmanager.varfromtdatetime(variant(tvardata(dest)),source);
  669. end;
  670. operator :=(const source : error) dest : olevariant;{$ifdef SYSTEMINLINE}inline;{$endif}
  671. begin
  672. variantmanager.olevarfromint(dest,source,-sizeof(error));
  673. end;
  674. {**********************************************************************
  675. Variant manager functions
  676. **********************************************************************}
  677. procedure GetVariantManager(var VarMgr: TVariantManager);
  678. begin
  679. VarMgr:=VariantManager;
  680. end;
  681. procedure SetVariantManager(const VarMgr: TVariantManager);
  682. begin
  683. VariantManager:=VarMgr;
  684. end;
  685. function IsVariantManagerSet: Boolean;
  686. var
  687. i : longint;
  688. begin
  689. I:=0;
  690. Result:=True;
  691. While Result and (I<(sizeof(tvariantmanager) div sizeof(pointer))-1) do
  692. begin
  693. Result:=Pointer(ppointer(@variantmanager+i*sizeof(pointer))^)<>Pointer(@invalidvariantop);
  694. Inc(I);
  695. end;
  696. end;
  697. procedure initvariantmanager;
  698. var
  699. i : longint;
  700. begin
  701. VarDispProc:=@vardisperror;
  702. DispCallByIDProc:=@vardisperror;
  703. tvardata(Unassigned).VType:=varEmpty;
  704. tvardata(Null).VType:=varNull;
  705. for i:=0 to (sizeof(tvariantmanager) div sizeof(pointer))-1 do
  706. ppointer(@variantmanager+i*sizeof(pointer))^:=@invalidvariantopnovariants;
  707. pointer(variantmanager.varclear):=@varclear
  708. end;