Ignore:
Timestamp:
Jun 29, 2009, 4:03:45 AM (15 years ago)
Author:
イグトランス (egtra)
Message:

最新のコンパイラに通るように修正。参照クラスのセマンティクスに合うように修正(Setter系プロパティの削除など)。

File:
1 edited

Legend:

Unmodified
Added
Removed

  • trunk/ab5.0/ablib/src/com/variant.ab

    r478 r709  
    77
    88Class Variant
     9    Implements System.IDisposable, System.ICloneable
    910Public
    1011    Sub Variant()
    … …  
    1213    End Sub
    1314
     15    Sub Variant(ByRef y As VARIANT)
     16        VariantInit(v)
     17        VariantCopy(v, y)
     18    End Sub
     19
     20    ' 仮
    1421    Sub Variant(y As Variant)
    1522        VariantInit(v)
    … …  
    1724    End Sub
    1825
    19     Sub Variant(ByRef y As VARIANT)
    20         VariantInit(v)
    21         VariantCopy(v, y)
    22     End Sub
    23 
    2426    Sub Variant(n As SByte)
    2527        v.vt = VT_I1
    … …  
    7476    Sub Variant(bs As BString)
    7577        v.vt = VT_BSTR
    76         SetPointer(VarPtr(v.val), bs.Copy))
     78        SetPointer(VarPtr(v.val), bs.Copy())
    7779    End Sub
    7880
    7981    Sub Variant(unk As IUnknown)
    80         If Not IsNothing(unk) Then unk.AddRef()
     82        If ObjPtr(unk) <> 0 Then unk.AddRef()
    8183        v.vt = VT_UNKNOWN
    8284        SetPointer(VarPtr(v.val), ObjPtr(unk))
    … …  
    8486
    8587    Sub Variant(disp As IDispatch)
    86         If Not IsNothing(disp) Then disp.AddRef()
     88        If ObjPtr(disp) <> 0 Then disp.AddRef()
    8789        v.vt = VT_DISPATCH
    8890        SetPointer(VarPtr(v.val), ObjPtr(disp))
    … …  
    104106
    105107    Sub Variant(s As String)
    106         ValStr = New BString(s)
    107     End Sub
     108        v.vt = VT_BSTR
     109        If IsNothing(s) Then
     110            initWithStr(0)
     111        Else
     112            initWithStr(0)
     113        End If
     114    End Sub
     115
     116    Sub Variant(s As BSTR)
     117        initWithStr(s)
     118    End Sub
     119Private
     120    Sub initWithStr(bs As BSTR)
     121        v.vt = VT_BSTR
     122        If bs = NULL Then
     123            SetPointer(VarPtr(v.val), SysAllocStringLen(0, 0))
     124        Else
     125            SetPointer(VarPtr(v.val), SysAllocStringByteLen(bs As PCSTR, SysStringByteLen(bs)))
     126        End If
     127    End Sub
     128
     129Public
    108130
    109131    Sub Variant(n As Currency)
    … …  
    118140    End Sub
    119141
    120 
    121142    Sub ~Variant()
    122         Clear()
    123     End Sub
    124 
    125     Sub Clear()
     143        Dispose()
     144    End Sub
     145
     146    Sub Dispose()
    126147        VariantClear(v)
    127148        v.vt = VT_EMPTY
    128149    End Sub
    129150
    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
     151    Sub Clear()
     152        Dispose()
     153    End Sub
     154
     155    Virtual Function Clone() As Variant
     156        Clone = New Variant(This)
     157    End Function
     158
     159    Function Copy() As VARIANT
    147160        Variant.Copy(Copy, v)
    148161    End Function
    … …  
    151164        Variant.Move(Detach, v)
    152165    End Function
    153 /*
    154     Static Function Assgin(ByRef from As VARIANT) As Variant
    155         Assign = New Variant
    156         Assgin.Assign(from)
     166
     167    Static Function CopyFrom(ByRef from As VARIANT) As Variant
     168        CopyFrom = New Variant
     169        Variant.Copy(CopyFrom.v, from)
    157170    End Function
    158171
    159172    Static Function Attach(ByRef from As VARIANT) As Variant
    160173        Attach = New Variant
    161         Attach.Attach(from)
    162     End Function
    163 */
     174        Variant.Move(Attach.v, from)
     175    End Function
     176
     177    Static Function CopyIndirectFrom(ByRef from As VARIANT) As Variant
     178        CopyIndirectFrom = New Variant
     179        VariantCopyInd(CopyIndirectFrom.v, from)
     180    End Function
     181
    164182    'Operators
    165183/*
    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)
     184    Function Operator ^(y As Variant) As Variant
     185        Dim ret = New Variant
     186        Windows.ThrowIfFailed(VarPow(This.v, y.v, ret.v))
     187        Return ret
     188    End Function
     189*/
     190    Function Operator +() As Variant
     191'       Return Clone()
     192    End Function
     193
     194    Function Operator -() As Variant
     195        Dim ret = New Variant
     196        Windows.ThrowIfFailed(VarNeg(This.v, ret.v))
     197        Return ret
     198    End Function
     199
     200    Function Operator *(y As Variant) As Variant
     201        Dim ret = New Variant
     202        Windows.ThrowIfFailed(VarMul(This.v, y.v, ret.v))
     203        Return ret
     204    End Function
     205
     206    Function Operator /(y As Variant) As Variant
     207        Dim ret = New Variant
     208        Windows.ThrowIfFailed(VarDiv(This.v, y.v, ret.v))
     209        Return ret
     210    End Function
     211
     212    Function Operator \(y As Variant) As Variant
     213        Dim ret = New Variant
     214        Windows.ThrowIfFailed(VarIdiv(This.v, y.v, ret.v))
     215        Return ret
     216    End Function
     217
     218    Function Operator Mod(y As Variant) As Variant
     219        Dim ret = New Variant
     220        Windows.ThrowIfFailed(VarMod(This.v, y.v, ret.v))
     221        Return ret
     222    End Function
     223
     224    Function Operator +(y As Variant) As Variant
     225        Dim ret = New Variant
     226        Windows.ThrowIfFailed(VarAdd(This.v, y.v, ret.v))
     227        Return ret
     228    End Function
     229
     230    Function Operator -(y As Variant) As Variant
     231        Dim ret = New Variant
     232        Windows.ThrowIfFailed(VarSub(This.v, y.v, ret.v))
     233        Return ret
     234    End Function
     235
     236    Function Operator &(y As Variant) As Variant
     237        Dim ret = New Variant
     238        Windows.ThrowIfFailed(VarCat(This.v, y.v, ret.v))
     239        Return ret
     240    End Function
     241
     242    Function Operator And(y As Variant) As Variant
     243        Dim ret = New Variant
     244        Windows.ThrowIfFailed(VarAnd(This.v, y.v, ret.v))
     245        Return ret
     246    End Function
     247
     248    Function Operator Or(y As Variant) As Variant
     249        Dim ret = New Variant
     250        Windows.ThrowIfFailed(VarOr(This.v, y.v, ret.v))
     251        Return ret
     252    End Function
     253
     254    Function Operator Xor(y As Variant) As Variant
     255        Dim ret = New Variant
     256        Windows.ThrowIfFailed(VarXor(This.v, y.v, ret.v))
     257        Return ret
     258    End Function
     259
     260    Function Operator Not() As Variant
     261        Dim ret = New Variant
     262        Windows.ThrowIfFailed(VarNot(This.v, ret.v))
    245263        Return ret
    246264    End Function
    … …  
    248266    Static Function Imp(x As Variant, y As Variant) As Variant
    249267        Dim ret = New Variant
    250         VarImp(x.v, y.v, ret.v)
     268        Windows.ThrowIfFailed(VarImp(x.v, y.v, ret.v))
    251269        Return ret
    252270    End Function
    … …  
    254272    Static Function Eqv(x As Variant, y As Variant) As Variant
    255273        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
     274        Windows.ThrowIfFailed(VarEqv(x.v, y.v, ret.v))
     275        Return ret
     276    End Function
     277
     278    Function Abs() As Variant
    261279        Abs = New Variant
    262         VarAbs(This.v, Abs.v)
    263     End Function
    264 
    265     Const Function Fix() As Variant
     280        Windows.ThrowIfFailed(VarAbs(This.v, Abs.v))
     281    End Function
     282
     283    Function Fix() As Variant
    266284        Fix = New Variant
    267         VarFix(This.v, Fix.v)
    268     End Function
    269 
    270     Const Function Int() As Variant
     285        Windows.ThrowIfFailed(VarFix(This.v, Fix.v))
     286    End Function
     287
     288    Function Int() As Variant
    271289        Int = New Variant
    272         VarInt(This.v, Int.v)
    273     End Function
    274 
    275     Const Function Round(cDecimals = 0 As Long) As Variant
     290        Windows.ThrowIfFailed(VarInt(This.v, Int.v))
     291    End Function
     292
     293    Function Round(cDecimals = 0 As Long) As Variant
    276294        Round = New Variant
    277         VarRound(This.v, cDecimals, Round.v)
    278     End Function
    279 
     295        Windows.ThrowIfFailed(VarRound(This.v, cDecimals, Round.v))
     296    End Function
     297
     298    ' ThrowIfFailedを使っていないことに注意
    280299    Static Function Compare(x As Variant, y As Variant, lcid As LCID, flags As DWord) As HRESULT
    281300        Return VarCmp(removeNull(x).v, removeNull(y).v, lcid, flags)
    … …  
    286305    End Function
    287306
    288     Const Function Operator ==(y As Variant) As Boolean
     307    Function Operator ==(y As Variant) As Boolean
    289308        Dim c = Compare(This, y)
    290309        Return c = VARCMP_EQ
    291310    End Function
    292311
    293     Const Function Operator <>(y As Variant) As Boolean
     312    Function Operator <>(y As Variant) As Boolean
    294313        Dim c = Compare(This, y)
    295314        Return c <> VARCMP_EQ
    296315    End Function
    297316
    298     Const Function Operator <(y As Variant) As Boolean
     317    Function Operator <(y As Variant) As Boolean
    299318        Dim c = Compare(This, y)
    300319        Return c = VARCMP_LT
    301320    End Function
    302321
    303     Const Function Operator >(y As Variant) As Boolean
     322    Function Operator >(y As Variant) As Boolean
    304323        Dim c = Compare(This, y)
    305324        Return c = VARCMP_GT
    306325    End Function
    307326
    308     Const Function Operator <=(y As Variant) As Boolean
     327    Function Operator <=(y As Variant) As Boolean
    309328        Dim c = Compare(This, y)
    310329        Return c = VARCMP_LT Or c = VARCMP_EQ
    311330    End Function
    312331
    313     Const Function Operator >=(y As Variant) As Boolean
     332    Function Operator >=(y As Variant) As Boolean
    314333        Dim c = Compare(This, y)
    315334        Return c = VARCMP_GT Or c = VARCMP_EQ
    316335    End Function
    317336
    318     Const Function ChangeType(vt As VARTYPE, flags As Word) As Variant
     337    Function ChangeType(vt As VARTYPE, flags = 0 As Word) As Variant
    319338        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
     339        changeType(ChangeType.v, vt, flags)
     340    End Function
     341Private
     342    Sub changeType(ByRef ret As VARIANT, vt As VARTYPE, flags = 0 As Word)
     343        Windows.ThrowIfFailed(VariantChangeType(ret, v, flags, vt))
     344    End Sub
     345Public
     346
     347    Function VarType() As VARTYPE
    336348        Return v.vt
    337349    End Function
    338350
    339351    Override Function ToString() As String
    340         /*Using*/ Dim bs = ValStr
    341         ToString = bs.ToString
    342         bstr.Dispose() 'End Using
     352        Using bs = ValStr
     353            ToString = bs.ToString()
     354        End Using
    343355    End Function
    344356
    … …  
    348360    End Function
    349361
    350     Const Function ValUI1() As Byte
     362    Function ValUI1() As Byte
    351363        Dim r = ChangeType(VT_UI1)
    352364        Return GetByte(VarPtr(r.v.val))
    353365    End Function
    354366
    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
     367    Function ValUI2() As Word
    362368        Dim r = ChangeType(VT_UI2)
    363369        Return GetWord(VarPtr(r.v.val))
    364370    End Function
    365371
    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
     372    Function ValUI4() As DWord
    373373        Dim r = ChangeType(VT_UI4)
    374374        Return GetDWord(VarPtr(r.v.val))
    375375    End Function
    376376
    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
     377    Function ValUI8() As QWord
    384378        Dim r = ChangeType(VT_UI8)
    385379        Return GetQWord(VarPtr(r.v.val))
    386380    End Function
    387381
    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
     382    Function ValI1() As SByte
    395383        Dim r = ChangeType(VT_I1)
    396384        Return GetByte(VarPtr(r.v.val)) As SByte
    397385    End Function
    398386
    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
     387    Function ValI2() As Integer
    406388        Dim r = ChangeType(VT_I2)
    407389        Return GetWord(VarPtr(r.v.val)) As Integer
    408390    End Function
    409391
    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
     392    Function ValI4() As Long
    417393        Dim r = ChangeType(VT_I4)
    418394        Return GetDWord(VarPtr(r.v.val)) As Long
    419395    End Function
    420396
    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
     397    Function ValI8() As Int64
    428398        Dim r = ChangeType(VT_I8)
    429399        Return GetQWord(VarPtr(r.v.val)) As Int64
    430400    End Function
    431401
    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
     402    Function ValR4() As Single
    439403        Dim r = ChangeType(VT_R4)
    440404        Return GetSingle(VarPtr(r.v.val))
    441405    End Function
    442406
    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
     407    Function ValR8() As Double
    450408        Dim r = ChangeType(VT_UI8)
    451409        Return GetDouble(VarPtr(r.v.val))
    452410    End Function
    453411
    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
     412    Function ValBool() As VARIANT_BOOL
    461413        Dim r = ChangeType(VT_BOOL)
    462414        Return GetWord(VarPtr(r.v.val))
    463415    End Function
    464416
    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
     417    Function ValError() As SCODE
    472418        Dim r = ChangeType(VT_ERROR)
    473419        Return GetDWord(VarPtr(r.v.val))
    474420    End Function
    475421
    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
     422    Function ValCy() As Currency
    483423        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    
     424        ValCy = Currency.FromCy(GetQWord(VarPtr(r.v.val)))
     425    End Function
     426
    494427    'ValDate
    495428
    496     Const Function ValStr() As BString
     429    Function ValStr() As BString
    497430        ValStr = New BString
    498431        Dim r As VARIANT
    499         ChangeType(r, VARIANT_ALPHABOOL, VT_BSTR)
     432        changeType(r, VT_BSTR, VARIANT_ALPHABOOL)
    500433        ValStr.Attach(GetPointer(VarPtr(r.val)) As BSTR)
    501434    End Function
    502435
    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
     436    Function ValUnknown() As IUnknown
    514437        Dim r As VARIANT
    515         ChangeType(r, 0, VT_UNKNOWN)
     438        changeType(r, VT_UNKNOWN)
    516439        Return _System_PtrUnknown(r.val As ULONG_PTR As VoidPtr)
    517440    End Function
    518441
    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
     442    Function ValObject() As VBObject
    529443        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 */
     444        changeType(r, VT_DISPATCH)
     445        ValObject = VBObject.Attach(_System_PtrUnknown(r.val As ULONG_PTR As VoidPtr) As IDispatch)
     446    End Function
     447
    543448    'ValArray
    544449
    545     Const Function ValDecimal() As Decimal
    546         Dim p = VarPtr(v) As *Decimal
    547         Return New Deciaml(ByVal p)
     450    Function ValDecimal() As Decimal
     451        Dim p = VarPtr(v) As *DECIMAL
     452        Return New Decimal(ByVal p)
    548453    End Function
    549454
    … …  
    554459        v.vt = VT_DECIMAL '念の為
    555460    End Sub
    556    
    557461
    558462    Function PtrToVariant() As *VARIANT
    … …  
    562466    Static Function OptionalParam() As Variant
    563467        If IsNothing(optionalParam) Then
    564             Dim t = New Variant
    565             t.ValError = DISP_E_PARAMNOTFOUND
    566             InterlockedCompareExchangePointer(ByVal VarPtr(optionalParam), ObjPtr(t), 0)
     468            Using lock = New ActiveBasic.Windows.CriticalSectionLock(_System_CriticalSection)
     469                If IsNothing(optionalParam) Then
     470                    Dim t = New Variant
     471                    Dim p = t.PtrToVariant
     472                    p->vt = VT_ERROR
     473                    p->val = DISP_E_PARAMNOTFOUND
     474                    optionalParam = t
     475                End If
     476            End Using
    567477        End If
    568478        Return optionalParam
    … …  
    570480
    571481    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)
     482        If IsNothing(null) Then
     483            Using lock = New ActiveBasic.Windows.CriticalSectionLock(_System_CriticalSection)
     484                If IsNothing(null) Then
     485                    Dim t = New Variant
     486                    Dim p = t.PtrToVariant
     487                    p->vt = VT_NULL
     488                    null = t
     489                End If
     490            End Using
    577491        End If
    578         Return optionalParam
    579     End Function
     492        Return null
     493    End Function
     494
    580495Private
    581496    v As VARIANT
    … …  
    587502    Static Sub Move(ByRef dst As VARIANT, ByRef src As VARIANT)
    588503        dst = src
    589 '       src.vt = VT_EMPTY
    590     End Sub
    591 
    592     Static Function removeNull(v As Variant) As Varinat
     504        src.vt = VT_EMPTY
     505    End Sub
     506
     507    Static Function removeNull(v As Variant) As Variant
    593508        If IsNothing(v) Then
    594509            removeNull = Null
    … …  
    600515    Static optionalParam = Nothing As Variant
    601516    Static null = Nothing As Variant
     517
    602518End Class
    603519
    604 /*
     520
    605521Function Abs(v As Variant) As Variant
    606522    Return v.Abs()
    … …  
    618534    Return v.VarType()
    619535End Function
    620 */
     536
     537Namespace Detail
     538
     539Sub CopyFromVariant(ByRef x As Byte, v As Variant)
     540    x = v.ValUI1
     541End Sub
     542
     543Sub CopyFromVariant(ByRef x As Word, v As Variant)
     544    x = v.ValUI2
     545End Sub
     546
     547Sub CopyFromVariant(ByRef x As DWord, v As Variant)
     548    x = v.ValUI4
     549End Sub
     550
     551Sub CopyFromVariant(ByRef x As QWord, v As Variant)
     552    x = v.ValUI8
     553End Sub
     554
     555Sub CopyFromVariant(ByRef x As SByte, v As Variant)
     556    x = v.ValI1
     557End Sub
     558
     559Sub CopyFromVariant(ByRef x As Integer, v As Variant)
     560    x = v.ValI2
     561End Sub
     562
     563Sub CopyFromVariant(ByRef x As Long, v As Variant)
     564    x = v.ValI4
     565End Sub
     566
     567Sub CopyFromVariant(ByRef x As Int64, v As Variant)
     568    x = v.ValI8
     569End Sub
     570
     571Sub CopyFromVariant(ByRef x As Single, v As Variant)
     572    x = v.ValR4
     573End Sub
     574
     575Sub CopyFromVariant(ByRef x As Double, v As Variant)
     576    x = v.ValR8
     577End Sub
     578
     579Sub CopyFromVariant(ByRef x As Boolean, v As Variant)
     580    x = v.ValBool As Boolean
     581End Sub
     582
     583Sub CopyFromVariant(ByRef x As ActiveBasic.COM.Currency, v As Variant)
     584    x = v.ValCy
     585End Sub
     586
     587Sub CopyFromVariant(ByRef x As String, v As Variant)
     588    x = v.ValStr.ToString()
     589End Sub
     590
     591Sub CopyFromVariant(ByRef x As ActiveBasic.COM.VBObject, v As Variant)
     592    x = v.ValObject
     593End Sub
     594
     595Sub CopyFromVariant(ByRef x As ActiveBasic.COM.Decimal, v As Variant)
     596    x = v.ValDecimal
     597End Sub
     598
     599Sub CopyFromVariant(ByRef x As IUnknown, v As Variant)
     600    x = v.ValUnknown
     601End Sub
     602
     603Sub CopyFromVariant(ByRef x As Variant, v As Variant)
     604    x = v.Clone()
     605End Sub
     606
     607End Namespace
    621608
    622609End Namespace 'COM
Note: See TracChangeset for help on using the changeset viewer.