source: Include/com/variant.ab@ 244

Last change on this file since 244 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
10Class Variant
11Public
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
603Private
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
614End Class
615
616'Dim _System_VariantOptionalParam = Nothing As Variant
617
618/*
619Function Abs(v As Variant) As Variant
620 Return v.Abs()
621End Function
622
623Function Fix(v As Variant) As Variant
624 Return v.Fix()
625End Function
626
627Function Int(v As Variant) As Variant
628 Return v.Int()
629End Function
630
631Function VarType(v As Variant) As VARTYPE
632 Return v.VarType()
633End Function
634*/
635
636#endif '_COM_VARIANT_AB
Note: See TracBrowser for help on using the repository browser.