1  ' com/currency.ab


2 


3  #require <com/variant.ab>


4 


5  #ifndef _COM_CURRENCY_AB


6  #define _COM_CURRENCY_AB


7 


8  Namespace ActiveBasic


9  Namespace COM


10 


11  Class Currency


12  Public


13  Sub Currency()


14  cy = 0


15  End Sub


16 


17  /*


18  Sub Currency(x As CY)


19  cy = x


20  End Sub


21  */


22  Sub Currency(x As Double)


23  VarCyFromR8(x, cy)


24  End Sub


25  /*


26  Sub Currency(x As Int64)


27  VarCyFromI8(x, cy)


28  End Sub


29  */


30  /*


31  Const Function Operator +() As Currency


32  Return New Currency(This)


33  End Function


34  */


35  Const Function Operator () As Currency


36  Dim ret = New Currency


37  VarCyNeg(This.cy, ret.cy)


38  Return ret


39  End Function


40 


41  Const Function Operator *(y As Currency) As Currency


42  Dim ret = New Currency


43  VarCyMul(This.cy, y.cy, ret.cy)


44  Return ret


45  End Function


46 


47  Const Function Operator *(y As Long) As Currency


48  Dim ret = New Currency


49  VarCyMulI4(This.cy, y, ret.cy)


50  Return ret


51  End Function


52 


53  Const Function Operator *(y As Int64) As Currency


54  Dim ret = New Currency


55  VarCyMulI8(This.cy, y, ret.cy)


56  Return ret


57  End Function


58 


59  Const Function Operator /(y As Variant) As Double


60  Dim vx = New Variant(This)


61  Dim ret = vx / y


62  Return ret.ValR4


63  End Function


64 


65  Const Function Operator /(y As Currency) As Double


66  Dim vx = New Variant(This)


67  Dim vy = New Variant(y)


68  Dim ret = vx / vy


69  Return ret.ValR4


70  End Function


71 


72  Const Function Operator +(y As Currency) As Currency


73  Dim ret = New Currency


74  VarCyAdd(This.cy, y.cy, ret.cy)


75  Return ret


76  End Function


77 


78  Const Function Operator (y As Currency) As Currency


79  Dim ret = New Currency


80  VarCySub(This.cy, y.cy, ret.cy)


81  Return ret


82  End Function


83 


84  Static Function Compare(x As Currency, y As Currency) As HRESULT


85  Return VarCyCmp(x.cy, y.cy)


86  End Function


87 


88  Static Function Compare(x As Currency, y As Double) As HRESULT


89  Return VarCyCmpR8(x.cy, y)


90  End Function


91 


92  Static Function Compare(x As Double, y As Currency) As HRESULT


93  Dim ret = VarCyCmpR8(y.cy, x)


94  Select Case ret


95  Case VARCMP_LT


96  Return VARCMP_GT


97  Case VARCMP_GT


98  Return VARCMP_LT


99  Case Else


100  Return ret


101  End Select


102  End Function


103 


104  Const Function Operator ==(y As Currency) As Boolean


105  Dim c = Compare(This, y)


106  Return c = VARCMP_EQ


107  End Function


108 


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


110  Dim c = Compare(This, y)


111  Return c = VARCMP_EQ


112  End Function


113 


114  Const Function Operator <>(y As Currency) As Boolean


115  Dim c = Compare(This, y)


116  Return c <> VARCMP_EQ


117  End Function


118 


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


120  Dim c = Compare(This, y)


121  Return c <> VARCMP_EQ


122  End Function


123 


124  Const Function Operator <(y As Currency) As Boolean


125  Dim c = Compare(This, y)


126  Return c = VARCMP_LT


127  End Function


128 


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


130  Dim c = Compare(This, y)


131  Return c = VARCMP_LT


132  End Function


133  /*


134  Const Function Operator >(y As Currency) As Boolean


135  Dim c = Compare(This, y)


136  Return c = VARCMP_GT


137  End Function


138 


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


140  Dim c = Compare(This, y)


141  Return c = VARCMP_GT


142  End Function


143  */


144  Const Function Operator <=(y As Currency) As Boolean


145  Dim c = Compare(This, y)


146  Return c = VARCMP_LT Or c = VARCMP_EQ


147  End Function


148 


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


150  Dim c = Compare(This, y)


151  Return c = VARCMP_LT Or c = VARCMP_EQ


152  End Function


153 


154  Const Function Operator >=(y As Currency) As Boolean


155  Dim c = Compare(This, y)


156  Return c = VARCMP_GT Or c = VARCMP_EQ


157  End Function


158 


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


160  Dim c = Compare(This, y)


161  Return c = VARCMP_GT Or c = VARCMP_EQ


162  End Function


163 


164  Const Function Abs() As Currency


165  Abs = New Currency


166  VarCyAbs(This.cy, Abs.cy)


167  End Function


168 


169  Const Function Fix() As Currency


170  Fix = New Currency


171  VarCyFix(This.cy, Fix.cy)


172  End Function


173 


174  Const Function Int() As Currency


175  Int = New Currency


176  VarCyInt(This.cy, Int.cy)


177  End Function


178 


179  Const Function Round(c = 0 As Long) As Currency


180  Round = New Currency


181  VarCyRound(This.cy, c, Round.cy)


182  End Function


183 


184  Const Function Cy() As CY


185  Return cy


186  End Function


187 


188  Sub Cy(c As CY)


189  cy = c


190  End Sub


191 


192  Const Function ToDouble() As Double


193  VarR8FromCy(cy, ToDouble)


194  End Function


195 


196  Const Function ToInt64() As Int64


197  VarI8FromCy(cy, ToInt64)


198  End Function


199 


200  Const Function ToVariant() As Variant


201  Return New Variant(This)


202  End Function


203 


204  Override Function ToString() As String


205  Dim bs As BSTR


206  VarBstrFromCy(cy, LOCALE_USER_DEFAULT, LOCALE_USE_NLS, bs)


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


208  SysFreeString(bs)


209  End Function


210 


211  Override Function GetHashCode() As Long


212  Return HIDWORD(cy) Xor LODWORD(cy)


213  End Function


214 


215  Function Equals(y As Currency) As Boolean


216  Dim c = Compare(This, y)


217  Return c = VARCMP_EQ


218  End Function


219  Private


220  cy As CY


221  End Class


222 


223  End Namespace 'COM


224  End Namespace 'ActiveBasic


225 


226  #endif '_COM_CURRENCY_AB

