Context Navigation

variant.ab@ 339

Last change on this file since 339 was 211, checked in by イグトランス (egtra), 18 years ago
Decimalを追加、OAIdl.abの一応の完成など
File size: 12.8 KB

Line
1	' com/variant.ab
2
3	#ifndef _COM_VARIANT_AB
4	#define _COM_VARIANT_AB
5
6	#require <oaidl.ab>
7	#require <oleauto.ab>
8	#require <com/index.ab>
9
10	Class Variant
11	Public
12	Sub Variant()
13	VariantInit(v)
14	End Sub
15
16	Sub Variant(y As Variant)
17	VariantInit(v)
18	VariantCopy(v, y.v)
19	End Sub
20
21	Sub Variant(ByRef y As VARIANT)
22	VariantInit(v)
23	VariantCopy(v, y)
24	End Sub
25
26	Sub Variant(n As SByte)
27	v.vt = VT_I1
28	SetByte(VarPtr(v.val), n)
29	End Sub
30
31	Sub Variant(n As Byte)
32	v.vt = VT_UI1
33	SetByte(VarPtr(v.val), n)
34	End Sub
35
36	Sub Variant(n As Integer)
37	v.vt = VT_I2
38	SetWord(VarPtr(v.val), n)
39	End Sub
40
41	Sub Variant(n As Word)
42	v.vt = VT_UI2
43	SetWord(VarPtr(v.val), n)
44	End Sub
45
46	Sub Variant(n As Long)
47	v.vt = VT_I4
48	SetDWord(VarPtr(v.val), n)
49	End Sub
50
51	Sub Variant(n As DWord)
52	v.vt = VT_UI4
53	SetDWord(VarPtr(v.val), n)
54	End Sub
55
56	Sub Variant(n As Int64)
57	v.vt = VT_I8
58	SetQWord(VarPtr(v.val), n)
59	End Sub
60
61	Sub Variant(n As QWord)
62	v.vt = VT_UI8
63	SetQWord(VarPtr(v.val), n)
64	End Sub
65
66	Sub Variant(n As Single)
67	v.vt = VT_R4
68	SetSingle(VarPtr(v.val), n)
69	End Sub
70
71	Sub Variant(n As Double)
72	v.vt = VT_R8
73	SetDouble(VarPtr(v.val), n)
74	End Sub
75
76	Sub Variant(bs As BString)
77	v.vt = VT_BSTR
78	SetPointer(VarPtr(v.val), SysAllocStringLen(bs.BStr, bs.Length))
79	End Sub
80
81	Sub Variant(p As *IUnknown)
82	p->AddRef()
83	v.vt = VT_UNKNOWN
84	SetPointer(VarPtr(v.val), p)
85	End Sub
86
87	Sub Variant(p As *IDispatch)
88	p->AddRef()
89	v.vt = VT_DISPATCH
90	SetPointer(VarPtr(v.val), p)
91	End Sub
92	/*
93	Sub Variant(b As VARIANT_BOOL)
94	v.vt = VT_BOOL
95	SetWord(VarPtr(v.val), b)
96	End Sub
97	*/
98	Sub Variant(b As Boolean)
99	v.vt = VT_BOOL
100	If b Then
101	SetWord(VarPtr(v.val), VARIANT_TRUE)
102	Else
103	SetWord(VarPtr(v.val), VARIANT_FALSE)
104	End If
105	End Sub
106
107	Sub Variant(s As String)
108	Dim bs As BString(s)
109	Variant(bs)
110	End Sub
111
112	Sub Variant(n As Currency)
113	v.vt = VT_CY
114	SetQWord(VarPtr(v.val), n.Cy As QWord)
115	End Sub
116
117
118	Sub ~Variant()
119	Clear()
120	End Sub
121
122	Sub Clear()
123	VariantClear(v)
124	v.vt = VT_EMPTY
125	End Sub
126
127	Sub Operator =(y As Variant)
128	Assign(y.v)
129	End Sub
130
131	Sub Operator =(y As VARIANT)
132	Assign(y)
133	End Sub
134
135	Sub Assign(from As Variant)
136	Assign(from.v)
137	End Sub
138
139	Sub Assign(ByRef from As VARIANT)
140	Variant.Copy(v, from)
141	End Sub
142
143	Sub AssignInd(ByRef from As VARIANT)
144	VariantCopyInd(v, from)
145	End Sub
146
147	Sub Attach(ByRef from As VARIANT)
148	Variant.Move(v, from)
149	End Sub
150
151	Const Function Copy() As VARIANT
152	Variant.Copy(Copy, v)
153	End Function
154
155	Function Detach() As VARIANT
156	Variant.Move(Detach, v)
157	End Function
158	/*
159	Static Function Assgin(ByRef from As VARIANT) As Variant
160	Assign = New Variant
161	Assgin.Assign(from)
162	End Function
163
164	Static Function Attach(ByRef from As VARIANT) As Variant
165	Attach = New Variant
166	Attach.Attach(from)
167	End Function
168	*/
169	'Operators
170
171	Const Function Operator ^(y As Variant) As Variant
172	Dim ret = New Variant
173	VarPow(This.v, y.v, ret.v)
174	Return ret
175	End Function
176
177	Const Function Operator +() As Variant
178	Return New Variant(This)
179	End Function
180
181	Const Function Operator -() As Variant
182	Dim ret = New Variant
183	VarNeg(This.v, ret.v)
184	Return ret
185	End Function
186
187	Const Function Operator *(y As Variant) As Variant
188	Dim ret = New Variant
189	VarMul(This.v, y.v, ret.v)
190	Return ret
191	End Function
192
193	Const Function Operator /(y As Variant) As Variant
194	Dim ret = New Variant
195	VarDiv(This.v, y.v, ret.v)
196	Return ret
197	End Function
198
199	Const Function Operator \(y As Variant) As Variant
200	Dim ret = New Variant
201	VarIDiv(This.v, y.v, ret.v)
202	Return ret
203	End Function
204
205	Const Function Operator Mod(y As Variant) As Variant
206	Dim ret = New Variant
207	VarMod(This.v, y.v, ret.v)
208	Return ret
209	End Function
210
211	Const Function Operator +(y As Variant) As Variant
212	Dim ret = New Variant
213	VarAdd(This.v, y.v, ret.v)
214	Return ret
215	End Function
216
217	Const Function Operator -(y As Variant) As Variant
218	Dim ret = New Variant
219	VarSub(This.v, y.v, ret.v)
220	Return ret
221	End Function
222
223	Const Function Operator &(y As Variant) As Variant
224	Dim ret = New Variant
225	VarCat(This.v, y.v, ret.v)
226	Return ret
227	End Function
228
229	Const Function Operator And(y As Variant) As Variant
230	Dim ret = New Variant
231	VarAnd(This.v, y.v, ret.v)
232	Return ret
233	End Function
234
235	Const Function Operator Or(y As Variant) As Variant
236	Dim ret = New Variant
237	VarOr(This.v, y.v, ret.v)
238	Return ret
239	End Function
240
241	Const Function Operator Xor(y As Variant) As Variant
242	Dim ret = New Variant
243	VarXor(This.v, y.v, ret.v)
244	Return ret
245	End Function
246
247	Const Function Operator Not() As Variant
248	Dim ret = New Variant
249	VarNot(This.v, ret.v)
250	Return ret
251	End Function
252
253	Static Function Imp(x As Variant, y As Variant) As Variant
254	Dim ret = New Variant
255	VarImp(x.v, y.v, ret.v)
256	Return ret
257	End Function
258
259	Static Function Eqv(x As Variant, y As Variant) As Variant
260	Dim ret = New Variant
261	VarEqv(x.v, y.v, ret.v)
262	Return ret
263	End Function
264
265	Const Function Abs() As Variant
266	Dim ret = New Variant
267	VarAbs(This.v, ret.v)
268	Return ret
269	End Function
270
271	Const Function Fix() As Variant
272	Dim ret = New Variant
273	VarFix(This.v, ret.v)
274	Return ret
275	End Function
276
277	Const Function Int() As Variant
278	Dim ret = New Variant
279	VarInt(This.v, ret.v)
280	Return ret
281	End Function
282
283	Const Function Round(cDecimals As Long) As Variant
284	Dim ret = New Variant
285	VarRound(This.v, cDecimals, ret)
286	Return ret
287	End Function
288
289	Const Function Round() As Variant
290	Return Round(0)
291	End Function
292
293	Static Function Compare(x As Variant, y As Variant, lcid As LCID, flags As DWord) As HRESULT
294	Return VarCmp(x.v, y.v, lcid, flags)
295	End Function
296
297	Static Function Compare(x As Variant, y As Variant) As HRESULT
298	Return VarCmp(x.v, y.v, LOCALE_USER_DEFAULT, 0) 'VARCMP_NULL = 3を返す場合があるので注意
299	End Function
300
301	Const Function Operator ==(y As Variant) As Boolean
302	Dim c = Compare(This, y)
303	If c = VARCMP_EQ Then
304	Return True
305	Else
306	Return False
307	End If
308	End Function
309
310	Const Function Operator <>(y As Variant) As Boolean
311	Dim c = Compare(This, y)
312	If c <> VARCMP_EQ Then
313	Return True
314	Else
315	Return False
316	End If
317	End Function
318
319	Const Function Operator <(y As Variant) As Boolean
320	Dim c = Compare(This, y)
321	If c = VARCMP_LT Then
322	Return True
323	Else
324	Return False
325	End If
326	End Function
327	/*
328	Const Function Operator >(y As Variant) As Boolean
329	Dim c = Compare(This, y)
330	If c = VARCMP_GT Then
331	Return True
332	Else
333	Return False
334	End If
335	End Function
336	*/
337	Const Function Operator <=(y As Variant) As Boolean
338	Dim c = Compare(This, y)
339	If result = VARCMP_LT Or result = VARCMP_EQ Then
340	Return True
341	Else
342	Return False
343	End If
344	End Function
345
346	Const Function Operator >=(y As Variant) As Boolean
347	Dim c = Compare(This, y)
348	If result = VARCMP_GT Or result = VARCMP_EQ Then
349	Return True
350	Else
351	Return False
352	End If
353	End Function
354
355	Const Function ChangeType(vt As VARTYPE, flags As Word) As Variant
356	Dim ret = New Variant
357	ChangeType(ret, flags, vt)
358	Return ret
359	End Function
360
361	Const Function ChangeType(vt As VARTYPE) As Variant
362	Return ChangeType(vt, 0)
363	End Function
364
365	Const Function ChangeType(ByRef ret As VARIANT, flags As Word, vt As VARTYPE) As HRESULT
366	Return VariantChangeType(ret, v, flags, vt)
367	End Function
368
369	Const Function ChangeType(ByRef ret As Variant, flags As Word, vt As VARTYPE) As HRESULT
370	Return ChangeType(ret.v, flags, vt)
371	End Function
372
373	Const Function VarType() As VARTYPE
374	Return v.vt
375	End Function
376
377	Override Function ToString() As String
378	Dim tmp = ChangeType(VT_BSTR)
379	Dim bs = ((tmp.v.val As ULONG_PTR) As BSTR)
380	Return New String(bs As PCWSTR, SysStringLen(bs) As Long)
381	End Function
382
383	Override Function GetHashCode() As Long
384	Dim p = (VarPtr(v) As *DWord)
385	Return (p[0] Xor p[1] Xor p[2] Xor p[3]) As Long
386	End Function
387
388	Const Function ValUI1() As Byte
389	Dim r = ChangeType(VT_UI1)
390	Return GetByte(VarPtr(r.val))
391	End Function
392
393	Sub ValUI1(x As Byte)
394	Clear()
395	SetByte(VarPtr(v.val), x)
396	v.vt = VT_UI1
397	End Sub
398
399	Const Function ValUI2() As Word
400	Dim r = ChangeType(VT_UI2)
401	Return GetWord(VarPtr(r.val))
402	End Function
403
404	Sub ValUI2(x As Word)
405	Clear()
406	SetWord(VarPtr(v.val), x)
407	v.vt = VT_UI2
408	End Sub
409
410	Const Function ValUI4() As DWord
411	Dim r = ChangeType(VT_UI4)
412	Return GetDWord(VarPtr(r.val))
413	End Function
414
415	Sub ValUI4(x As DWord)
416	Clear()
417	SetDWord(VarPtr(v.val), x)
418	v.vt = VT_UI4
419	End Sub
420
421	Const Function ValUI8() As QWord
422	Dim r = ChangeType(VT_UI8)
423	Return GetQWord(VarPtr(r.val))
424	End Function
425
426	Sub ValUI8(x As QWord)
427	Clear()
428	SetQWord(VarPtr(v.val), x)
429	v.vt = VT_UI8
430	End Sub
431
432	Const Function ValI1() As SByte
433	Dim r = ChangeType(VT_I1)
434	Return GetByte(VarPtr(r.val)) As SByte
435	End Function
436
437	Sub ValI1(x As SByte)
438	Clear()
439	SetByte(VarPtr(v.val), x As Byte)
440	v.vt = VT_I1
441	End Sub
442
443	Const Function ValI2() As Integer
444	Dim r = ChangeType(VT_I2)
445	Return GetWord(VarPtr(r.val)) As Integer
446	End Function
447
448	Sub ValI2(x As Integer)
449	Clear()
450	SetWord(VarPtr(v.val), x As Word)
451	v.vt = VT_I2
452	End Sub
453
454	Const Function ValI4() As Long
455	Dim r = ChangeType(VT_I4)
456	Return GetDWord(VarPtr(r.val)) As Long
457	End Function
458
459	Sub ValI4(x As Long)
460	Clear()
461	SetDWord(VarPtr(v.val), x As DWord)
462	v.vt = VT_I4
463	End Sub
464
465	Const Function ValI8() As Int64
466	Dim r = ChangeType(VT_I8)
467	Return GetQWord(VarPtr(r.val)) As Int64
468	End Function
469
470	Sub ValI8(x As Int64)
471	Clear()
472	SetQWord(VarPtr(v.val), x As QWord)
473	v.vt = VT_I8
474	End Sub
475
476	Const Function ValR4() As Single
477	Dim r = ChangeType(VT_R4)
478	Return GetSingle(VarPtr(r.val))
479	End Function
480
481	Sub ValR4(x As Single)
482	Clear()
483	SetDWord(VarPtr(v.val), x)
484	v.vt = VT_R4
485	End Sub
486
487	Const Function ValR8() As Double
488	Dim r = ChangeType(VT_UI8)
489	Return GetDouble(VarPtr(r.val))
490	End Function
491
492	Sub ValR8(x As Double)
493	Clear()
494	SetDouble(VarPtr(v.val), x)
495	v.vt = VT_R8
496	End Sub
497
498	Const Function ValBool() As VARIANT_BOOL
499	Dim r = ChangeType(VT_BOOL)
500	Return GetWord(VarPtr(r.val))
501	End Function
502
503	Sub ValBool(x As VARIANT_BOOL)
504	Clear()
505	SetWord(VarPtr(v.val), x)
506	v.vt = VT_BOOL
507	End Sub
508
509	Const Function ValError() As SCODE
510	Dim r = ChangeType(VT_ERROR)
511	Return GetDWord(VarPtr(r.val))
512	End Function
513
514	Sub ValError(x As SCODE)
515	Clear()
516	SetDWord(VarPtr(v.val), x)
517	v.vt = VT_ERROR
518	End Sub
519
520	Const Function ValCy() As Currency
521	Dim r = ChangeType(VT_CY)
522	ValCy = New Currency
523	ValCy.Cy = GetQWord(VarPtr(r.val))
524	End Function
525
526	Sub ValCy(x As Currency)
527	Clear()
528	SetQWord(VarPtr(v.val), x.Cy)
529	v.vt = VT_CY
530	End Sub
531
532	'ValDate
533
534	Const Function ValStr() As BString
535	Dim r As VARIANT
536	ChangeType(r, 0, VT_BSTR)
537	Dim bs = New BString
538	bs.Attach(GetPointer(VarPtr(r.val)) As BSTR)
539	Return bs
540	End Function
541
542	Sub ValStr(x As BString)
543	Clear()
544	v.vt = VT_BSTR
545	SetPointer(VarPtr(v.val), x.Copy())
546	End Sub
547
548	Const Function ValUnknown() As *IUnknown
549	Dim r As VARIANT
550	ChangeType(r, 0, VT_UNKNOWN)
551	Return GetPointer(VarPtr(r.val)) As *IUnknown
552	End Function
553
554	Sub ValUnknown(x As *IUnknown)
555	Clear()
556	SetPointer(VarPtr(v.val), x.Copy())
557	x->AddRef()
558	v.vt = VT_UNKNOWN
559	End Sub
560
561	Const Function ValObject() As VBObject
562	Dim r As VARIANT
563	ChangeType(r, 0, VT_DISPATCH)
564	Dim o As VBObject
565	o.Attach(GetPointer(VarPtr(r.val)) As *IDispatch)
566	Return o
567	End Function
568
569	Sub ValObject(x As VBObject)
570	Clear()
571	SetPointer(VarPtr(v.val), x.Copy())
572	x->AddRef()
573	v.vt = VT_DISPATH
574	End Sub
575
576	'ValArray
577
578	Const Function ValDecimal() As Decimal
579	Dim p = VarPtr(v) As *Decimal
580	Return New Deciaml(p[0])
581	End Function
582
583	Sub ValDecimal(x As Decimal)
584	Clear()
585	Dim p = VarPtr(v) As *Decimal
586	p[0] = x.Dec
587	v.vt = VT_DECIMAL '念の為
588	End Sub
589
590
591	Function PtrToVariant() As *VARIANT
592	Return VarPtr(v)
593	End Function
594
595	Static Function OptionalParam() As Variant
596	' If _System_VariantOptionalParam = Nothing Then
597	' 'ToDo マルチスレッド対応
598	_System_VariantOptionalParam = New Variant
599	_System_VariantOptionalParam.ValError = DISP_E_PARAMNOTFOUND
600	' End If
601	Return _System_VariantOptionalParam
602	End Function
603	Private
604	v As VARIANT
605
606	Static Sub Copy(ByRef dst As VARIANT, ByRef src As VARIANT)
607	VariantCopy(dst, src)
608	End Sub
609
610	Static Sub Move(ByRef dst As VARIANT, ByRef src As VARIANT)
611	dst = src
612	' src.vt = VT_EMPTY
613	End Sub
614	End Class
615
616	'Dim _System_VariantOptionalParam = Nothing As Variant
617
618	/*
619	Function Abs(v As Variant) As Variant
620	Return v.Abs()
621	End Function
622
623	Function Fix(v As Variant) As Variant
624	Return v.Fix()
625	End Function
626
627	Function Int(v As Variant) As Variant
628	Return v.Int()
629	End Function
630
631	Function VarType(v As Variant) As VARTYPE
632	Return v.VarType()
633	End Function
634	*/
635
636	#endif '_COM_VARIANT_AB

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

Original Format