source: trunk/ab5.0/ablib/src/com/decimal.ab

' com/decimal.ab

#require <com/variant.ab>
#require <com/currency.ab>

Namespace ActiveBasic
Namespace COM

Class Decimal
    Implements System.ICloneable, System.IEquatable<Decimal>', System.IComparable<Decimal>
Public

    Sub Decimal()
    End Sub

    Sub Decimal(d As Decimal)
        dec = d.dec
    End Sub

    Sub Decimal(ByRef d As DECIMAL)
        dec = d
    End Sub

    Sub Decimal(lo As Long, mid As Long, hi As Long, isNegative As Boolean, scale As Byte)
        If scale > 28 Then
            Throw New System.ArgumentOutOfRangeException("scale - Decimal constructor")
        End If
        Dim sign As Byte
        If isNegative Then
            sign = DECIMAL_NEG
        Else
            sign = 0
        End If
        dec.signscale = MAKEWORD(sign, scale) 'ToDo:どっちが上位だか検証すること
        dec.Hi32 = hi
        dec.Lo64 = MAKEQWORD(mid, lo)
    End Sub

    Sub Decimal(x As Long)
        Windows.ThrowIfFailed(VarDecFromI4(x, dec))
    End Sub

    Sub Decimal(x As DWord)
        Windows.ThrowIfFailed(VarDecFromUI4(x, dec))
    End Sub

    Sub Decimal(x As Int64)
        Windows.ThrowIfFailed(VarDecFromI8(x, dec))
    End Sub

    Sub Decimal(x As QWord)
        Windows.ThrowIfFailed(VarDecFromUI8(x, dec))
    End Sub

    Sub Decimal(x As Single)
        Windows.ThrowIfFailed(VarDecFromR4(x, dec))
    End Sub

    Sub Decimal(x As Double)
        Windows.ThrowIfFailed(VarDecFromR8(x, dec))
    End Sub

    Const Function Operator() As Variant
        Return New Variant(This)
    End Function
