' com/currency.ab #require #ifndef _COM_CURRENCY_AB #define _COM_CURRENCY_AB Class Currency Public /* 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 Return This / New Varinat(y) 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, y) End Function Static Function Compare(x As Currency, y As Double) As HRESULT Return VarCyCmpR8(x, y) End Function Static Function Compare(x As Double, y As Currency) As HRESULT Dim ret = VarCyCmpR8(y, 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 result = VARCMP_LT Or result = VARCMP_EQ End Function Const Function Operator <=(y As Double) As Boolean Dim c = Compare(This, y) Return result = VARCMP_LT Or result = VARCMP_EQ End Function Const Function Operator >=(y As Currency) As Boolean Dim c = Compare(This, y) Return result = VARCMP_GT Or result = VARCMP_EQ End Function Const Function Operator >=(y As Double) As Boolean Dim c = Compare(This, y) Return result = VARCMP_GT Or result = 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 Private cy As CY End Class #endif '_COM_CURRENCY_AB