
Mar 9th, 2018, 08:29 AM
#1
Thread Starter
Fanatic Member
Round Function
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.
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

Mar 9th, 2018, 08:55 AM
#2
Re: Round Function
Hi George,
If you don't mind, maybe you could illustrate the problem a bit more. So far, I've only tested with Decimals, and the regular Round() function seems to work just fine.
Here's code I used to test:
Code:
Debug.Print Round(CDec("0.1234567890123456789012345678"), 25)
And the results were: 0.1234567890123456789012346
which is correct.
I also executed this:
Code:
Debug.Print TypeName(Round(CDec("0.1234567890123456789012345678"), 25))
And it reported: Decimal
suggesting that it was doing everything with the Decimal data type.
I didn't really test the Currency, but Currency is really just a disguised LongLong, under the guise of a fixed (4 digit) floating point number.
All The Best,
Elroy
EDIT1: Also, when examining Currency, I tried this:
Code:
Debug.Print TypeName(Round(CCur(1234.5678), 3))
and it reported: Currency
for me, which is correct.
And I also tried this:
Code:
Debug.Print Round(CCur(1234.5678), 3)
And it reported: 1234.568
which is also correct.
We mustn't forget that a Currency can't handle anything more than four decimal places.
EDIT2: Also, just thinking through what you're doing, if the Decimal or Currency into your procedure was near the upper limit (in absolute numeric size), you're going to get an overflow with your multiplications. I'll admit that I haven't tested the Round() function, but I'd be surprised if it has that problem.
EDIT3: I did more testing with the Currency, and you appear to be correct about it getting typecast to a Double when it goes into the Round() function. However, the Decimal does not. Therefore, the following seems like a more robust solution, given that the Decimal's abilities completely eclipse those of Currency. Here's the oneline solution:
Code:
Debug.Print CCur(Round(CDec(CCur("922337203685477.5707")), 3))
Notice that I typecasted (CCur) to Currency to make sure that's what we were starting with. Then, I had the intent of wanting to round this Currency to 3 decimal places. Knowing it'd be implicitly typecast to a Double by Round(), I pretypecast it to Decimal, executed the Round() and then retypecast back to Currency. Problem solved.
EDIT4: Hmmm, I had a typo in EDIT3. I corrected it and I've still got a problem with that code (i.e., it's overflowing). That's strange because the return of 922337203685477.581 should fit into a Currency.
EDIT5: Ahhh, I figured it out. 922337203685477.581 actually IS too large for a Currency, by only the smallest of amounts. I changed the .5807 to .5707 and now it works just fine.
Last edited by Elroy; Mar 9th, 2018 at 09:27 AM.
Any software I post in these forums written by me is provided “AS IS” without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. Please understand that I’ve been programming since the mid1970s and still have some of that code. My contemporary VB6 project is approaching 1,000 modules. In addition, I have a “VB6 random code folder” that is overflowing. I’ve been at this long enough to truly not know with absolute certainty from whence every single line of my code has come, with much of it coming from programmers under my employ who signed intellectual property transfers. I have not deliberately attempted to remove any licenses and/or attributions from any software. If someone finds that I have inadvertently done so, I sincerely apologize, and, upon notice and reasonable proof, will reattach those licenses and/or attributions. To all, peace and happiness.

Mar 9th, 2018, 09:03 AM
#3
Re: Round Function
There's a few rounding bugs in VB6 I think even specific to the (sorry Currency) type.
MS published a knowledge base with a whole bunch of rounding functions to address the issues too, I don't seem to have it handy.
edit: here's an archive of the rounding functions Knowledge base > https://web.archive.org/web/20080219....com/kb/196652
I can't seem to find the Currency rounding bug, though I have it somewhere in my notes, because it also affects (and probably comes from) a specific API.
Last edited by DEXWERX; Mar 9th, 2018 at 09:29 AM.

Mar 9th, 2018, 09:20 AM
#4
Re: Round Function
Hi Dex. I was probably typing when you submitted. Certainly, one problem is that implicit typecasting of a Currency to a Double (my EDIT3). However, from my testing, that problem doesn't seem to exist for Decimals.
Any software I post in these forums written by me is provided “AS IS” without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. Please understand that I’ve been programming since the mid1970s and still have some of that code. My contemporary VB6 project is approaching 1,000 modules. In addition, I have a “VB6 random code folder” that is overflowing. I’ve been at this long enough to truly not know with absolute certainty from whence every single line of my code has come, with much of it coming from programmers under my employ who signed intellectual property transfers. I have not deliberately attempted to remove any licenses and/or attributions from any software. If someone finds that I have inadvertently done so, I sincerely apologize, and, upon notice and reasonable proof, will reattach those licenses and/or attributions. To all, peace and happiness.

Mar 9th, 2018, 09:31 AM
#5
Re: Round Function
So, just to summarize all my post #2 edits, Round() with Decimal seems to work just fine. However, Round() with Currency does have some problem. But the following fixes it with no worries of any overflows:
Code:
Public Function CurRound(c As Currency, Optional digits As Long = 0&) As Currency
CurRound = CCur(Round(CDec(c), digits))
End Function
Best Regards,
Elroy
Any software I post in these forums written by me is provided “AS IS” without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. Please understand that I’ve been programming since the mid1970s and still have some of that code. My contemporary VB6 project is approaching 1,000 modules. In addition, I have a “VB6 random code folder” that is overflowing. I’ve been at this long enough to truly not know with absolute certainty from whence every single line of my code has come, with much of it coming from programmers under my employ who signed intellectual property transfers. I have not deliberately attempted to remove any licenses and/or attributions from any software. If someone finds that I have inadvertently done so, I sincerely apologize, and, upon notice and reasonable proof, will reattach those licenses and/or attributions. To all, peace and happiness.