/*
    Static Function Operator(x As SByte) As Decimal
        Dim d = New Decimal
        VarDecFromI1(x, d.dec)
        Return d
    End Function

    Static Function Operator(x As Byte) As Decimal
        Dim d = New Decimal
        VarDecFromUI1(x, d.dec)
        Return d
    End Function

    Static Function Operator(x As Integer) As Decimal
        Dim d = New Decimal
        VarDecFromI2(x, d.dec)
        Return d
    End Function

    Static Function Operator(x As Word) As Decimal
        Dim d = New Decimal
        VarDecFromUI2(x, d.dec)
        Return d
    End Function

    Static Function Operator(x As Long) As Decimal
        Dim d = New Decimal
        VarDecFromI4(x, d.dec)
        Return d
    End Function

    Static Function Operator(x As DWord) As Decimal
        Dim d = New Decimal
        VarDecFromUI4(x, d.dec)
        Return d
    End Function

    Static Function Operator(x As Int64) As Decimal
        Dim d = New Decimal
        VarDecFromI8(x, d.dec)
        Return d
    End Function

    Static Function Operator(x As QWord) As Decimal
        Dim d = New Decimal
        VarDecFromUI8(x, d.dec)
        Return d
    End Function

    Static Function Operator(x As DECIMAL) As Decimal
        Return New Decimal(X)
    End Function

    Const Function Operator As() As SByte
        Dim x As SByte
        VarI1FromDec(dec, x)
        Return x
    End Function

    Const Function Operator As() As Byte
        Dim x As Byte
        VarUI1FromDec(dec, x)
        Return x
    End Function

    Const Function Operator As() As Integer
        Dim x As Integer
        VarI2FromDec(dec, x)
        Return x
    End Function

    Const Function Operator As() As Word
        Dim x As Word
        VarUI2FromDec(dec, x)
        Return x
    End Function

    Const Function Operator As() As Long
        Dim x As Long
        VarI4FromDec(dec, x)
        Return x
    End Function

    Const Function Operator As() As DWord
        Dim x As DWord
        VarUI4FromDec(dec, x)
        Return x
    End Function

    Const Function Operator As() As Int64
        Dim x As Int64
        VarI8FromDec(dec, x)
        Return x
    End Function

    Const Function Operator As() As QWord
        Dim x As QWord
        VarUI8FromDec(dec, x)
        Return x
    End Function

    Const Function Operator As() As Single
        Dim x As Single
        VarR4FromDec(dec, x)
        Return x
    End Function

    Const Function Operator As() As Double
        Dim x As Double
        VarR8FromDec(dec, x)
        Return x
    End Function

    Const Function Operator As() As Currency
        Dim x As Currency
        VarCyFromDec(dec, x)
        Return x
    End Function

    Const Function Operator As() As DECIMAL
        Return dec
    End Function

    Static Function Operator As(x As Single) As Decimal
        Dim d = New Decimal
        VarDecFromR4(x, d.dec)
        Return d
    End Function

    Static Function Operator As(x As Double) As Decimal
        Dim d = New Decimal
        VarDecFromR8(x, d.dec)
        Return d
    End Function
*/

    Const Function Operator +() As Decimal
        Return New Decimal(dec)
    End Function

    Const Function Operator -() As Decimal
        Dim ret = New Decimal
        Windows.ThrowIfFailed(VarDecNeg(This.dec, ret.dec))
        Return ret
    End Function

    Const Function Operator *(y As Decimal) As Decimal
        Dim ret = New Decimal
        Windows.ThrowIfFailed(VarDecMul(This.dec, y.dec, ret.dec))
        Return ret
    End Function

    Const Function Operator /(y As Decimal) As Decimal
        Dim ret = New Decimal
        Windows.ThrowIfFailed(VarDecDiv(This.dec, y.dec, ret.dec))
        Return ret
    End Function

    Const Function Operator +(y As Decimal) As Decimal
        Dim ret = New Decimal
        Windows.ThrowIfFailed(VarDecAdd(This.dec, y.dec, ret.dec))
        Return ret
    End Function

    Const Function Operator -(y As Decimal) As Decimal
        Dim ret = New Decimal
        Windows.ThrowIfFailed(VarDecSub(This.dec, y.dec, ret.dec))
        Return ret
    End Function

    ' ThrowIfFailedしていないことに注意
    Static Function Compare(x As Decimal, y As Decimal) As HRESULT
        Compare = VarDecCmp(x.dec, y.dec)
    End Function

    ' ThrowIfFailedしていないことに注意
    Static Function Compare(x As Decimal, y As Double) As HRESULT
        Return VarDecCmpR8(x.dec, y)
    End Function

    Static Function Compare(x As Double, y As Decimal) As HRESULT
        Dim ret = VarDecCmpR8(y.dec, x)
        Select Case ret
            Case VARCMP_LT
                Return VARCMP_GT
            Case VARCMP_GT
                Return VARCMP_LT
            Case Else
                Return ret
        End Select
    End Function

    Const Function Operator ==(y As Decimal) As Boolean
        Dim c = Compare(This, y)
        Return c = VARCMP_EQ
    End Function

    Const Function Operator ==(y As Double) As Boolean
        Dim c = Compare(This, y)
        Return c = VARCMP_EQ
    End Function

    Const Function Operator <>(y As Decimal) As Boolean
        Dim c = Compare(This, y)
        Return c <> VARCMP_EQ
    End Function

    Const Function Operator <>(y As Double) As Boolean
        Dim c = Compare(This, y)
        Return c <> VARCMP_EQ
    End Function

    Const Function Operator <(y As Decimal) As Boolean
        Dim c = Compare(This, y)
        Return c = VARCMP_LT
    End Function

    Const Function Operator <(y As Double) As Boolean
        Dim c = Compare(This, y)
        Return c = VARCMP_LT
    End Function

    Const Function Operator >(y As Decimal) As Boolean
        Dim c = Compare(This, y)
        Return c = VARCMP_GT
    End Function

    Const Function Operator >(y As Double) As Boolean
        Dim c = Compare(This, y)
        Return c = VARCMP_GT
    End Function

    Const Function Operator <=(y As Decimal) As Boolean
        Dim c = Compare(This, y)
        Return c = VARCMP_LT Or c = VARCMP_EQ
    End Function

    Const Function Operator <=(y As Double) As Boolean
        Dim c = Compare(This, y)
        Return c = VARCMP_LT Or c = VARCMP_EQ
    End Function

    Const Function Operator >=(y As Decimal) As Boolean
        Dim c = Compare(This, y)
        Return c = VARCMP_GT Or c = VARCMP_EQ
    End Function

    Const Function Operator >=(y As Double) As Boolean
        Dim c = Compare(This, y)
        Return c = VARCMP_GT Or c = VARCMP_EQ
    End Function

    Const Function Abs() As Decimal
        Abs = New Decimal
        Windows.ThrowIfFailed(VarDecAbs(This.dec, Abs.dec))
    End Function

    Const Function Fix() As Decimal
        Fix = New Decimal
        Windows.ThrowIfFailed(VarDecFix(This.dec, Fix.dec))
    End Function

    Const Function Int() As Decimal
        Int = New Decimal
        Windows.ThrowIfFailed(VarDecInt(This.dec, Int.dec))
    End Function

    Const Function Round(c = 0 As Long) As Decimal
        Round = New Decimal
        Windows.ThrowIfFailed(VarDecRound(This.dec, c, Round.dec))
    End Function

    Const Function Dec() As DECIMAL
        Return dec
    End Function

    Const Function ToVariant() As Variant
        Return New Variant(This)
    End Function

    Function ToBString() As BString
        ToBString = New BString
        Dim bs As BSTR
        VarBstrFromDec(dec, LOCALE_USER_DEFAULT, LOCALE_USE_NLS, bs)
        ToBString.Attach(bs)
    End Function

    Override Function ToString() As String
        Using bstr = ToBString()
            ToString = bstr.ToString
        End Using
    End Function

    Override Function GetHashCode() As Long
        Dim p = VarPtr(dec) As *DWord
        Return (p[0] Xor p[1] Xor p[2] Xor p[3]) As Long
    End Function

    Function Equals(y As Decimal) As Boolean
        Dim c = Compare(This, y)
        Return c = VARCMP_EQ
    End Function

    Override Function Equals(y As Object) As Boolean
        If This.GetType().Equals(y.GetType()) Then
            Equals = Equals(y As Decimal)
        End If
    End Function

    Function Clone() As Decimal
        Clone = New Decimal(This)
    End Function

Private
    dec As DECIMAL
End Class

End Namespace 'COM
End Namespace 'ActiveBasic