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

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

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