' 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