source: trunk/ab5.0/ablib/src/com/decimal.ab @ 709

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

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