' com/decimal.ab #require #require Namespace ActiveBasic Namespace COM Class 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 ArgumentOutOfRangeException("scale") 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) VarDecFromI4(x, dec) End Sub Sub Decimal(x As DWord) VarDecFromUI4(x, dec) End Sub Sub Decimal(x As Int64) VarDecFromI8(x, dec) End Sub Sub Decimal(x As QWord) VarDecFromUI8(x, dec) End Sub Sub Decimal(x As Single) VarDecFromR4(x, dec) End Sub Sub Decimal(x As Double) 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 VarDecNeg(This.dec, ret.dec) Return ret End Function Const Function Operator *(y As Decimal) As Decimal Dim ret = New Decimal VarDecMul(This.dec, y.dec, ret.dec) Return ret End Function Const Function Operator /(y As Decimal) As Decimal Dim ret = New Decimal VarDecDiv(This.dec, y.dec, ret.dec) Return ret End Function Const Function Operator +(y As Decimal) As Decimal Dim ret = New Decimal VarDecAdd(This.dec, y.dec, ret.dec) Return ret End Function Const Function Operator -(y As Decimal) As Decimal Dim ret = New Decimal VarDecSub(This.dec, y.dec, ret.dec) Return ret End Function Static Function Compare(x As Decimal, y As Decimal) As HRESULT Return VarDecCmp(x.dec, y.dec) End Function 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 VarDecAbs(This.dec, Abs.dec) End Function Const Function Fix() As Decimal Fix = New Decimal VarDecFix(This.dec, Fix.dec) End Function Const Function Int() As Decimal Int = New Decimal VarDecInt(This.dec, Int.dec) End Function Const Function Round(c = 0 As Long) As Decimal Round = New Decimal VarDecRound(This.dec, c, Round.dec) End Function Const Function Dec() As DECIMAL Return dec End Function Sub Dec(ByRef d As DECIMAL) dec = d End Sub 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 VarBstrFromDec(dec, LOCALE_USER_DEFAULT, LOCALE_USE_NLS, bs) bstr.Attach(bs) ToString = bstr.ToString bstr.Dispose() '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 Private dec As DECIMAL End Class End Namespace 'COM End Namespace 'ActiveBasic