source: Include/com/variant.ab@ 192

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

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