source: branch/egtra-stream-without-en_dec/com/decimal.ab@ 673

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

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