Mar 9th, 2018, 09:35 AM
#6
Re: Round Function
Rounding "bugs" or rounding "working as intended?" Banker's Rounding is documented and the alternatives should be well known to any VB6 programmer at this late date.
The goto for this has long been Q196652 "HOWTO: Implement Custom Rounding Procedures" which covers VB5, VB6, VBA, and SQL Server. This article existed in even earlier forms for VB3, VB4, Qbasic/QuickBasic/PDS/VBDOS, and WordBasic.
I doubt any version is still online at Microsoft's KB support site. However if you have the MSDN Library documentation installed and a recent enough version of it (the October 2001 edition being the gold standard and last to support VB6) you can find it there.
SUMMARY
There are a number of different rounding algorithms available in Microsoft products. Rounding algorithms range from Arithmetic Rounding in Excel's Worksheet Round() function to Banker's Rounding in the CInt(), CLng(), and Round() functions in Visual Basic for Applications. This article describes what the various Visual Basic for Applications rounding functions do and provides samples of using the functions. In addition, the article includes sample functions that implement various rounding algorithms.
If you haven't added it to your Favorites in the MSDN Library CHMs yet you should. Highly recommended.
If nothing else it will help explain why "rounding" isn't just "rounding." There are many possible types of rounding and each has its place.

Mar 9th, 2018, 09:50 AM
#7
Re: Round Function
I still can't find the specific bug in oleaut32.dll that has issues rounding Currency types. My memory says its one of the VarR8FromCY type functions.

Mar 9th, 2018, 07:09 PM
#8
Thread Starter
Fanatic Member
Re: Round Function
First, I have to say that MyRound() isn't Banker Round. My bug was in an earlier version of MyRound when I move to use Currency and Decimals.
Decimal changed to double if we want a power. Currency type change to double very easy. Using / you get double, but using * may not.
Code:
Sub testnow()
Dim a As Currency, b As Currency, d As Variant
a = 2233123
b = 10
d = a / b
Debug.Print Typename(d) ' double
End Sub
Code:
Sub testnow1()
Dim a As Currency, b As Currency, d As Variant
a = 2233123
b = 0.01
d = a * b
Debug.Print Typename(d) ' Currency
End Sub
Elroy, check these:
Round(4.45, 1) = 4.4
Myround(4.45, 1) = 4.5
MyRound(Ccur(4.45), 1) = 4.5
Round(Ccur(4.45), 1) = 4.4
For Bankers to get average from a sum of many numbers with half cent or other currency, it is good to use Round(). But I think for graphics rounding is better with the way MyRound works.

Mar 10th, 2018, 01:34 AM
#9
Any software I post in these forums written by me is provided “AS IS” without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. Please understand that I’ve been programming since the mid1970s and still have some of that code. My contemporary VB6 project is approaching 1,000 modules. In addition, I have a “VB6 random code folder” that is overflowing. I’ve been at this long enough to truly not know with absolute certainty from whence every single line of my code has come, with much of it coming from programmers under my employ who signed intellectual property transfers. I have not deliberately attempted to remove any licenses and/or attributions from any software. If someone finds that I have inadvertently done so, I sincerely apologize, and, upon notice and reasonable proof, will reattach those licenses and/or attributions. To all, peace and happiness.

Mar 10th, 2018, 06:34 AM
#10
Thread Starter
Fanatic Member
Re: Round Function
Ok I read the KB, so my round function before was like this
Code:
Function SymArith(ByVal X As Double, _
Optional ByVal Factor As Double = 1) As Double
SymArith = Fix(X * Factor + 0.5 * Sgn(X)) / Factor
' Alternately:
' SymArith = Abs(AsymArith(X, Factor)) * Sgn(X)
End Function
As you see X is a Double. So works fine. Lets say that X is a Variant, and we pass a Currency. We get a Double, because multiplication of a currency turn it to double.
So MyRound() can work as SymArithm, but because has a "+" for addition on Fix(x) (which returns same type), we get as resault same type.

Mar 10th, 2018, 09:06 AM
#11
Re: Round Function
Just for reference http://www.xbeat.net/vbspeed/c_Round.htm includes some interesting code examples (albeit all for doubles) and a test routine to determine if a rounding routine is good with a broad range of 'difficult' numbers.

