source: Include/com/variant.ab@ 200

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

Currencyにメンバを追加
File size: 12.1 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 'Operators
160
161 Const Function Operator ^(y As Variant) As Variant
162 Dim ret As Variant
163 VarPow(This.v, y.v, ret.v)
164 Return ret
165 End Function
166
167 Const Function Operator +() As Variant
168 Return New Variant(This)
169 End Function
170
171 Const Function Operator -() As Variant
172 Dim ret As Variant
173 VarNeg(This.v, ret.v)
174 Return ret
175 End Function
176
177 Const Function Operator *(y As Variant) As Variant
178 Dim ret As Variant
179 VarMul(This.v, y.v, ret.v)
180 Return ret
181 End Function
182
183 Const Function Operator /(y As Variant) As Variant
184 Dim ret As Variant
185 VarDiv(This.v, y.v, ret.v)
186 Return ret
187 End Function
188
189 Const Function Operator \(y As Variant) As Variant
190 Dim ret As Variant
191 VarIDiv(This.v, y.v, ret.v)
192 Return ret
193 End Function
194
195 Const Function Operator Mod(y As Variant) As Variant
196 Dim ret As Variant
197 VarMod(This.v, y.v, ret.v)
198 Return ret
199 End Function
200
201 Const Function Operator +(y As Variant) As Variant
202 Dim ret As Variant
203 VarAdd(This.v, y.v, ret.v)
204 Return ret
205 End Function
206
207 Const Function Operator -(y As Variant) As Variant
208 Dim ret As Variant
209 VarSub(This.v, y.v, ret.v)
210 Return ret
211 End Function
212
213 Const Function Operator &(y As Variant) As Variant
214 Dim ret As Variant
215 VarCat(This.v, y.v, ret.v)
216 Return ret
217 End Function
218
219 Const Function Operator And(y As Variant) As Variant
220 Dim ret As Variant
221 VarAnd(This.v, y.v, ret.v)
222 Return ret
223 End Function
224
225 Const Function Operator Or(y As Variant) As Variant
226 Dim ret As Variant
227 VarOr(This.v, y.v, ret.v)
228 Return ret
229 End Function
230
231 Const Function Operator Xor(y As Variant) As Variant
232 Dim ret As Variant
233 VarXor(This.v, y.v, ret.v)
234 Return ret
235 End Function
236
237 Const Function Operator Not() As Variant
238 Dim ret As Variant
239 VarNot(This.v, ret.v)
240 Return ret
241 End Function
242
243 Static Function Imp(x As Variant, y As Variant) As Variant
244 Dim ret As Variant
245 VarImp(x.v, y.v, ret.v)
246 Return ret
247 End Function
248
249 Static Function Eqv(x As Variant, y As Variant) As Variant
250 Dim ret As Variant
251 VarEqv(x.v, y.v, ret.v)
252 Return ret
253 End Function
254
255 Const Function Abs() As Variant
256 Dim ret As Variant
257 VarAbs(This.v, ret.v)
258 Return ret
259 End Function
260
261 Const Function Fix() As Variant
262 Dim ret As Variant
263 VarFix(This.v, ret.v)
264 Return ret
265 End Function
266
267 Const Function Int() As Variant
268 Dim ret As Variant
269 VarInt(This.v, ret.v)
270 Return ret
271 End Function
272
273 Const Function Round(cDecimals As Long) As Variant
274 Dim ret As Variant
275 VarRound(This.v, cDecimals, ret)
276 Return ret
277 End Function
278
279 Const Function Round() As Variant
280 Return Round(0)
281 End Function
282
283 Static Function Compare(x As Variant, y As Variant, lcid As LCID, flags As DWord) As HRESULT
284 Return VarCmp(x.v, y.v, lcid, flags)
285 End Function
286
287 Static Function Compare(x As Variant, y As Variant) As HRESULT
288 Return VarCmp(x.v, y.v, GetUserDefaultLCID(), 0) 'VARCMP_NULL = 3を返す場合があるので注意
289 End Function
290
291 Const Function Operator ==(y As Variant) As Boolean
292 Dim c = Compare(This, y)
293 If c = VARCMP_EQ Then
294 Return True
295 Else
296 Return False
297 End If
298 End Function
299
300 Const Function Operator <>(y As Variant) As Boolean
301 Dim c = Compare(This, y)
302 If c <> VARCMP_EQ Then
303 Return True
304 Else
305 Return False
306 End If
307 End Function
308
309 Const Function Operator <(y As Variant) As Boolean
310 Dim c = Compare(This, y)
311 If c = VARCMP_LT Then
312 Return True
313 Else
314 Return False
315 End If
316 End Function
317/*
318 Const Function Operator >(y As Variant) As Boolean
319 Dim c = Compare(This, y)
320 If c = VARCMP_GT Then
321 Return True
322 Else
323 Return False
324 End If
325 End Function
326*/
327 Const Function Operator <=(y As Variant) As Boolean
328 Dim c = Compare(This, y)
329 If result = VARCMP_LT Or result = VARCMP_EQ Then
330 Return True
331 Else
332 Return False
333 End If
334 End Function
335
336 Const Function Operator >=(y As Variant) As Boolean
337 Dim c = Compare(This, y)
338 If result = VARCMP_GT Or result = VARCMP_EQ Then
339 Return True
340 Else
341 Return False
342 End If
343 End Function
344
345 Const Function ChangeType(vt As VARTYPE, flags As Word) As Variant
346 Dim ret As Variant
347 ChangeType(ret, flags, vt)
348 Return ret
349 End Function
350
351 Const Function ChangeType(vt As VARTYPE) As Variant
352 Return ChangeType(vt, 0)
353 End Function
354
355 Const Function ChangeType(ByRef ret As VARIANT, flags As Word, vt As VARTYPE) As HRESULT
356 Return VariantChangeType(ret, v, flags, vt)
357 End Function
358
359 Const Function ChangeType(ByRef ret As Variant, flags As Word, vt As VARTYPE) As HRESULT
360 Return ChangeType(ret.v, flags, vt)
361 End Function
362
363 Const Function VarType() As VARTYPE
364 Return v.vt
365 End Function
366
367 Override Function ToString() As String
368 Dim tmp = ChangeType(VT_BSTR)
369 Dim bs = ((tmp.v.val As ULONG_PTR) As BSTR)
370 Dim s As String(bs As PCWSTR, SysStringLen(bs) As Long)
371 Return s
372 End Function
373
374 Override Function GetHashCode() As Long
375 Dim p = (VarPtr(v) As *DWord)
376 Return (p[0] Xor p[1] Xor p[2] Xor p[3]) As Long
377 End Function
378
379 Const Function ValUI1() As Byte
380 Dim r = ChangeType(VT_UI1)
381 Return GetByte(VarPtr(r.val))
382 End Function
383
384 Sub ValUI1(x As Byte)
385 Clear()
386 SetByte(VarPtr(v.val), x)
387 v.vt = VT_UI1
388 End Sub
389
390 Const Function ValUI2() As Word
391 Dim r = ChangeType(VT_UI2)
392 Return GetWord(VarPtr(r.val))
393 End Function
394
395 Sub ValUI2(x As Word)
396 Clear()
397 SetWord(VarPtr(v.val), x)
398 v.vt = VT_UI2
399 End Sub
400
401 Const Function ValUI4() As DWord
402 Dim r = ChangeType(VT_UI4)
403 Return GetDWord(VarPtr(r.val))
404 End Function
405
406 Sub ValUI4(x As DWord)
407 Clear()
408 SetDWord(VarPtr(v.val), x)
409 v.vt = VT_UI4
410 End Sub
411
412 Const Function ValUI8() As QWord
413 Dim r = ChangeType(VT_UI8)
414 Return GetQWord(VarPtr(r.val))
415 End Function
416
417 Sub ValUI8(x As QWord)
418 Clear()
419 SetQWord(VarPtr(v.val), x)
420 v.vt = VT_UI8
421 End Sub
422
423 Const Function ValI1() As SByte
424 Dim r = ChangeType(VT_I1)
425 Return GetByte(VarPtr(r.val)) As SByte
426 End Function
427
428 Sub ValI1(x As SByte)
429 Clear()
430 SetByte(VarPtr(v.val), x As Byte)
431 v.vt = VT_I1
432 End Sub
433
434 Const Function ValI2() As Integer
435 Dim r = ChangeType(VT_I2)
436 Return GetWord(VarPtr(r.val)) As Integer
437 End Function
438
439 Sub ValI2(x As Integer)
440 Clear()
441 SetWord(VarPtr(v.val), x As Word)
442 v.vt = VT_I2
443 End Sub
444
445 Const Function ValI4() As Long
446 Dim r = ChangeType(VT_I4)
447 Return GetDWord(VarPtr(r.val)) As Long
448 End Function
449
450 Sub ValI4(x As Long)
451 Clear()
452 SetDWord(VarPtr(v.val), x As DWord)
453 v.vt = VT_I4
454 End Sub
455
456 Const Function ValI8() As Int64
457 Dim r = ChangeType(VT_I8)
458 Return GetQWord(VarPtr(r.val)) As Int64
459 End Function
460
461 Sub ValI8(x As Int64)
462 Clear()
463 SetQWord(VarPtr(v.val), x As QWord)
464 v.vt = VT_I8
465 End Sub
466
467 Const Function ValR4() As Single
468 Dim r = ChangeType(VT_R4)
469 Return GetSingle(VarPtr(r.val))
470 End Function
471
472 Sub ValR4(x As Single)
473 Clear()
474 SetDWord(VarPtr(v.val), x)
475 v.vt = VT_R4
476 End Sub
477
478 Const Function ValR8() As Double
479 Dim r = ChangeType(VT_UI8)
480 Return GetDouble(VarPtr(r.val))
481 End Function
482
483 Sub ValR8(x As Double)
484 Clear()
485 SetDouble(VarPtr(v.val), x)
486 v.vt = VT_R8
487 End Sub
488
489 Const Function ValBool() As VARIANT_BOOL
490 Dim r = ChangeType(VT_BOOL)
491 Return GetWord(VarPtr(r.val))
492 End Function
493
494 Sub ValBool(x As VARIANT_BOOL)
495 Clear()
496 SetWord(VarPtr(v.val), x)
497 v.vt = VT_BOOL
498 End Sub
499
500 Const Function ValError() As SCODE
501 Dim r = ChangeType(VT_ERROR)
502 Return GetDWord(VarPtr(r.val))
503 End Function
504
505 Sub ValError(x As SCODE)
506 Clear()
507 SetDWord(VarPtr(v.val), x)
508 v.vt = VT_ERROR
509 End Sub
510
511 Const Function ValCy() As Currency
512 End Function
513
514 Sub ValCy(x As Currency)
515 End Sub
516
517 'ValDate
518
519 Const Function ValStr() As BString
520 Dim r As VARIANT
521 ChangeType(r, 0, VT_BSTR)
522 Dim bs As BString
523 bs.Attach(GetPointer(VarPtr(r.val)) As BSTR)
524 Return bs
525 End Function
526
527 Sub ValStr(x As BString)
528 Clear()
529 v.vt = VT_BSTR
530 End Sub
531
532 Const Function ValUnknown() As *IUnknown
533 Dim r As VARIANT
534 ChangeType(r, 0, VT_UNKNOWN)
535 Return GetPointer(VarPtr(r.val)) As *IUnknown
536 End Function
537
538 Sub ValUnknown(x As *IUnknown)
539 Clear()
540 SetPointer(VarPtr(v.val), x.Copy())
541 x->AddRef()
542 v.vt = VT_UNKNOWN
543 End Sub
544
545 Const Function ValObject() As VBObject
546 Dim r As VARIANT
547 ChangeType(r, 0, VT_DISPATCH)
548 Dim o As VBObject
549 o.Attach(GetPointer(VarPtr(r.val)) As *IDispatch)
550 Return o
551 End Function
552
553 Sub ValObject(x As VBObject)
554 Clear()
555 SetPointer(VarPtr(v.val), x.Copy())
556 x->AddRef()
557 v.vt = VT_DISPATH
558 End Sub
559
560 'ValArray
561
562 'ValDecimal
563
564 Function PtrToVariant() As *VARIANT
565 Return VarPtr(v)
566 End Function
567
568 Static Function OptionalParam() As Variant
569' If _System_VariantOptionalParam = Nothing Then
570' 'ToDo マルチスレッド対応
571 _System_VariantOptionalParam = New Variant
572 _System_VariantOptionalParam.ValError = DISP_E_PARAMNOTFOUND
573' End If
574 Return _System_VariantOptionalParam
575 End Function
576Private
577 v As VARIANT
578
579 Static Sub Copy(ByRef dst As VARIANT, ByRef src As VARIANT)
580 VariantCopy(dst, src)
581 End Sub
582
583
584 Static Sub Move(ByRef dst As VARIANT, ByRef src As VARIANT)
585 dst = src
586' src.vt = VT_EMPTY
587 End Sub
588End Class
589
590Dim _System_VariantOptionalParam = Nothing As Variant
591
592/*
593Function Abs(v As Variant) As Variant
594 Return v.Abs()
595End Function
596
597Function Fix(v As Variant) As Variant
598 Return v.Fix()
599End Function
600
601Function Int(v As Variant) As Variant
602 Return v.Int()
603End Function
604
605Function VarType(v As Variant) As VARTYPE
606 Return v.VarType()
607End Function
608*/
609
610#endif '_COM_VARIANT_AB
Note: See TracBrowser for help on using the repository browser.