This round function round at 0 to 13 places, and a -1.5 turn to -2 and 1.5 to 2
While upgrading M2000 Interpreter to work with Currency and Decimals, I make this function to work with decimals, currency and doubles. The problem with old code was the automatic convertion of all to double.
To eliminate this problem, i thought to place an expression which the biggest number has to be the type of interest. The most problematic type is the Currency, because it has automatic convertion to double. So here is a Testnow sub to show that. Expression Fix(pos * v3 + v4) / v3 has all members as Currency, and return Double. Expression MyRound = Fix(x) + Fix((x - Fix(x)) * 10 + N) / 10 has members as variants, and constant 10, which is as vb want to be as a value, and the return is Currency.
While upgrading M2000 Interpreter to work with Currency and Decimals, I make this function to work with decimals, currency and doubles. The problem with old code was the automatic convertion of all to double.
To eliminate this problem, i thought to place an expression which the biggest number has to be the type of interest. The most problematic type is the Currency, because it has automatic convertion to double. So here is a Testnow sub to show that. Expression Fix(pos * v3 + v4) / v3 has all members as Currency, and return Double. Expression MyRound = Fix(x) + Fix((x - Fix(x)) * 10 + N) / 10 has members as variants, and constant 10, which is as vb want to be as a value, and the return is Currency.
Code:
Sub testnow()
Dim pos As Currency, v As Variant, v1 As Variant, v3 As Currency, v4 As Currency
v3 = 10
v4 = 0.5
pos = 33123.25
v = Fix(pos * v3 + v4) / v3
Debug.Print Typename(v), v ' Double 33123.3
v1 = MyRound(pos, 1)
Debug.Print Typename(v1), v1 ' Currency 33123.3
End Sub
Function MyRound(ByVal x, Optional d As Variant = 0#) As Variant
Dim i, N
i = Abs(Int(d)): If i > 13 Then i = 13
N = Sgn(x) * 0.5
On Error GoTo there
Select Case i
Case 0
MyRound = Fix(x + N)
Case 1
MyRound = Fix(x) + Fix((x - Fix(x)) * 10 + N) / 10
Case 2
MyRound = Fix(x) + Fix((x - Fix(x)) * 100 + N) / 100
Case 3
MyRound = Fix(x) + Fix((x - Fix(x)) * 1000 + N) / 1000
Case 4
MyRound = Fix(x) + Fix((x - Fix(x)) * 10000 + N) / 10000
Case 5
MyRound = Fix(x) + Fix((x - Fix(x)) * 100000 + N) / 100000
Case 6
MyRound = Fix(x) + Fix((x - Fix(x)) * 1000000 + N) / 1000000
Case 7
MyRound = Fix(x) + Fix((x - Fix(x)) * 10000000 + N) / 10000000
Case 8
MyRound = Fix(x) + Fix((x - Fix(x)) * 100000000 + N) / 100000000
Case 9
MyRound = Fix(x) + Fix((x - Fix(x)) * 1000000000 + N) / 1000000000
Case 10
MyRound = Fix(x) + Fix((x - Fix(x)) * 10000000000# + N) / 10000000000#
Case 11
MyRound = Fix(x) + Fix((x - Fix(x)) * 100000000000# + N) / 100000000000#
Case 12
MyRound = Fix(x) + Fix((x - Fix(x)) * 1000000000000# + N) / 1000000000000#
Case 13
MyRound = Fix(x) + Fix((x - Fix(x)) * 10000000000000# + N) / 10000000000000#
End Select
Exit Function
there:
Err.Clear
MyRound = x
End Function