Context Navigation

decimal.ab@ 442

Last change on this file since 442 was 355, checked in by イグトランス (egtra), 18 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
7	Namespace ActiveBasic
8	Namespace COM
9
10	Class Decimal
11	Public
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
365	Private
366	dec As DECIMAL
367	End Class
368
369	End Namespace 'COM
370	End Namespace 'ActiveBasic

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

Original Format