source: Include/com/variant.ab@ 208

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

[207]参照型変数のNothing初期化に対応する修正
File size: 12.4 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 End Function
522
523 Sub ValCy(x As Currency)
524 End Sub
525
526 'ValDate
527
528 Const Function ValStr() As BString
529 Dim r As VARIANT
530 ChangeType(r, 0, VT_BSTR)
531 Dim bs = New BString
532 bs.Attach(GetPointer(VarPtr(r.val)) As BSTR)
533 Return bs
534 End Function
535
536 Sub ValStr(x As BString)
537 Clear()
538 v.vt = VT_BSTR
539 SetPointer(VarPtr(v.val), x.Copy())
540 End Sub
541
542 Const Function ValUnknown() As *IUnknown
543 Dim r As VARIANT
544 ChangeType(r, 0, VT_UNKNOWN)
545 Return GetPointer(VarPtr(r.val)) As *IUnknown
546 End Function
547
548 Sub ValUnknown(x As *IUnknown)
549 Clear()
550 SetPointer(VarPtr(v.val), x.Copy())
551 x->AddRef()
552 v.vt = VT_UNKNOWN
553 End Sub
554
555 Const Function ValObject() As VBObject
556 Dim r As VARIANT
557 ChangeType(r, 0, VT_DISPATCH)
558 Dim o As VBObject
559 o.Attach(GetPointer(VarPtr(r.val)) As *IDispatch)
560 Return o
561 End Function
562
563 Sub ValObject(x As VBObject)
564 Clear()
565 SetPointer(VarPtr(v.val), x.Copy())
566 x->AddRef()
567 v.vt = VT_DISPATH
568 End Sub
569
570 'ValArray
571
572 'ValDecimal
573
574 Function PtrToVariant() As *VARIANT
575 Return VarPtr(v)
576 End Function
577
578 Static Function OptionalParam() As Variant
579' If _System_VariantOptionalParam = Nothing Then
580' 'ToDo マルチスレッド対応
581 _System_VariantOptionalParam = New Variant
582 _System_VariantOptionalParam.ValError = DISP_E_PARAMNOTFOUND
583' End If
584 Return _System_VariantOptionalParam
585 End Function
586Private
587 v As VARIANT
588
589 Static Sub Copy(ByRef dst As VARIANT, ByRef src As VARIANT)
590 VariantCopy(dst, src)
591 End Sub
592
593
594 Static Sub Move(ByRef dst As VARIANT, ByRef src As VARIANT)
595 dst = src
596' src.vt = VT_EMPTY
597 End Sub
598End Class
599
600'Dim _System_VariantOptionalParam = Nothing As Variant
601
602/*
603Function Abs(v As Variant) As Variant
604 Return v.Abs()
605End Function
606
607Function Fix(v As Variant) As Variant
608 Return v.Fix()
609End Function
610
611Function Int(v As Variant) As Variant
612 Return v.Int()
613End Function
614
615Function VarType(v As Variant) As VARTYPE
616 Return v.VarType()
617End Function
618*/
619
620#endif '_COM_VARIANT_AB
Note: See TracBrowser for help on using the repository browser.