1  ' com/decimal.ab


2 


3  #require <oleauto.ab>


4  #require <com/variant.ab>


5  #require <com/currency.ab>


6 


7  Namespace ActiveBasic


8  Namespace COM


9 


10  Class Decimal


11  Public


12  Sub Decimal()


13  End Sub


14 


15  Sub Decimal(d As Decimal)


16  dec = d


17  End Sub


18 


19  Sub Decimal(lo As Long, mid As Long, hi As Long, isNegative As Boolean, scale As Byte)


20  If scale > 28 Then


21  Debug


22  Throw New ArgumentOutOfRangeException


23  End If


24  Dim sign As Byte


25  If isNegative Then


26  sign = DECIMAL_NEG


27  Else


28  sign = 0


29  End If


30  dec.signscale = MAKEWORD(sign, scale) 'ToDo:どっちが上位だか検証すること


31  dec.Hi32 = hi


32  dec.Lo64 = MAKEQWORD(mid, lo)


33  End Sub


34 


35  Sub Decimal(x As Long)


36  VarDecFromI4(x, dec)


37  End Sub


38 


39  Sub Decimal(x As DWord)


40  VarDecFromUI4(x, dec)


41  End Sub


42 


43  Sub Decimal(x As Int64)


44  VarDecFromI8(x, dec)


45  End Sub


46 


47  Sub Decimal(x As QWord)


48  VarDecFromUI8(x, dec)


49  End Sub


50 


51  Sub Decimal(x As Single)


52  VarDecFromR4(x, dec)


53  End Sub


54 


55  Sub Decimal(x As Double)


56  VarDecFromR8(x, dec)


57  End Sub


58 


59  Const Function Operator() As Variant


60  Return New Variant(This)


61  End Function


62  /*


63  Static Function Operator(x As SByte) As Decimal


64  Dim d = New Decimal


65  VarDecFromI1(x, d.dec)


66  Return d


67  End Function


68 


69  Static Function Operator(x As Byte) As Decimal


70  Dim d = New Decimal


71  VarDecFromUI1(x, d.dec)


72  Return d


73  End Function


74 


75  Static Function Operator(x As Integer) As Decimal


76  Dim d = New Decimal


77  VarDecFromI2(x, d.dec)


78  Return d


79  End Function


80 


81  Static Function Operator(x As Word) As Decimal


82  Dim d = New Decimal


83  VarDecFromUI2(x, d.dec)


84  Return d


85  End Function


86 


87  Static Function Operator(x As Long) As Decimal


88  Dim d = New Decimal


89  VarDecFromI4(x, d.dec)


90  Return d


91  End Function


92 


93  Static Function Operator(x As DWord) As Decimal


94  Dim d = New Decimal


95  VarDecFromUI4(x, d.dec)


96  Return d


97  End Function


98 


99  Static Function Operator(x As Int64) As Decimal


100  Dim d = New Decimal


101  VarDecFromI8(x, d.dec)


102  Return d


103  End Function


104 


105  Static Function Operator(x As QWord) As Decimal


106  Dim d = New Decimal


107  VarDecFromUI8(x, d.dec)


108  Return d


109  End Function


110 


111  Static Function Operator(x As DECIMAL) As Decimal


112  Return New Decimal(X)


113  End Function


114 


115  Const Function Operator As() As SByte


116  Dim x As SByte


117  VarI1FromDec(dec, x)


118  Return x


119  End Function


120 


121  Const Function Operator As() As Byte


122  Dim x As Byte


123  VarUI1FromDec(dec, x)


124  Return x


125  End Function


126 


127  Const Function Operator As() As Integer


128  Dim x As Integer


129  VarI2FromDec(dec, x)


130  Return x


131  End Function


132 


133  Const Function Operator As() As Word


134  Dim x As Word


135  VarUI2FromDec(dec, x)


136  Return x


137  End Function


138 


139  Const Function Operator As() As Long


140  Dim x As Long


141  VarI4FromDec(dec, x)


142  Return x


143  End Function


144 


145  Const Function Operator As() As DWord


146  Dim x As DWord


147  VarUI4FromDec(dec, x)


148  Return x


149  End Function


150 


151  Const Function Operator As() As Int64


152  Dim x As Int64


153  VarI8FromDec(dec, x)


154  Return x


155  End Function


156 


157  Const Function Operator As() As QWord


158  Dim x As QWord


159  VarUI8FromDec(dec, x)


160  Return x


161  End Function


162 


163  Const Function Operator As() As Single


164  Dim x As Single


165  VarR4FromDec(dec, x)


166  Return x


167  End Function


168 


169  Const Function Operator As() As Double


170  Dim x As Double


171  VarR8FromDec(dec, x)


172  Return x


173  End Function


174 


175  Const Function Operator As() As Currency


176  Dim x As Currency


177  VarCyFromDec(dec, x)


178  Return x


179  End Function


180 


181  Const Function Operator As() As DECIMAL


182  Return dec


183  End Function


184 


185  Static Function Operator As(x As Single) As Decimal


186  Dim d = New Decimal


187  VarDecFromR4(x, d.dec)


188  Return d


189  End Function


190 


191  Static Function Operator As(x As Double) As Decimal


192  Dim d = New Decimal


193  VarDecFromR8(x, d.dec)


194  Return d


195  End Function


196  */


197  Const Function Operator +() As Decimal


198  Return New Decimal(dec)


199  End Function


200 


201  Const Function Operator () As Decimal


202  Dim ret = New Decimal


203  VarDecNeg(This.dec, ret.dec)


204  Return ret


205  End Function


206 


