source: branch/egtra-gdiplus/com/decimal.ab@ 303

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

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