' com/currency.ab #require 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.ValR8 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.ValR8 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 Cy = 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 /*Using*/ Dim bstr = New BString Dim bs As BSTR VarBstrFromCy(cy, LOCALE_USER_DEFAULT, LOCALE_USE_NLS, bs) bstr.Attach(bs) ToString = bstr.ToString bstr.Dispose() 'End Using 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