207  Const Function Operator *(y As Decimal) As Decimal


208  Dim ret = New Decimal


209  VarDecMul(This.dec, y.dec, ret.dec)


210  Return ret


211  End Function


212 


213  Const Function Operator *(y As Long) As Decimal


214  Dim ret = New Decimal


215  VarDecMulI4(This.dec, y, ret.dec)


216  Return ret


217  End Function


218 


219  Const Function Operator *(y As Int64) As Decimal


220  Dim ret = New Decimal


221  VarDecMulI8(This.dec, y, ret.dec)


222  Return ret


223  End Function


224 


225  Const Function Operator /(y As Decimal) As Decimal


226  Dim ret = New Decimal


227  VarDecDiv(This.dec, y.dec, ret.dec)


228  Return ret


229  End Function


230 


231  Const Function Operator +(y As Decimal) As Decimal


232  Dim ret = New Decimal


233  VarDecAdd(This.dec, y.dec, ret.dec)


234  Return ret


235  End Function


236 


237  Const Function Operator (y As Decimal) As Decimal


238  Dim ret = New Decimal


239  VarDecSub(This.dec, y.dec, ret.dec)


240  Return ret


241  End Function


242 


243  Static Function Compare(x As Decimal, y As Decimal) As HRESULT


244  Return VarDecCmp(x, y)


245  End Function


246 


247  Static Function Compare(x As Decimal, y As Double) As HRESULT


248  Return VarDecCmpR8(x, y)


249  End Function


250 


251  Static Function Compare(x As Double, y As Decimal) As HRESULT


252  Dim ret = VarDecCmpR8(y, x)


253  Select Case ret


254  Case VARCMP_LT


255  Return VARCMP_GT


256  Case VARCMP_GT


257  Return VARCMP_LT


258  Case Else


259  Return ret


260  End Select


261  End Function


262 


263  Const Function Operator ==(y As Decimal) As Boolean


264  Dim c = Compare(This, y)


265  Return c = VARCMP_EQ


266  End Function


267 


268  Const Function Operator ==(y As Double) As Boolean


269  Dim c = Compare(This, y)


270  Return c = VARCMP_EQ


271  End Function


272 


273  Const Function Operator <>(y As Decimal) As Boolean


274  Dim c = Compare(This, y)


275  Return c <> VARCMP_EQ


276  End Function


277 


278  Const Function Operator <>(y As Double) As Boolean


279  Dim c = Compare(This, y)


280  Return c <> VARCMP_EQ


281  End Function


282 


283  Const Function Operator <(y As Decimal) As Boolean


284  Dim c = Compare(This, y)


285  Return c = VARCMP_LT


286  End Function


287 


288  Const Function Operator <(y As Double) As Boolean


289  Dim c = Compare(This, y)


290  Return c = VARCMP_LT


291  End Function


292  /*


293  Const Function Operator >(y As Decimal) As Boolean


294  Dim c = Compare(This, y)


295  Return c = VARCMP_GT


296  End Function


297 


298  Const Function Operator >(y As Double) As Boolean


299  Dim c = Compare(This, y)


300  Return c = VARCMP_GT


301  End Function


302  */


303  Const Function Operator <=(y As Decimal) As Boolean


304  Dim c = Compare(This, y)


305  Return result = VARCMP_LT Or result = VARCMP_EQ


306  End Function


307 


308  Const Function Operator <=(y As Double) As Boolean


309  Dim c = Compare(This, y)


310  Return result = VARCMP_LT Or result = VARCMP_EQ


311  End Function


312 


313  Const Function Operator >=(y As Decimal) As Boolean


314  Dim c = Compare(This, y)


315  Return result = VARCMP_GT Or result = VARCMP_EQ


316  End Function


317 


318  Const Function Operator >=(y As Double) As Boolean


319  Dim c = Compare(This, y)


320  Return result = VARCMP_GT Or result = VARCMP_EQ


321  End Function


322 


323  Const Function Abs() As Decimal


324  Abs = New Decimal


325  VarDecAbs(This.dec, Abs.dec)


326  End Function


327 


328  Const Function Fix() As Decimal


329  Fix = New Decimal


330  VarDecFix(This.dec, Fix.dec)


331  End Function


332 


333  Const Function Int() As Decimal


334  Int = New Decimal


335  VarDecInt(This.dec, Int.dec)


336  End Function


337 


338  Const Function Round(c = 0 As Long) As Decimal


339  Round = New Decimal


340  VarDecRound(This.dec, c, Round.dec)


341  End Function


342 


343  Const Function Dec() As DECIMAL


344  Return dec


345  End Function


346 


347  Sub Dec(ByRef d As DECIMAL)


348  dec = d


349  End Sub


350 


351  Const Function ToVariant() As Variant


352  Return New Variant(dec)


353  End Function


354 


355  Override Function ToString() As String


356  Dim bs As BSTR


357  VarBstrFromDec(dec, LOCALE_USER_DEFAULT, LOCALE_USE_NLS, bs)


358  ToString = New String(bs As PCWSTR, SysStringLen(bs) As Long)


359  SysFreeString(bs)


360  End Function


361 


362  Override Function GetHashCode() As Long


363  Dim p = VarPtr(dec) As *DWord


364  Return (p[0] Xor p[1] Xor p[2] Xor p[3]) As Long


365  End Function


366 


367  Function Equals(y As Decimal) As Boolean


368  Dim c = Compare(This, y)


369  Return c = VARCMP_EQ


370  End Function


371  Private


372  dec As DECIMAL


373  End Class


374 


375  End Namespace 'COM


376  End Namespace 'ActiveBasic