Mar 10th, 2018, 11:19 AM
#12
Re: Round Function
That Debug.Print Round(33.675, 2) > 33.67 (from VBSpeed) is interesting. I suspect it has something to do with the way that 33.675 goes into and outof binary (i.e., IEEE Double).
In fact, George, your MyRound(33.675, 2) also results in 33.67, which further suggests that it's a binarytobase10 (and viceversa) issue.
So long as we're reading floatingpoints in base10, and storing them in base2, we're probably always going to struggle with these issues.
Because Decimal is actually storing integers with a codeddecimalplace (outlined here), I suspect they always get it correct. In fact, through testing the above example, we get:
Code:
Debug.Print Round(CDec(33.675), 2) ' > prints 33.68
Voila, it's correct (for Banker's rounding).
I suppose we could just always use a CDec() function with Round(). Decimals may hold more precision than any other number type. However, both Single and Double can have far larger and smaller numbers than Decimal, so that's not a perfect solution either.
Best Regards,
Elroy
EDIT1: I do think it's worth remembering though that we're talking about rare numbers that occur only in rare situations. The rare situation is: We're only talking about rounding a 5 to the right of the decimal, and only in the case where there are no more digits to the right of the 5. That's somewhat rare to start with. And then, we're further talking about a rather small subset of those cases that don't round correctly. Granted, we should understand the limitations of our functions, but we should also appreciate the significance (or lack thereof) of those limitations. It's similar to the fact that we'll never have a perfect representation of 1/3 or a perfect value for pi. But we somehow proceed to get work done in spite of these limitations.
EDIT2: If you want a clear example of the difficulties of storing base10 floatingpoint in binary, look at the following:
Code:
Debug.Print CDbl(33.675!) ' > prints 33.6749992370605
A Double is a perfectsuperset of a Single. So why in the world can't a Single be perfectly converted to a Double? (Rhetorical, I know the answer.)
Last edited by Elroy; Mar 10th, 2018 at 11:33 AM.
Any software I post in these forums written by me is provided “AS IS” without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. Please understand that I’ve been programming since the mid1970s and still have some of that code. My contemporary VB6 project is approaching 1,000 modules. In addition, I have a “VB6 random code folder” that is overflowing. I’ve been at this long enough to truly not know with absolute certainty from whence every single line of my code has come, with much of it coming from programmers under my employ who signed intellectual property transfers. I have not deliberately attempted to remove any licenses and/or attributions from any software. If someone finds that I have inadvertently done so, I sincerely apologize, and, upon notice and reasonable proof, will reattach those licenses and/or attributions. To all, peace and happiness.

