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

Last change on this file since 709 was 709, checked in by イグトランス (egtra), 16 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.