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

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

FormatIntegerDを実装。
UnitTestの失敗時の表示を目立つようにした。
ArrayListを名前空間System.Collectionsに入れた。
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
10Namespace ActiveBasic
11Namespace COM
12
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
24 Sub Variant(ByRef y As VARIANT)
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 ValStr = New BString(s)
112 End Sub
113
114 Sub Variant(n As Currency)
115 v.vt = VT_CY
116 SetQWord(VarPtr(v.val), n.Cy As QWord)
117 End Sub
118
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
124
125
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
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 Abs = New Variant
267 VarAbs(This.v, Abs.v)
268 End Function
269
270 Const Function Fix() As Variant
271 Fix = New Variant
272 VarFix(This.v, Fix.v)
273 End Function
274
275 Const Function Int() As Variant
276 Int = New Variant
277 VarInt(This.v, Int.v)
278 End Function
279
280 Const Function Round(cDecimals = 0 As Long) As Variant
281 Round = New Variant
282 VarRound(This.v, cDecimals, Round.v)
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
290 Return VarCmp(x.v, y.v, LOCALE_USER_DEFAULT, 0) 'VARCMP_NULL = 3を返す場合があるので注意
291 End Function
292/*
293 Const Function Operator ==(y As Variant) As Boolean
294 Dim c = Compare(This, y)
295 If c = VARCMP_EQ Then
296 Return True
297 Else
298 Return False
299 End If
300 End Function
301
302 Const Function Operator <>(y As Variant) As Boolean
303 Dim c = Compare(This, y)
304 If c <> VARCMP_EQ Then
305 Return True
306 Else
307 Return False
308 End If
309 End Function
310
311 Const Function Operator <(y As Variant) As Boolean
312 Dim c = Compare(This, y)
313 If c = VARCMP_LT Then
314 Return True
315 Else
316 Return False
317 End If
318 End Function
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*/
329/*
330 Const Function Operator <=(y As Variant) As Boolean
331 Dim c = Compare(This, y)
332 If c = VARCMP_LT Or c = VARCMP_EQ Then
333 Return True
334 Else
335 Return False
336 End If
337 End Function
338
339 Const Function Operator >=(y As Variant) As Boolean
340 Dim c = Compare(This, y)
341 If c = VARCMP_GT Or c = VARCMP_EQ Then
342 Return True
343 Else
344 Return False
345 End If
346 End Function
347*/
348 Const Function ChangeType(vt As VARTYPE, flags As Word) As Variant
349 Dim ret = New Variant
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
371 Dim tmp = ChangeType(VT_BSTR, VARIANT_ALPHABOOL)
372 Dim bs = ((tmp.v.val As ULONG_PTR) As BSTR)
373 Return New String(bs As PCWSTR, SysStringLen(bs) As Long)
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)
383 Return GetByte(VarPtr(r.v.val))
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)
394 Return GetWord(VarPtr(r.v.val))
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)
405 Return GetDWord(VarPtr(r.v.val))
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)
416 Return GetQWord(VarPtr(r.v.val))
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)
427 Return GetByte(VarPtr(r.v.val)) As SByte
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)
438 Return GetWord(VarPtr(r.v.val)) As Integer
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)
449 Return GetDWord(VarPtr(r.v.val)) As Long
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)
460 Return GetQWord(VarPtr(r.v.val)) As Int64
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)
471 Return GetSingle(VarPtr(r.v.val))
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)
482 Return GetDouble(VarPtr(r.v.val))
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)
493 Return GetWord(VarPtr(r.v.val))
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)
504 Return GetDWord(VarPtr(r.v.val))
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
513 Const Function ValCy() As Currency
514 Dim r = ChangeType(VT_CY)
515 ValCy = New Currency
516 ValCy.Cy = GetQWord(VarPtr(r.v.val))
517 End Function
518
519 Sub ValCy(x As Currency)
520 Clear()
521 SetQWord(VarPtr(v.val), x.Cy)
522 v.vt = VT_CY
523 End Sub
524
525 'ValDate
526
527 Const Function ValStr() As BString
528 Dim r As VARIANT
529 ChangeType(r, VARIANT_ALPHABOOL, VT_BSTR)
530 Dim bs = New BString
531 bs.Attach(GetPointer(VarPtr(r.val)) As BSTR)
532 Return bs
533 End Function
534
535 Sub ValStr(x As BString)
536 Clear()
537 v.vt = VT_BSTR
538 SetPointer(VarPtr(v.val), x.Copy())
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()
549 SetPointer(VarPtr(v.val), x)
550 x->AddRef()
551 v.vt = VT_UNKNOWN
552 End Sub
553/*
554 Const Function ValObject() As VBObject
555 Dim r As VARIANT
556 ChangeType(r, 0, VT_DISPATCH)
557 Dim o As VBObject
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
568*/
569 'ValArray
570
571 Const Function ValDecimal() As Decimal
572 Dim p = VarPtr(v) As *Decimal
573 Return New Deciaml(ByVal p)
574 End Function
575
576 Sub ValDecimal(x As Decimal)
577 Clear()
578 Dim p = VarPtr(v) As *DECIMAL
579 p[0] = x.Dec
580 v.vt = VT_DECIMAL '念の為
581 End Sub
582
583
584 Function PtrToVariant() As *VARIANT
585 Return VarPtr(v)
586 End Function
587
588 Static Function OptionalParam() As Variant
589' If _System_VariantOptionalParam = Nothing Then
590' 'ToDo マルチスレッド対応
591 VariantOptionalParam = New Variant
592 VariantOptionalParam.ValError = DISP_E_PARAMNOTFOUND
593' End If
594 Return VariantOptionalParam
595 End Function
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
608
609Dim VariantOptionalParam = Nothing As Variant
610
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
629End Namespace 'COM
630End Namespace 'ActiveBasic
631
632#endif '_COM_VARIANT_AB
Note: See TracBrowser for help on using the repository browser.