Context Navigation

decimal.ab@ 478

Last change on this file since 478 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
6	Namespace ActiveBasic
7	Namespace COM
8
9	Class Decimal
10	Public
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
364	Private
365	dec As DECIMAL
366	End Class
367
368	End Namespace 'COM
369	End Namespace 'ActiveBasic

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

Download in other formats:

Original Format