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

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

FormatIntegerDを実装。
UnitTestの失敗時の表示を目立つようにした。
ArrayListを名前空間System.Collectionsに入れた。

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