source: trunk/Include/com/decimal.ab @ 478

Last change on this file since 478 was 478, checked in by イグトランス (egtra), 15 years ago

現在向けに修正（参照型のポインタの排除など）
File size: 7.7 KB
Line 
1' com/decimal.ab
2
3#require <com/variant.ab>
4#require <com/currency.ab>
5
6Namespace ActiveBasic
7Namespace COM
8
9Class Decimal
10Public
11    Sub Decimal()
12    End Sub
13
14    Sub Decimal(d As Decimal)
15        dec = d.dec
16    End Sub
17
18    Sub Decimal(ByRef d As DECIMAL)
19        dec = d
20    End Sub
21
22    Sub Decimal(lo As Long, mid As Long, hi As Long, isNegative As Boolean, scale As Byte)
23        If scale > 28 Then
24            Throw New ArgumentOutOfRangeException("scale")
25        End If
26        Dim sign As Byte
27        If isNegative Then
28            sign = DECIMAL_NEG
29        Else
30            sign = 0
31        End If
32        dec.signscale = MAKEWORD(sign, scale) 'ToDo:どっちが上位だか検証すること
33        dec.Hi32 = hi
34        dec.Lo64 = MAKEQWORD(mid, lo)
35    End Sub
36
37    Sub Decimal(x As Long)
38        VarDecFromI4(x, dec)
39    End Sub
40
41    Sub Decimal(x As DWord)
42        VarDecFromUI4(x, dec)
43    End Sub
44
45    Sub Decimal(x As Int64)
46        VarDecFromI8(x, dec)
47    End Sub
48
49    Sub Decimal(x As QWord)
50        VarDecFromUI8(x, dec)
51    End Sub
52
53    Sub Decimal(x As Single)
54        VarDecFromR4(x, dec)
55    End Sub
56
57    Sub Decimal(x As Double)
58        VarDecFromR8(x, dec)
59    End Sub
60/*
61    Const Function Operator() As Variant
62        Return New Variant(This)
63    End Function
64/*
65    Static Function Operator(x As SByte) As Decimal
66        Dim d = New Decimal
67        VarDecFromI1(x, d.dec)
68        Return d
69    End Function
70
71    Static Function Operator(x As Byte) As Decimal
72        Dim d = New Decimal
73        VarDecFromUI1(x, d.dec)
74        Return d
75    End Function
76
77    Static Function Operator(x As Integer) As Decimal
78        Dim d = New Decimal
79        VarDecFromI2(x, d.dec)
80        Return d
81    End Function
82
83    Static Function Operator(x As Word) As Decimal
84        Dim d = New Decimal
85        VarDecFromUI2(x, d.dec)
86        Return d
87    End Function
88
89    Static Function Operator(x As Long) As Decimal
90        Dim d = New Decimal
91        VarDecFromI4(x, d.dec)
92        Return d
93    End Function
94
95    Static Function Operator(x As DWord) As Decimal
96        Dim d = New Decimal
97        VarDecFromUI4(x, d.dec)
98        Return d
99    End Function
100
101    Static Function Operator(x As Int64) As Decimal
102        Dim d = New Decimal
103        VarDecFromI8(x, d.dec)
104        Return d
105    End Function
106
107    Static Function Operator(x As QWord) As Decimal
108        Dim d = New Decimal
109        VarDecFromUI8(x, d.dec)
110        Return d
111    End Function
112
113    Static Function Operator(x As DECIMAL) As Decimal
114        Return New Decimal(X)
115    End Function
116
117    Const Function Operator As() As SByte
118        Dim x As SByte
119        VarI1FromDec(dec, x)
120        Return x
121    End Function
122
123    Const Function Operator As() As Byte
124        Dim x As Byte
125        VarUI1FromDec(dec, x)
126        Return x
127    End Function
128
129    Const Function Operator As() As Integer
130        Dim x As Integer
131        VarI2FromDec(dec, x)
132        Return x
133    End Function
134
135    Const Function Operator As() As Word
136        Dim x As Word
137        VarUI2FromDec(dec, x)
138        Return x
139    End Function
140
141    Const Function Operator As() As Long
142        Dim x As Long
143        VarI4FromDec(dec, x)
144        Return x
145    End Function
146
147    Const Function Operator As() As DWord
148        Dim x As DWord
149        VarUI4FromDec(dec, x)
150        Return x
151    End Function
152
153    Const Function Operator As() As Int64
154        Dim x As Int64
155        VarI8FromDec(dec, x)
156        Return x
157    End Function
158
159    Const Function Operator As() As QWord
160        Dim x As QWord
161        VarUI8FromDec(dec, x)
162        Return x
163    End Function
164
165    Const Function Operator As() As Single
166        Dim x As Single
167        VarR4FromDec(dec, x)
168        Return x
169    End Function
170
171    Const Function Operator As() As Double
172        Dim x As Double
173        VarR8FromDec(dec, x)
174        Return x
175    End Function
176
177    Const Function Operator As() As Currency
178        Dim x As Currency
179        VarCyFromDec(dec, x)
180        Return x
181    End Function
182
183    Const Function Operator As() As DECIMAL
184        Return dec
185    End Function
186
187    Static Function Operator As(x As Single) As Decimal
188        Dim d = New Decimal
189        VarDecFromR4(x, d.dec)
190        Return d
191    End Function
192
193    Static Function Operator As(x As Double) As Decimal
194        Dim d = New Decimal
195        VarDecFromR8(x, d.dec)
196        Return d
197    End Function
198*/
199/*
200    Const Function Operator +() As Decimal
201        Return New Decimal(dec)
202    End Function
203*/
204    Const Function Operator -() As Decimal
205        Dim ret = New Decimal
206        VarDecNeg(This.dec, ret.dec)
207        Return ret
208    End Function
209
210    Const Function Operator *(y As Decimal) As Decimal
211        Dim ret = New Decimal
212        VarDecMul(This.dec, y.dec, ret.dec)
213        Return ret
214    End Function
215
216    Const Function Operator /(y As Decimal) As Decimal
217        Dim ret = New Decimal
218        VarDecDiv(This.dec, y.dec, ret.dec)
219        Return ret
220    End Function
221
222    Const Function Operator +(y As Decimal) As Decimal
223        Dim ret = New Decimal
224        VarDecAdd(This.dec, y.dec, ret.dec)
225        Return ret
226    End Function
227
228    Const Function Operator -(y As Decimal) As Decimal
229        Dim ret = New Decimal
230        VarDecSub(This.dec, y.dec, ret.dec)
231        Return ret
232    End Function
233
234    Static Function Compare(x As Decimal, y As Decimal) As HRESULT
235        Return VarDecCmp(x.dec, y.dec)
236    End Function
237
238    Static Function Compare(x As Decimal, y As Double) As HRESULT
239        Return VarDecCmpR8(x.dec, y)
240    End Function
241
242    Static Function Compare(x As Double, y As Decimal) As HRESULT
243        Dim ret = VarDecCmpR8(y.dec, x)
244        Select Case ret
245            Case VARCMP_LT
246                Return VARCMP_GT
247            Case VARCMP_GT
248                Return VARCMP_LT
249            Case Else
250                Return ret
251        End Select
252    End Function
253
254    Const Function Operator ==(y As Decimal) As Boolean
255        Dim c = Compare(This, y)
256        Return c = VARCMP_EQ
257    End Function
258
259    Const Function Operator ==(y As Double) As Boolean
260        Dim c = Compare(This, y)
261        Return c = VARCMP_EQ
262    End Function
263
264    Const Function Operator <>(y As Decimal) As Boolean
265        Dim c = Compare(This, y)
266        Return c <> VARCMP_EQ
267    End Function
268
269    Const Function Operator <>(y As Double) As Boolean
270        Dim c = Compare(This, y)
271        Return c <> VARCMP_EQ
272    End Function
273
274    Const Function Operator <(y As Decimal) As Boolean
275        Dim c = Compare(This, y)
276        Return c = VARCMP_LT
277    End Function
278
279    Const Function Operator <(y As Double) As Boolean
280        Dim c = Compare(This, y)
281        Return c = VARCMP_LT
282    End Function
283
284    Const Function Operator >(y As Decimal) As Boolean
285        Dim c = Compare(This, y)
286        Return c = VARCMP_GT
287    End Function
288
289    Const Function Operator >(y As Double) As Boolean
290        Dim c = Compare(This, y)
291        Return c = VARCMP_GT
292    End Function
293
294    Const Function Operator <=(y As Decimal) As Boolean
295        Dim c = Compare(This, y)
296        Return c = VARCMP_LT Or c = VARCMP_EQ
297    End Function
298
299    Const Function Operator <=(y As Double) As Boolean
300        Dim c = Compare(This, y)
301        Return c = VARCMP_LT Or c = VARCMP_EQ
302    End Function
303
304    Const Function Operator >=(y As Decimal) As Boolean
305        Dim c = Compare(This, y)
306        Return c = VARCMP_GT Or c = VARCMP_EQ
307    End Function
308
309    Const Function Operator >=(y As Double) As Boolean
310        Dim c = Compare(This, y)
311        Return c = VARCMP_GT Or c = VARCMP_EQ
312    End Function
313
314    Const Function Abs() As Decimal
315        Abs = New Decimal
316        VarDecAbs(This.dec, Abs.dec)
317    End Function
318
319    Const Function Fix() As Decimal
320        Fix = New Decimal
321        VarDecFix(This.dec, Fix.dec)
322    End Function
323
324    Const Function Int() As Decimal
325        Int = New Decimal
326        VarDecInt(This.dec, Int.dec)
327    End Function
328
329    Const Function Round(c = 0 As Long) As Decimal
330        Round = New Decimal
331        VarDecRound(This.dec, c, Round.dec)
332    End Function
333
334    Const Function Dec() As DECIMAL
335        Return dec
336    End Function
337
338    Sub Dec(ByRef d As DECIMAL)
339        dec = d
340    End Sub
341
342    Const Function ToVariant() As Variant
343        Return New Variant(This)
344    End Function
345
346    Override Function ToString() As String
347        /*Using*/ Dim bstr = New BString
348            Dim bs As BSTR
349            VarBstrFromDec(dec, LOCALE_USER_DEFAULT, LOCALE_USE_NLS, bs)
350            bstr.Attach(bs)
351            ToString = bstr.ToString
352        bstr.Dispose() 'End Using
353    End Function
354
355    Override Function GetHashCode() As Long
356        Dim p = VarPtr(dec) As *DWord
357        Return (p[0] Xor p[1] Xor p[2] Xor p[3]) As Long
358    End Function
359
360    Function Equals(y As Decimal) As Boolean
361        Dim c = Compare(This, y)
362        Return c = VARCMP_EQ
363    End Function
364Private
365    dec As DECIMAL
366End Class
367
368End Namespace 'COM
369End Namespace 'ActiveBasic
Note: See TracBrowser for help on using the repository browser.