source: trunk/Include/com/variant.ab@ 383

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

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