source: trunk/Include/com/currency.ab@ 335

' com/currency.ab

#require <com/variant.ab>

#ifndef _COM_CURRENCY_AB
#define _COM_CURRENCY_AB

Namespace ActiveBasic
Namespace COM

Class Currency
Public
    Sub Currency()
        cy = 0
    End Sub

/*
    Sub Currency(x As CY)
        cy = x
    End Sub
*/
    Sub Currency(x As Double)
        VarCyFromR8(x, cy)
    End Sub
/*
    Sub Currency(x As Int64)
        VarCyFromI8(x, cy)
    End Sub
*/
/*
    Const Function Operator +() As Currency
        Return New Currency(This)
    End Function
*/
    Const Function Operator -() As Currency
        Dim ret = New Currency
        VarCyNeg(This.cy, ret.cy)
        Return ret
    End Function

    Const Function Operator *(y As Currency) As Currency
        Dim ret = New Currency
        VarCyMul(This.cy, y.cy, ret.cy)
        Return ret
    End Function

    Const Function Operator *(y As Long) As Currency
        Dim ret = New Currency
        VarCyMulI4(This.cy, y, ret.cy)
        Return ret
    End Function

    Const Function Operator *(y As Int64) As Currency
        Dim ret = New Currency
        VarCyMulI8(This.cy, y, ret.cy)
        Return ret
    End Function

    Const Function Operator /(y As Variant) As Double
        Dim vx = New Variant(This)
        Dim ret = vx / y
        Return ret.ValR4
    End Function

    Const Function Operator /(y As Currency) As Double
        Dim vx = New Variant(This)
        Dim vy = New Variant(y)
        Dim ret = vx / vy
        Return ret.ValR4
    End Function

    Const Function Operator +(y As Currency) As Currency
        Dim ret = New Currency
        VarCyAdd(This.cy, y.cy, ret.cy)
        Return ret
    End Function

    Const Function Operator -(y As Currency) As Currency
        Dim ret = New Currency
        VarCySub(This.cy, y.cy, ret.cy)
        Return ret
    End Function

    Static Function Compare(x As Currency, y As Currency) As HRESULT
        Return VarCyCmp(x.cy, y.cy)
    End Function

    Static Function Compare(x As Currency, y As Double) As HRESULT
        Return VarCyCmpR8(x.cy, y)
    End Function

    Static Function Compare(x As Double, y As Currency) As HRESULT
        Dim ret = VarCyCmpR8(y.cy, 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 Currency) 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 Currency) 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 Currency) 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 Currency) 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 Currency) 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 Currency) 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 Currency
        Abs = New Currency
        VarCyAbs(This.cy, Abs.cy)
    End Function

    Const Function Fix() As Currency
        Fix = New Currency
        VarCyFix(This.cy, Fix.cy)
    End Function

    Const Function Int() As Currency
        Int = New Currency
        VarCyInt(This.cy, Int.cy)
    End Function

    Const Function Round(c = 0 As Long) As Currency
        Round = New Currency
        VarCyRound(This.cy, c, Round.cy)
    End Function

    Const Function Cy() As CY
        Return cy
    End Function

    Sub Cy(c As CY)
        cy = c
    End Sub

    Const Function ToDouble() As Double
        VarR8FromCy(cy, ToDouble)
    End Function

    Const Function ToInt64() As Int64
        VarI8FromCy(cy, ToInt64)
    End Function

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

    Override Function ToString() As String
        Dim bs As BSTR
        VarBstrFromCy(cy, LOCALE_USER_DEFAULT, LOCALE_USE_NLS, bs)
        ToString = New String(bs As PCWSTR, SysStringLen(bs) As Long)
        SysFreeString(bs)
    End Function

    Override Function GetHashCode() As Long
        Return HIDWORD(cy) Xor LODWORD(cy)
    End Function

    Function Equals(y As Currency) As Boolean
        Dim c = Compare(This, y)
        Return c = VARCMP_EQ
    End Function
Private
    cy As CY
End Class

End Namespace 'COM
End Namespace 'ActiveBasic

#endif '_COM_CURRENCY_AB