Context Navigation

decimal.ab@ 478

Last change on this file since 478 was 478, checked in by イグトランス (egtra), 16 years ago
現在向けに修正（参照型のポインタの排除など）
File size: 7.7 KB

Rev	Line
[211]	1	' com/decimal.ab
	2
	3	#require <com/variant.ab>
[231]	4	#require <com/currency.ab>
[211]	5
[267]	6	Namespace ActiveBasic
	7	Namespace COM
	8
[211]	9	Class Decimal
	10	Public
[231]	11	Sub Decimal()
	12	End Sub
	13
	14	Sub Decimal(d As Decimal)
[478]	15	dec = d.dec
[355]	16	End Sub
	17
	18	Sub Decimal(ByRef d As DECIMAL)
[478]	19	dec = d
[211]	20	End Sub
	21
[231]	22	Sub Decimal(lo As Long, mid As Long, hi As Long, isNegative As Boolean, scale As Byte)
	23	If scale > 28 Then
[478]	24	Throw New ArgumentOutOfRangeException("scale")
[231]	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
[335]	60	/*
[231]	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	*/
[335]	199	/*
[211]	200	Const Function Operator +() As Decimal
	201	Return New Decimal(dec)
	202	End Function
[335]	203	*/
[211]	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
[335]	235	Return VarDecCmp(x.dec, y.dec)
[211]	236	End Function
	237
	238	Static Function Compare(x As Decimal, y As Double) As HRESULT
[335]	239	Return VarDecCmpR8(x.dec, y)
[211]	240	End Function
	241
	242	Static Function Compare(x As Double, y As Decimal) As HRESULT
[335]	243	Dim ret = VarDecCmpR8(y.dec, x)
[211]	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
[478]	283
[211]	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
[478]	293
[211]	294	Const Function Operator <=(y As Decimal) As Boolean
	295	Dim c = Compare(This, y)
[335]	296	Return c = VARCMP_LT Or c = VARCMP_EQ
[211]	297	End Function
	298
	299	Const Function Operator <=(y As Double) As Boolean
	300	Dim c = Compare(This, y)
[335]	301	Return c = VARCMP_LT Or c = VARCMP_EQ
[211]	302	End Function
	303
	304	Const Function Operator >=(y As Decimal) As Boolean
	305	Dim c = Compare(This, y)
[335]	306	Return c = VARCMP_GT Or c = VARCMP_EQ
[211]	307	End Function
	308
	309	Const Function Operator >=(y As Double) As Boolean
	310	Dim c = Compare(This, y)
[335]	311	Return c = VARCMP_GT Or c = VARCMP_EQ
[211]	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
[355]	343	Return New Variant(This)
[211]	344	End Function
	345
	346	Override Function ToString() As String
[478]	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
[211]	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
[231]	366	End Class
[267]	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