Mar 10th, 2018, 11:31 AM
#13
Thread Starter
Fanatic Member
Re: Round Function
This is my final code. I found for doubles is better to use Fix(x * N +Sgn(x) * 0.5) / N, but for Currency and Decimals the new one is better.
Code:
Sub test()
Dim A1 As Double, A2 As Variant, A3 As Variant
A1 = 12.445
Debug.Print Round(A1, 2) = 12.45, MyRound(A1, 2) = 12.45
A2 = CCur(A1)
Debug.Print Round(A2, 2) = 12.45, MyRound(A2, 2) = 12.45
A3 = CDec(A1)
Debug.Print Round(A3, 2) = 12.45, MyRound(A3, 2) = 12.45
End Sub
In each type Round return 12.44 and MyRound 12.45
About correctness Round(32.675, 2) when 32.675 is Currency or Decimal return 32.68
And for double 32.67
Code:
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
If VarType(x) = vbDouble Then
' old code but good for double
Select Case i
Case 0
MyRound = Fix(x + n)
Case 1
MyRound = Fix(x * 10# + n) / 10#
Case 2
MyRound = Fix(x * 100# + n) / 100#
Case 3
MyRound = Fix(x * 1000# + n) / 1000#
Case 4
MyRound = Fix(x * 10000# + n) / 10000#
Case 5
MyRound = Fix(x * 100000# + n) / 100000#
Case 6
MyRound = Fix(x * 1000000# + n) / 1000000#
Case 7
MyRound = Fix(x * 10000000# + n) / 10000000#
Case 8
MyRound = Fix(x * 100000000# + n) / 100000000#
Case 9
MyRound = Fix(x * 1000000000# + n) / 1000000000#
Case 10
MyRound = Fix(x * 10000000000# + n) / 10000000000#
Case 11
MyRound = Fix(x * 100000000000# + n) / 100000000000#
Case 12
MyRound = Fix(x * 1000000000000# + n) / 1000000000000#
Case 13
MyRound = Fix(x * 10000000000000# + n) / 10000000000000#
End Select
Exit Function
Else
' good fon currency and decimals
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
End If
there:
Err.Clear
MyRound = x
End Function
Last edited by georgekar; Mar 10th, 2018 at 11:38 AM.

Mar 10th, 2018, 12:01 PM
#14
Re: Round Function
George, just to summarize. Your MyRound() rounds a 5 in the fraction (with nothing more to the right) UP, except in cases where it doesn't. And the VB6 Round() uses Banker's method (rounding those 5's to the "even" side), also except in cases where it doesn't.
And, a particular case where neither rounds as advertised:
Code:
Debug.Print Round(33.675, 2) ' > shows 33.67
Debug.Print MyRound(33.675, 2) ' > shows 33.67
All The Best,
Elroy
Any software I post in these forums written by me is provided “AS IS” without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. Please understand that I’ve been programming since the mid1970s and still have some of that code. My contemporary VB6 project is approaching 1,000 modules. In addition, I have a “VB6 random code folder” that is overflowing. I’ve been at this long enough to truly not know with absolute certainty from whence every single line of my code has come, with much of it coming from programmers under my employ who signed intellectual property transfers. I have not deliberately attempted to remove any licenses and/or attributions from any software. If someone finds that I have inadvertently done so, I sincerely apologize, and, upon notice and reasonable proof, will reattach those licenses and/or attributions. To all, peace and happiness.

Mar 10th, 2018, 12:38 PM
#15
Re: Round Function
Regarding the below code:
Code:
Select Case i
Case 0
MyRound = Fix(x + n)
Case 1
MyRound = Fix(x * 10# + n) / 10#
Case 2
MyRound = Fix(x * 100# + n) / 100#
Case 3
MyRound = Fix(x * 1000# + n) / 1000#
Case 4
MyRound = Fix(x * 10000# + n) / 10000#
Case 5
MyRound = Fix(x * 100000# + n) / 100000#
Case 6
MyRound = Fix(x * 1000000# + n) / 1000000#
Case 7
MyRound = Fix(x * 10000000# + n) / 10000000#
Case 8
MyRound = Fix(x * 100000000# + n) / 100000000#
Case 9
MyRound = Fix(x * 1000000000# + n) / 1000000000#
Case 10
MyRound = Fix(x * 10000000000# + n) / 10000000000#
Case 11
MyRound = Fix(x * 100000000000# + n) / 100000000000#
Case 12
MyRound = Fix(x * 1000000000000# + n) / 1000000000000#
Case 13
MyRound = Fix(x * 10000000000000# + n) / 10000000000000#
End Select
From code above that block
Code:
i = Abs(Int(d)): If i > 13 Then i = 13
we know that the variable i will always contain an integer value from 0 to 13, inclusive. So the numerous lines of code quoted above could be consolidated into a single line:
Code:
MyRound = Fix(x * 10^i + n)/ 10^i

Mar 10th, 2018, 03:14 PM
#16
Thread Starter
Fanatic Member
Re: Round Function
Elroy,
Check MyRound with Decimal and Currency types. These types has no faults, as doubles.
OptionBase1.
I found before some years (the part for doubles, see latest post of MyRound) fastest the function if use literals, and not variables. My language was very slow that time, so everything counts.
I almost done with new interpreter and I publish the code in my git.

Mar 10th, 2018, 07:34 PM
#17
Re: Round Function
Hi George,
Yeah, I had no doubt that a Decimal and Currency were going to work because neither of these is a typical floating point number with respect to having base2 exponent and mantissa(significance) parts. Rather, both Decimal and Currency are actually integers. The Currency just has a 4point (base 10) forced implied fractional part, and the Decimal has another piece that's basically a base10 (not base2) exponent.
And, given that integers can be perfectly translated from base10 to base2 (and viceversa), there would never be any of these problems.
And, I completely agree, if we want a RoundLike function that always rounds a 5 (in the base10 fraction) up, then yours seems to do the job.
All The Best,
Elroy
Any software I post in these forums written by me is provided “AS IS” without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. Please understand that I’ve been programming since the mid1970s and still have some of that code. My contemporary VB6 project is approaching 1,000 modules. In addition, I have a “VB6 random code folder” that is overflowing. I’ve been at this long enough to truly not know with absolute certainty from whence every single line of my code has come, with much of it coming from programmers under my employ who signed intellectual property transfers. I have not deliberately attempted to remove any licenses and/or attributions from any software. If someone finds that I have inadvertently done so, I sincerely apologize, and, upon notice and reasonable proof, will reattach those licenses and/or attributions. To all, peace and happiness.

Mar 10th, 2018, 08:45 PM
#18
Thread Starter
Fanatic Member
Re: Round Function
Hi Elroy,
You say up to .5 but for negatives is down, so MyRound(2.5,0) return 3
For my Interpreter revision 55 completed, and if anyone want to see how Currency and Decimal works there, just take the code from git https://github.com/M2000Interpreter/Version9
Also there is wiki for it a https://github.com/M2000Interpreter/Version9/wiki and there is my blog (In Greek language most of the text, but a lot of code in M2000 written with the English Commands (there are two sets, the other is Greek).

Mar 10th, 2018, 10:51 PM
#19
Re: Round Function
Originally Posted by georgekar
You say up to .5 but for negatives is down, so MyRound(2.5,0) return 3
Ahhh, good point. Yeah, I should have said up (in terms of absolute value).
Any software I post in these forums written by me is provided “AS IS” without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. Please understand that I’ve been programming since the mid1970s and still have some of that code. My contemporary VB6 project is approaching 1,000 modules. In addition, I have a “VB6 random code folder” that is overflowing. I’ve been at this long enough to truly not know with absolute certainty from whence every single line of my code has come, with much of it coming from programmers under my employ who signed intellectual property transfers. I have not deliberately attempted to remove any licenses and/or attributions from any software. If someone finds that I have inadvertently done so, I sincerely apologize, and, upon notice and reasonable proof, will reattach those licenses and/or attributions. To all, peace and happiness.

Mar 11th, 2018, 01:57 AM
#20
Thread Starter
Fanatic Member
Re: Round Function
I forgot to add the blog link. I added to signature.

Mar 11th, 2018, 06:27 AM
#21
Re: Round Function
Along the lines suggested by OptionBase1 in post #16. It seems like Double returns are improved and your old routine works for Currency too if the power of 10 is in a Decimal var.
Hope the following makes sense...
Code:
Function GeorgeRound2(ByVal x As Variant, Optional i As Variant = 0#) As Variant
Dim n As Variant ', i As Variant
Dim j As Integer
Static init As Boolean, PowersOfTen(20 To 20) As Variant
'this prevents handling negative rounding, why not just do it? The code below handles it ok.
'i = Abs(Int(d)): If i > 20 Then i = 20
n = Sgn(x) * 0.5
On Error GoTo there
If Not init Then
For j = 20 To 20
PowersOfTen(j) = CDec(10 ^ j) 'better than plain 10^j?
Next
init = True
End If
' If VarType(x) = vbDouble Then
'when we use CDec(10^j) we can use your 'old code' for Doubles and Currency,
' only 2 stop faults for Doubles and Currency in VBspeed diagnostic test, previously Doubles retuned 8 stop faults using 10^j
GeorgeRound2 = Fix(x * PowersOfTen(i) + n) / PowersOfTen(i)
' Else
'7 stop faults in VBspeed diagnostic test using CDec(10 ^ j) or just 10^j
'GeorgeRound2 = Fix(x) + Fix((x  Fix(x)) * PowersOfTen(i) + n) / PowersOfTen(i)
' End If
Exit Function
there:
Err.Clear
GeorgeRound2 = x
End Function

Mar 11th, 2018, 07:01 AM
#22
Re: Round Function
...and just a tad quicker if you do;
Code:
Static Function GeorgeRound2(ByVal x As Variant, Optional i As Variant = 0#) As Variant
Dim n As Variant ', i As Variant
Dim j As Integer
Dim init As Boolean, PowersOfTen(20 To 20) As Variant
... at the top.

Mar 11th, 2018, 11:06 AM
#23
Thread Starter
Fanatic Member
Re: Round Function
No, test this code with your modification:
Code:
Sub Test()
Dim k As Variant, n As Variant
n = CCur(1232321.235)
k = GeorgeRound2(n, 1)
Debug.Print k
Debug.Print TypeName(k) = TypeName(n)
End Sub
Sub Test2()
Dim A As Variant, B As Variant
A = CCur(1)
B = A / A
Debug.Print TypeName(B)
End Sub
You get False for TypeName(k) = TypeName(n).
This is becaue Currency/Currency return always double
check code in Test2, B is Double.
Although your code is not compatible with Currency is faster than mine. So I have to change it, slighty!
I am working to find the 14 to 1 range for Currency.

Mar 11th, 2018, 12:58 PM
#24
Re: Round Function
Sorry for my oversight on the type returned, but pleased you found it faster.
This one is a little slower of course (unless we pass a Decimal);
Code:
Static Function GeorgeRound2(ByVal x As Variant, Optional i As Variant = 0#) As Variant
Dim n As Variant
Dim j As Long
Dim init As Boolean, PowersOfTen(20 To 20) As Variant
n = Sgn(x) * 0.5
On Error GoTo there
If Not init Then
For j = 20 To 20
PowersOfTen(j) = CDec(10 ^ j)
Next
init = True
End If
GeorgeRound2 = Fix(x * PowersOfTen(i) + n) / PowersOfTen(i)
'ensure returned value has same variable type as that passed in x, else it will be Decimal
Select Case VarType(x)
Case 4 'single
GeorgeRound2 = CSng(GeorgeRound2)
Case 5 'double
GeorgeRound2 = CDbl(GeorgeRound2)
Case 6 'currency
GeorgeRound2 = CCur(GeorgeRound2)
End Select
Exit Function
there:
Err.Clear
GeorgeRound2 = x
End Function
...still quite nippy.

Mar 11th, 2018, 01:38 PM
#25
Thread Starter
Fanatic Member
Re: Round Function
The requirement is to not use any conversion functions. If a currency division return a double, may stay as double. My interpreter also alter variable's types, except long type which raise overflow if happen.

Mar 11th, 2018, 02:03 PM
#26
Re: Round Function
Ok George. Your last two posts mention dividing by a Double, I am dividing by a Decimal which appears to be required to get reliably good numbers returned, albeit they are Decimals, not Doubles. Appreciate it if you are going 'purist' and want to avoid conversion functions though.
Happy Sunday and have a good week.

Mar 11th, 2018, 02:14 PM
#27
Re: Round Function
I was just thinking about the problems and solutions we've got with Round(), particularly the occasional errors with the Banker's rounding. If we're willing to discount speed, the following will correct for the occasional errors. I included a bit of test code along with it (specifically, one of the cases where Round() fails on Banker's rounding):
Code:
Option Explicit
Private Sub Form_Load()
Debug.Print DblRound(33.675, 2)
Unload Me
End Sub
Private Function DblRound(d As Double, Optional ByVal decs As Integer) As Double
' This corrects for the occasional errors in the Banker's rounding in the Round() function with IEEE Doubles.
Dim e As Integer
'
e = CInt(Split(Format$(d, "Scientific"), "E")(1))
DblRound = CDbl(Round(CDec(d * 10# ^ e), decs + e)) * 10# ^ e
End Function
This works because a Decimal has more precision than a Double. It just doesn't have the exponent range. Therefore, if we move the decimal place, do our rounding, and then return the decimal place, we can do it with a Decimal.
There's clearly some kind of machineepsilon value being considered when Doubles are typecast into other types, but that's not always being considered within the Round() function.
George, I'm not sure you're interested, but this could be easily modified to work with your .???5 UP (absolute value) rounding as well.
Best Regards,
Elroy
Any software I post in these forums written by me is provided “AS IS” without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. Please understand that I’ve been programming since the mid1970s and still have some of that code. My contemporary VB6 project is approaching 1,000 modules. In addition, I have a “VB6 random code folder” that is overflowing. I’ve been at this long enough to truly not know with absolute certainty from whence every single line of my code has come, with much of it coming from programmers under my employ who signed intellectual property transfers. I have not deliberately attempted to remove any licenses and/or attributions from any software. If someone finds that I have inadvertently done so, I sincerely apologize, and, upon notice and reasonable proof, will reattach those licenses and/or attributions. To all, peace and happiness.

Mar 11th, 2018, 05:48 PM
#28
Thread Starter
Fanatic Member
Re: Round Function
Hi to comrands from Vbforum;
Final Solution;
1. Works for Single, Double, Currency, Decimal
2. Return same variant type
3. No use of VarType()
4. Use of Round()
5. Range from 0 to 13 decimals round
6. Test5 print for all types the round(33.675, 2) as 33.68
Code:
Sub Test3(ByVal A As Variant, i As Long)
Dim B As Variant, c As Variant
Static n(1 To 13) As Single
If n(1) = 0 Then
For c = 1& To 13&
n(c) = (1  0.5) * CSng(10 ^ (1  c))
Next c
End If
If i = 0 Then
B = Sgn(A) * Int(Abs(A) + 0.5)
Else
c = Fix(A)
B = c + Round(A  c + Sgn(A) * n(i), c)
End If
Debug.Print TypeName(B), B, A, Round(A, i), Round(A, i) = B
End Sub
Sub Test4()
Dim i As Single, m As Variant
For i = 10 To 10 Step 0.125
'Test3 CDec(i / 10), 2
'Test3 CCur(i / 10), 2
'Test3 CDbl(i / 10), 2
Test3 CSng(i * 10), 1
Next i
End Sub
Sub Test5()
Test3 CDec(33.675), 2
Test3 CCur(33.675), 2
Test3 CDbl(33.675), 2
Test3 CSng(33.675), 2
End Sub
Last edited by georgekar; Mar 11th, 2018 at 07:35 PM.
Reason: correction

Mar 11th, 2018, 08:23 PM
#29
Thread Starter
Fanatic Member
Re: Round Function
I found that currency need double, so i make it for it
And these are the two versions for MyRound:
Version Myround() has check for variant types with codes <4, and those are Empty, Null, Integer and Long, which we didn't process. Also check for currency and use a second array (which we place values only in three first places)
We use GetMem2 to get the variant type (no use of VarType).
Version MyRound2 has no use of GetMem2, and if we place single we get double.
Code:
Private Declare Sub GetMem2 Lib "msvbvm60" (ByVal addr As Long, retval As Integer)
' with single, and check for empty, null, integer, long
Static Function MyRound(ByVal a As Variant, Optional ByVal i As Variant = 0)
Dim c As Variant, j As Integer
Dim n(1 To 13) As Single, curr(1 To 13) As Double
GetMem2 VarPtr(a), j
If j < 4 Then MyRound = a: Exit Function
On Error GoTo there
If n(1) = 0 Then
For c = 1& To 13&
n(c) = CSng(1  0.5) * CSng(10 ^ (1  c))
Next c
For c = 1& To 3&
curr(c) = CDbl(1  0.5) * CDbl(10 ^ (1  c))
Next c
End If
If i = 0 Then
MyRound = Sgn(a) * Int(Abs(a) + 0.5)
Else
c = Fix(a)
If j = 6 Then
MyRound = c + Round(a  c + Sgn(a) * curr(i), i)
Else
MyRound = c + Round(a  c + Sgn(a) * n(i), i)
End If
End If
Exit Function
there:
MyRound = a
End Function
' without single, and check for empty, null, integer, long
Static Function MyRound2(ByVal a As Variant, Optional ByVal i As Variant = 0)
Dim c As Variant, j As Integer
Dim n(1 To 13) As Double
On Error GoTo there
If n(1) = 0 Then
For c = 1& To 13&
n(c) = CDbl(1  0.5) * CDbl(10 ^ (1  c))
Next c
End If
If i = 0 Then
MyRound2 = Sgn(a) * Int(Abs(a) + 0.5)
Else
c = Fix(a)
MyRound2 = c + Round(a  c + Sgn(a) * n(i), i)
End If
Exit Function
there:
MyRound2 = a
End Function

Mar 12th, 2018, 06:04 AM
#30
Re: Round Function
Looks good except for this quirk when the correct number of 1.235 is returned but ...
?GeorgeRound3(cdbl(1.2345),3)
1.235
?TypeName(GeorgeRound3(cdbl(1.2345),3))
Double
?GeorgeRound3(cdbl(1.2345),3)= 1.235
False
?GeorgeRound3(cdbl(1.2345),3)= cdbl(1.235)
False
?GeorgeRound3(cdbl(1.2345),3) cdbl(1.235)
2.22044604925031E16
?typename(GeorgeRound3(cdbl(1.2345),3) cdbl(1.235))
Double
?typename(2.22044604925031E16 )
Double
?GeorgeRound3(cdbl(1.2345),3)= cdec(1.235)
True
?GeorgeRound3(cdbl(1.2345),3) cdec(1.235)
0
'ref VbSpeed example
?round17(cdbl(1.2345),3)
1.235
?round17(cdbl(1.2345),3)=cdbl(1.235)
True
?round17(cdbl(1.2345),3) cdbl(1.235)
0

Mar 12th, 2018, 06:23 AM
#31
Re: Round Function
... and why use GetMem, VarType seems quicker here.
Last edited by Magic Ink; Mar 12th, 2018 at 06:30 AM.

Mar 12th, 2018, 06:33 AM
#32
Thread Starter
Fanatic Member
Re: Round Function
I know that. Processing floating point numbers may produce some small quantities. In my interpreter I have a == operator for using comparison both with rounding to 10 digits. And in revision 56, which has an addition for single values I have to do more rounding, say 7. I haven't figure this yet.

Mar 12th, 2018, 06:39 AM
#33
Thread Starter
Fanatic Member
Re: Round Function
About vartype vs getmem2 maybe you are right. Check it in your system using a loop and mesure it with a high precision timer, if you have time.

Mar 12th, 2018, 06:46 AM
#34
Re: Round Function
Done already;
0.222302572408274 (GetMem2)
0.115390198391647 (VarType)
10,000,000 iterations on x where x is a Variant = CDbl(1.2345). Using QueryPerformanceCounter etc.

Mar 12th, 2018, 07:32 AM
#35
Thread Starter
Fanatic Member
Re: Round Function
That's good. Do you do it for all types, single, decimal, double and currency; And for each you have to pass to VarType in a variant variable.

Mar 12th, 2018, 08:01 AM
#36
Re: Round Function
VarType seems faster for all;
Single
0.222638049097483 (1)
0.115567907197295 (2)
Decimal
0.220177691210716 (1)
0.115145042349533 (2)
Double
0.225667896259112 (1)
0.116864067132874 (2)
Currency
0.222074424799704 (1)
0.14575465100014 (2)
above in the IDE shows roughly *2 advantage, when compiled with full tweaks around 3*.

Mar 12th, 2018, 08:48 AM
#37
Re: Round Function
I do wonder if you would be better off taking a much tried and tested Double rounding routine from VbSpeed and converting the returned value to the Type you require as in;
Code:
Function RoundV(n As Variant, Optional places As Long) As Variant
Select Case VarType(n)
Case 5 'double
RoundV = Round17(n, places)
Case 6 'currency
RoundV = CCur(Round17(n, places))
Case 14 'decimal
RoundV = CDec(Round17(n, places))
End Select
End Function
Tests of this against the VbSpeed diagnostics seem to be good, and speed is as good as any posted above.
There may be occasional conversion errors I guess (although I have not found any yet) but they will be minor, and given that you have already said that you can live with/ handle them in post#32 why worry?
You'd need a trap to prevent places>4 with Currency etc., but you know all that....

Mar 12th, 2018, 11:42 AM
#38
Thread Starter
Fanatic Member
Re: Round Function
This is my test code, for MyRound, Round, Round17.
Scope of the test is to show what if we add an offset to A as B and round that, and then subtract from B the rounded A.
We don't care for actual numbers in B and A but we want to see if the offset as evaluated equals to original offset.
As we can see we need a round function, to a value of 10 to get the target value. This is how works an operator ==, by rounding each part (here we round one, because the other has lower decimals from 10).
Also I do a copy of Round17(), who knows what can be happen to the VbSpeed site..and we miss it.
Code:
Option Explicit
Sub test()
Dim a As Double, B As Double, B1 As Double, B0 As Double, B2 As Double, i As Long, M As Double
Dim val As Long
val = 6
M = CDbl(4)
Const Offset As Double = 145.1235
For i = 1 To 5
a = CDbl(Rnd * 100000 + Rnd / 1000000000#) / M
B0 = a + Offset
B = MyRound(B0, val)
B1 = Round(B0, val)
B2 = Round17(B0, val)
Debug.Print "Number " & a & " Add offset" & offset " and then Round to " & val & " place(s)"
Debug.Print B, B1, B2
' using right without Sgn(A) * N(i)
'Debug.Print "compare to Fix(A) + RoundAny(A  Fix(A), val) is Round(A, val)"
'Debug.Print "1st use MyRound, 2nd use 1st without Sgn(A) * N(val), 3d use Round17 and no Sgn(A) * N(val)."
'Debug.Print Fix(a) + Round(a  Fix(a) + Sgn(a) * n(val), val) = Round(a, val), Fix(a) + Round(a  Fix(a), val) = Round(a, val), Fix(a) + Round17(a  Fix(a), val) = Round(a, val)
'' Debug.Print "compare all with BRounded(A)=offset"
Debug.Print (B  MyRound(a, val)) = Offset, (B1  Round(a, val)) = Offset, (B2  Round17(a, val)) = Offset
Debug.Print B  MyRound(a, val), B1  Round(a, val), B2  Round17(a, val)
'Debug.Print "Round all comparisons to 10th place, using standard Round"
Debug.Print Round(B  MyRound(a, val), 10) = Offset, Round(B1  Round(a, val), 10) = Offset, Round(B2  (Round17(a, val)), 10) = Offset
Debug.Print Round(B  MyRound(a, val), 10), Round(B1  Round(a, val), 10), Round(B2  (Round17(a, val)), 10)
Next i
End Sub
Public Function Round17(ByVal v As Double, Optional ByVal lngDecimals As Long = 0) As Double
' By Filipe Lage
' fclage@gmail.com
' msn: fclage@clix.pt
' Revision C by Donald  20060201  (Bugfix)
' Revision D by Jeroen De Maeijer  20100529  (Bugfix)
' Revision E by Filipe Lage  20100530 (speed improvements)
Dim xint As Double, yint As Double, xrest As Double
Static PreviousValue As Double
Static PreviousDecimals As Long
Static PreviousOutput As Double
Static M As Double
If PreviousValue = v And PreviousDecimals = lngDecimals Then Round17 = PreviousOutput: Exit Function
' Hey... it's the same number and decimals as before...
' So, the actual result is the same. No need to recalc it
If v = 0 Then Exit Function
' no matter what rounding is made, 0 is always rounded to 0
If PreviousDecimals = lngDecimals Then
' 20100530 Improvement by fclage  Moved M initialization here for speedup
If M = 0 Then M = 1 ' Initialization  M is never 0 (it is always 10 ^ n)
Else
' A different number of decimal places, means a new Multiplier
PreviousDecimals = lngDecimals
M = 10 ^ lngDecimals
End If
If M = 1 Then xint = v Else xint = v * CDec(M)
' Let's consider the multiplication of the number by the multiplier
' Bug fixed: If you just multiplied the value by M, those nasty reals came up
' So, we use CDEC(m) to avoid that
Round17 = Fix(xint)
' The real integer of the number (unlike INT, FIX reports the actual number)
' 20060201: fix by Donald
If Abs(Fix(10 * (xint  Round17))) > 4 Then
If xint < 0 Then '20100529 fix by Zoenie:
' previous code would round 0,0714285714 with 1 decimal in the end result to 0.1 !!!
' 20100530 Speed improvement by Filipe  comparing vars with < instead of >=
Round17 = Round17  1
Else
Round17 = Round17 + 1
End If
End If
' First decimal is 5 or bigger ? If so, we'll add +1 or 1 to the result (later to be divided by M)
If M = 1 Then Else Round17 = Round17 / M
' Divides by the multiplier. But we only need to divide if M isn't 1
PreviousOutput = Round17
PreviousValue = v
' Let's save this last result in memory... may be handy ;)
End Function
Static Function MyRound(a As Variant, Optional ByVal i As Integer = 13)
Dim c As Variant, j As Integer
Dim n(1 To 13) As Single, curr(1 To 13) As Double
j = VarType(a)
If j < 4 Then MyRound = a: Exit Function
On Error GoTo there
If n(1) = 0 Then
For c = 1& To 13&
n(c) = CSng(1  0.5) * CSng(10 ^ (1  c))
Next c
For c = 1& To 3&
curr(c) = CDbl(1  0.5) * CDbl(10 ^ (1  c))
Next c
End If
If i = 0 Then
MyRound = Sgn(a) * Int(Abs(a) + 0.5)
Else
c = Fix(a)
If j = 6 Then
MyRound = c + Round(a  c + Sgn(a) * curr(i), i)
Else
MyRound = c + Round(a  c + Sgn(a) * n(i), i)
End If
End If
Exit Function
there:
MyRound = a
End Function
Last edited by georgekar; Mar 12th, 2018 at 11:55 AM.

Mar 12th, 2018, 03:19 PM
#39
Re: Round Function
Using the random numbers produced in your post #38 I'm getting up to 50 results per 1000 in which the results returned by MyRound and Round17 differ, the latter is consistently correct. Here are some examples...
Code:
MyRound Round17
(1)19322.9149762498 rounded to 2 places 19322.92 19322.91
(2)7128.67488301856 rounded to 2 places 7128.68 7128.67
(3)3405.6346598971 rounded to 2 places 3405.64 3405.63
(4)11845.2649299012 rounded to 2 places 11845.27 11845.26
(5)9619.9046555863 rounded to 2 places 9619.91 9619.9
(6)24279.2349044191 rounded to 2 places 24279.24 24279.23
(7)10410.9149161682 rounded to 2 places 10410.92 10410.91
(8)22709.3647900926 rounded to 2 places 22709.37 22709.36
MyRound Round17
(1)14956.5797034607 rounded to 6 places 14956.579704 14956.579703
(2)25130.4875794754 rounded to 6 places 25130.48758 25130.487579
(3)17507.2561684953 rounded to 6 places 17507.256169 17507.256168
(4)24622.0718804703 rounded to 6 places 24622.071881 24622.07188
(5)15650.3628674853 rounded to 6 places 15650.362868 15650.362867
(6)9610.27850545508 rounded to 6 places 9610.278506 9610.278505
(7)22653.4705344545 rounded to 6 places 22653.470535 22653.470534
I don't know what you are trying to achieve with the offset work. Almost seems like trying to prove that sums on 2 incorrectly rounded values give the same results as the same sums done on 2 correctly calculated values, that does not help if you want to display a rounded number directly.

Mar 12th, 2018, 04:02 PM
#40
Thread Starter
Fanatic Member
Re: Round Function
You are right. I don't want to prove something. And as I see for doubles Round17 is far better. The example with offset was on the use of round. Normally we use rounding to minimize errors, not to make a non error double. They have errors, and rounding needed. Thank you for your time to find these awful results.
Posting Permissions
 You may not post new threads
 You may not post replies
 You may not post attachments
 You may not edit your posts

Forum Rules

Click Here to Expand Forum to Full Width
