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