source: trunk/ab5.0/ablib/src/com/currency.ab@ 709

' com/currency.ab

#require <com/variant.ab>

Namespace ActiveBasic
Namespace COM

Class Currency
    Implements System.ICloneable, System.IEquatable<Currency>', System.IComparable<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
*/
    Static Function FromCy(cy As CY) As Currency
        FromCy = New Currency
        FromCy.cy = cy
    End Function

    Function Operator +() As Currency
        Return FromCy(cy)
    End Function

    Function Operator -() As Currency
        Dim ret = New Currency
        Windows.ThrowIfFailed(VarCyNeg(This.cy, ret.cy))
        Return ret
    End Function

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

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

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

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

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

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

    Function Operator -(y As Currency) As Currency
        Dim ret = New Currency
        Windows.ThrowIfFailed(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

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

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

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

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

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

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

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

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

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

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

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

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

    Function Abs() As Currency
        Abs = New Currency
        Windows.ThrowIfFailed(VarCyAbs(This.cy, Abs.cy))
    End Function

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

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

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

    Function Cy() As CY
        Cy = cy
    End Function

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

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

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

    Override Function ToString() As String
        Using bstr = New BString
            Dim bs As BSTR
            VarBstrFromCy(cy, LOCALE_USER_DEFAULT, LOCALE_USE_NLS, bs)
            bstr.Attach(bs)
            ToString = bstr.ToString()
        End Using
    End Function

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

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

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

    Function CompareTo(y As Currency) As Long
        Dim c = Compare(This, y)
        If c = VARCMP_GT Then
            CompareTo = 1
        ElseIf c = VARCMP_LT Then
            CompareTo = -1
        Else
            CompareTo = 0
        End If
    End Function

    Function Clone() As Currency
        Clone = This
    End Function
Private
    cy As CY
End Class

End Namespace 'COM
End Namespace 'ActiveBasic