Context Navigation

decimal.ab@ 344

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

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

Download in other formats:

Original Format