source: Include/com/variant.ab@ 267

Last change on this file since 267 was 267, checked in by イグトランス (egtra), 17 years ago

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