source: Include/com/variant.ab@ 175

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

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