Round to a specified number of digits after decimal

Post your FreeBASIC source, examples, tips and tricks here. Please don’t post code without including an explanation.
jkr59
Posts: 6
Joined: Oct 22, 2020 5:59

Re: Round to a specified number of digits after decimal

Post by jkr59 »

Okey, I found an error in line 156 (sNbr = mid(sDec, iDecCnt + 1, 1)). ,1 was missing. Now here is new version. Please let me know, if you find still bugs.

Code: Select all

'**************************************
'FORMATDBL.BAS
's.b. = should be, sorry about english: translated with Google
'**************************************
#define debug
#ifdef debug
    declare function FORMATDBL(dpValue as double, iDecCnt as integer) as string
    declare sub deb(iNumero as integer, sDec as string, iInd as integer, sNbr as string, iNbr as integer, bRise as boolean)
    dim as double dpValue
    dim as integer iDecCnt
    dim as string sSb
	
	print "dpValue,                  iDecCnt, FORMATDBL(dpValue, iDecCnt),      s.b."
    'basic cases
    dpValue = 3.1415 : iDecCnt = 3 : sSb = "3.142"
    print dpValue,, iDecCnt, FORMATDBL(dpValue, iDecCnt),, sSb, 
    if FORMATDBL(dpValue, iDecCnt) = sSb then print "OK" else print "FAIL"

    dpValue = 0.55555555555 : iDecCnt = 2 : sSb = "0.56"
    print dpValue, iDecCnt, FORMATDBL(dpValue, iDecCnt),, sSb,  
    if FORMATDBL(dpValue, iDecCnt) = sSb then print "OK" else print "FAIL"

    dpValue = .0095 : iDecCnt = 2 : sSb = "0.01"
    print dpValue,, iDecCnt, FORMATDBL(dpValue, iDecCnt),, sSb,  
    if FORMATDBL(dpValue, iDecCnt) = sSb then print "OK" else print "FAIL"

    dpValue = -.0095 : iDecCnt = 2 : sSb = "-0.01"
    print dpValue,, iDecCnt, FORMATDBL(dpValue, iDecCnt),, sSb,  
    if FORMATDBL(dpValue, iDecCnt) = sSb then print "OK" else print "FAIL"

    dpValue = 123.0091654 : iDecCnt = 4 : sSb = "123.0092"
    print dpValue,, iDecCnt, FORMATDBL(dpValue, iDecCnt),, sSb, 
    if FORMATDBL(dpValue, iDecCnt) = sSb then print "OK" else print "FAIL"

    dpValue = 123 : iDecCnt = 2 : sSb = "123.00"
    print dpValue,, iDecCnt, FORMATDBL(dpValue, iDecCnt),, sSb, 
    if FORMATDBL(dpValue, iDecCnt) = sSb then print "OK" else print "FAIL"

    dpValue = 99.99 : iDecCnt = 2 : sSb = "99.99"
    print dpValue,, iDecCnt, FORMATDBL(dpValue, iDecCnt),, sSb, 
    if FORMATDBL(dpValue, iDecCnt) = sSb then print "OK" else print "FAIL"

    dpValue = 99.9999 : iDecCnt = 2 : sSb = "100.00"
    print dpValue,, iDecCnt, FORMATDBL(dpValue, iDecCnt),, sSb, 
    if FORMATDBL(dpValue, iDecCnt) = sSb then print "OK" else print "FAIL"

    dpValue = 0.991283 : iDecCnt = 2 : sSb = "0.99"
    print dpValue,, iDecCnt, FORMATDBL(dpValue, iDecCnt),, sSb, 
    if FORMATDBL(dpValue, iDecCnt) = sSb then print "OK" else print "FAIL"

    dpValue = 0.995283 : iDecCnt = 2 : sSb = "1.00"
    print dpValue,, iDecCnt, FORMATDBL(dpValue, iDecCnt),, sSb, 
    if FORMATDBL(dpValue, iDecCnt) = sSb then print "OK" else print "FAIL"

    print

    'problems due to IEEE's format	
    'print 0.009 => 0.008999999999999999
    dpValue = 0.009 : iDecCnt = 3 : sSb = "0.009"
    print dpValue, iDecCnt, FORMATDBL(dpValue, iDecCnt),, sSb,  
    if FORMATDBL(dpValue, iDecCnt) = sSb then print "OK" else print "FAIL"

    'ROUNDDP(1453 / 15, 1) => 96.90000000000001
    dpValue = 1453 / 15 : iDecCnt = 1 : sSb = "96.9"
    print dpValue, iDecCnt, FORMATDBL(dpValue, iDecCnt),, sSb,  
    if FORMATDBL(dpValue, iDecCnt) = sSb then print "OK" else print "FAIL"

    'ROUNDDP(1542 / 20, 1) => 77.09999999999999 
    dpValue = 1542 / 20 : iDecCnt = 1 : sSb = "77.1"
    print dpValue, iDecCnt, FORMATDBL(dpValue, iDecCnt),, sSb,  
    if FORMATDBL(dpValue, iDecCnt) = sSb then print "OK" else print "FAIL"

    '301.1 + 3.1 => 304.2000000000001
    dpValue = 301.1 + 3.1 : iDecCnt = 2 : sSb = "304.20"
    print dpValue, iDecCnt, FORMATDBL(dpValue, iDecCnt),, sSb,  
    if FORMATDBL(dpValue, iDecCnt) = sSb then print "OK" else print "FAIL"

    ?
    ? "sleep.."
    sleep
    end
#endif
'**************************************
'produce double/single neat despite the IEEE format; op can be placed in a variable
'
'the next FORMAT help text doesn't work: 3.1415 and format = 0.000 s.b. 3.142 but is 3.141 
'0 = digit placeholder: if the number has fewer digits than there are zeros (on either side of the  
'decimal) in the format expression, leading or trailing zeros are displayed. 
'if there are more digits to the right of the decimal than zeros in the format, THE NUMBER IS ROUNDED. 
'if there are more digits to the left of decimal than zeros in format the digits are all displayed 
'**************************************
public function FORMATDBL(dpValue as double, iDecCnt as integer) as string

dim as string sFDtmp, sSign, sInt, sDec, sNbr
dim as integer iPointPosi, iIntLen, iDecLen, iInt, iInd, iNbr
dim as boolean bRise

'whole dbl-number
sFDtmp = ltrim(str(dpValue))
'integer and decimal parts of dbl-number
sInt = ""
sDec = ""

'save sign
if left(sFDtmp, 1) = "-" then
    sSign = "-"
    'drop it away
    sFDtmp = mid(sFDtmp, 2)
else
    sSign = ""
end if

'find lengths of parts
iPointPosi = instr(1, sFDtmp, ".")
'take nothing, if there is no decimal part; id est number is like 999
if iPointPosi = 0 then
    iIntLen = len(sFDtmp) 
    iDecLen = 0
else
    iIntLen = iPointPosi - 1 
    iDecLen = len(sFDtmp) - iPointPosi
end if

'separate integer and decimal parts to strings
if iIntLen > 0 then
    sInt = left(sFDtmp, iIntLen)
'sFDtmp is like .999
else
    sInt = "0"
end if
sDec = right(sFDtmp, iDecLen)
 
'may be possible rounding
if iDecCnt < iDecLen then
    bRise = FALSE

    'walk decimal part one character at a time from right to left through
    'first extra decimals not coming along output
    for iInd =  iDecLen to iDecCnt + 1 step -1
        sNbr = mid(sDec, iInd, 1)
        iNbr = cint(sNbr)
        if bRise = TRUE then
            iNbr = iNbr + 1
        end if
        bRise = FALSE

        if iNbr >= 5 then
            mid(sDec, iInd, 1) = "0"
            bRise = TRUE
        else
            mid(sDec, iInd, 1) = ltrim(str(iNbr))
        end if
    next iInd

    'transition point to iDecCnt (last number to right before iDecCnt)
    sNbr = mid(sDec, iDecCnt + 1, 1)
    'last number in iDecCnt, which comes to output
    iNbr = cint(mid(sDec, iDecCnt, 1))
    'last number in iDecCnt need to rise?
    if cint(sNbr) >= 5 then
        mid(sDec, iDecCnt, 1) = ltrim(str(iNbr + 1))
    end if
    
    'rounding of the included decimal part
    for iInd = iDecCnt to 1 step -1
        sNbr = mid(sDec, iInd, 1)
        iNbr = cint(sNbr)
        if bRise = TRUE then
            iNbr = iNbr + 1
        end if
        bRise = FALSE

        if iNbr >= 10 then
            mid(sDec, iInd, 1) = "0"
            bRise = TRUE
        else
            mid(sDec, iInd, 1) = ltrim(str(iNbr))
        end if
    next iInd

end if

'if necessary, integer part is increased
if bRise = TRUE and iNbr >= 10 then
    sInt = ltrim(str(cint(sInt) + 1))
end if

'extend the decimal part if necessary. add zeros
if iDecLen < iDecCnt then
    sDec = sDec + string(iDecCnt - iDecLen, "0")
end if

FORMATDBL = sSign + sInt + "." + left(sDec, iDecCnt) 

end function

hhr
Posts: 211
Joined: Nov 29, 2019 10:41

Re: Round to a specified number of digits after decimal

Post by hhr »

I have tested with an example like this:

Code: Select all

' *******************************
' put the function FORMATDBL here
' *******************************

'testing:
#Include "crt.bi" ' is needed for sprintf

Randomize
Dim As Double n,nsign,e,esign
Dim As Integer decimals
Dim As String s1,s2
Dim As Zstring*50 zs
Dim As Ulongint i

Do
   'Make up the number:
   
   n = Val(Left(Str(Rnd),8))
   nsign = Iif(Rnd < 0.5,-1,1)
   e = Int(Rnd * 4)
   esign = Iif(Rnd < 0.5,-1,1)
   n = nsign * n * (10^(esign * e))
   decimals = Int(Rnd * 4)
   
   'Printout:
   
   s1 = FORMATDBL(n,decimals)
   
   sprintf(zs,"%.*f",decimals,n)
   s2 = zs
   
   i += 1 ' successive number
   Print i
   Print "Number:    ";Str(n),"decimals: ";decimals
   Print "FORMATDBL: ";s1
   Print "sprintf:   ";s2
   
   If s1<>s2 Then
      Print "Different, any key to continue..."
      Sleep
   Else
      Print "Match"
   End If
   
   Print String(30,"-")
Loop
jkr59
Posts: 6
Joined: Oct 22, 2020 5:59

Re: Round to a specified number of digits after decimal

Post by jkr59 »

iDecCnt = 0 was really tricky. It's hard to consider all possibilities. Now new try.

In your testprogram are some oddities:
------------------------------
8 rises 4 to 5, so right answer is 1
Number: 0.480631 decimals: 0
FORMATDBL: 1
sprintf: 0
Different, any key to continue...
------------------------------
last 5 rises second last 4 to 5, which rises last 8 to 9
Number: 6.28845 decimals: 3
FORMATDBL: 6.289
sprintf: 6.288
Different, any key to continue...
------------------------------
last 5 rises last 4 to 5
Number: 462.445 decimals: 2
FORMATDBL: 462.45
sprintf: 462.44
Different, any key to continue...
------------------------------

Code: Select all

'**************************************
'FORMATDBL.BAS
's.b. = should be, sorry about english: translated with Google
'**************************************
#define debug
#ifdef debug
    declare function FORMATDBL(dpValue as double, iDecCnt as integer) as string
    declare sub deb(iNumero as integer, sDec as string, iInd as integer, sNbr as string, iNbr as integer, bRise as boolean)
    dim as double dpValue
    dim as integer iDecCnt
    dim as string sSb
	
	print "dpValue,                  iDecCnt, FORMATDBL(dpValue, iDecCnt),      s.b."
    'basic cases
    dpValue = 3.1415 : iDecCnt = 3 : sSb = "3.142"
    print dpValue,, iDecCnt, FORMATDBL(dpValue, iDecCnt),, sSb, 
    if FORMATDBL(dpValue, iDecCnt) = sSb then print "OK" else print "FAIL"

    dpValue = 0.55555555555 : iDecCnt = 2 : sSb = "0.56"
    print dpValue, iDecCnt, FORMATDBL(dpValue, iDecCnt),, sSb,  
    if FORMATDBL(dpValue, iDecCnt) = sSb then print "OK" else print "FAIL"

    dpValue = .0095 : iDecCnt = 2 : sSb = "0.01"
    print dpValue,, iDecCnt, FORMATDBL(dpValue, iDecCnt),, sSb,  
    if FORMATDBL(dpValue, iDecCnt) = sSb then print "OK" else print "FAIL"

    dpValue = -.0095 : iDecCnt = 2 : sSb = "-0.01"
    print dpValue,, iDecCnt, FORMATDBL(dpValue, iDecCnt),, sSb,  
    if FORMATDBL(dpValue, iDecCnt) = sSb then print "OK" else print "FAIL"

    dpValue = 123.0091654 : iDecCnt = 4 : sSb = "123.0092"
    print dpValue,, iDecCnt, FORMATDBL(dpValue, iDecCnt),, sSb, 
    if FORMATDBL(dpValue, iDecCnt) = sSb then print "OK" else print "FAIL"

    dpValue = 123 : iDecCnt = 2 : sSb = "123.00"
    print dpValue,, iDecCnt, FORMATDBL(dpValue, iDecCnt),, sSb, 
    if FORMATDBL(dpValue, iDecCnt) = sSb then print "OK" else print "FAIL"

    dpValue = 99.99 : iDecCnt = 2 : sSb = "99.99"
    print dpValue,, iDecCnt, FORMATDBL(dpValue, iDecCnt),, sSb, 
    if FORMATDBL(dpValue, iDecCnt) = sSb then print "OK" else print "FAIL"

    dpValue = 99.9999 : iDecCnt = 2 : sSb = "100.00"
    print dpValue,, iDecCnt, FORMATDBL(dpValue, iDecCnt),, sSb, 
    if FORMATDBL(dpValue, iDecCnt) = sSb then print "OK" else print "FAIL"

    dpValue = 0.991283 : iDecCnt = 2 : sSb = "0.99"
    print dpValue,, iDecCnt, FORMATDBL(dpValue, iDecCnt),, sSb, 
    if FORMATDBL(dpValue, iDecCnt) = sSb then print "OK" else print "FAIL"

    dpValue = 0.995283 : iDecCnt = 2 : sSb = "1.00"
    print dpValue,, iDecCnt, FORMATDBL(dpValue, iDecCnt),, sSb, 
    if FORMATDBL(dpValue, iDecCnt) = sSb then print "OK" else print "FAIL"

    dpValue = 999.4 : iDecCnt = 2 : sSb = "999.40"
    print dpValue,, iDecCnt, FORMATDBL(dpValue, iDecCnt),, sSb, 
    if FORMATDBL(dpValue, iDecCnt) = sSb then print "OK" else print "FAIL"

    dpValue = 999.999 : iDecCnt = 2 : sSb = "1000.00"
    print dpValue,, iDecCnt, FORMATDBL(dpValue, iDecCnt),, sSb, 
    if FORMATDBL(dpValue, iDecCnt) = sSb then print "OK" else print "FAIL"

    dpValue = -7.7713 : iDecCnt = 0 : sSb = "-8"
    print dpValue,, iDecCnt, FORMATDBL(dpValue, iDecCnt),, sSb, 
    if FORMATDBL(dpValue, iDecCnt) = sSb then print "OK" else print "FAIL"

    dpValue = 8.8671399 : iDecCnt = 0 : sSb = "9"
    print dpValue,, iDecCnt, FORMATDBL(dpValue, iDecCnt),, sSb, 
    if FORMATDBL(dpValue, iDecCnt) = sSb then print "OK" else print "FAIL"

    print

    'problems due to IEEE's format	
    'print 0.009 => 0.008999999999999999
    dpValue = 0.009 : iDecCnt = 3 : sSb = "0.009"
    print dpValue, iDecCnt, FORMATDBL(dpValue, iDecCnt),, sSb,  
    if FORMATDBL(dpValue, iDecCnt) = sSb then print "OK" else print "FAIL"

    'ROUNDDP(1453 / 15, 1) => 96.90000000000001
    dpValue = 1453 / 15 : iDecCnt = 1 : sSb = "96.9"
    print dpValue, iDecCnt, FORMATDBL(dpValue, iDecCnt),, sSb,  
    if FORMATDBL(dpValue, iDecCnt) = sSb then print "OK" else print "FAIL"

    'ROUNDDP(1542 / 20, 1) => 77.09999999999999 
    dpValue = 1542 / 20 : iDecCnt = 1 : sSb = "77.1"
    print dpValue, iDecCnt, FORMATDBL(dpValue, iDecCnt),, sSb,  
    if FORMATDBL(dpValue, iDecCnt) = sSb then print "OK" else print "FAIL"

    '301.1 + 3.1 => 304.2000000000001
    dpValue = 301.1 + 3.1 : iDecCnt = 2 : sSb = "304.20"
    print dpValue, iDecCnt, FORMATDBL(dpValue, iDecCnt),, sSb,  
    if FORMATDBL(dpValue, iDecCnt) = sSb then print "OK" else print "FAIL"

    ?
    ? "sleep.."
    sleep
    end
#endif
'**************************************
'produce double/single neat despite the IEEE format; op can be placed in a variable
'
'the next FORMAT help text doesn't work: 3.1415 and format = 0.000 s.b. 3.142 but is 3.141 
'0 = digit placeholder: if the number has fewer digits than there are zeros (on either side of the  
'decimal) in the format expression, leading or trailing zeros are displayed. 
'if there are more digits to the right of the decimal than zeros in the format, THE NUMBER IS ROUNDED. 
'if there are more digits to the left of decimal than zeros in format the digits are all displayed 
'**************************************
public function FORMATDBL(dpValue as double, iDecCnt as integer) as string

dim as string sFDtmp, sSign, sInt, sDec, sNbr
dim as integer iPointPosi, iIntLen, iDecLen, iInt, iInd, iNbr
dim as boolean bRise

'whole dbl-number
sFDtmp = ltrim(str(dpValue))
'integer and decimal parts of dbl-number
sInt = ""
sDec = ""

'save sign
if left(sFDtmp, 1) = "-" then
    sSign = "-"
    'drop it away
    sFDtmp = mid(sFDtmp, 2)
else
    sSign = ""
end if

'find lengths of parts
iPointPosi = instr(1, sFDtmp, ".")
'take nothing, if there is no decimal part; id est number is like 999
if iPointPosi = 0 then
    iIntLen = len(sFDtmp) 
    iDecLen = 0
else
    iIntLen = iPointPosi - 1 
    iDecLen = len(sFDtmp) - iPointPosi
end if

'separate integer and decimal parts to strings
if iIntLen > 0 then
    sInt = left(sFDtmp, iIntLen)
'sFDtmp is like .999
else
    sInt = "0"
end if
sDec = right(sFDtmp, iDecLen)
 
'may be possible rounding
if iDecCnt < iDecLen then
    bRise = FALSE

    if iDecCnt > 0 then
        'walk decimal part one character at a time from right to left through
        'first extra decimals not coming along output
        for iInd =  iDecLen to iDecCnt + 1 step -1
            sNbr = mid(sDec, iInd, 1)
            iNbr = cint(sNbr)
            if bRise = TRUE then
                iNbr = iNbr + 1
            end if
            bRise = FALSE
    
            if iNbr >= 5 then
                mid(sDec, iInd, 1) = "0"
                bRise = TRUE
            else
                mid(sDec, iInd, 1) = ltrim(str(iNbr))
            end if
        next iInd
    
        'transition point to iDecCnt (last number to right before iDecCnt)
        sNbr = mid(sDec, iDecCnt + 1, 1)
        'last number in iDecCnt, which comes to output
        iNbr = cint(mid(sDec, iDecCnt, 1))
        'last number in iDecCnt need to rise?
        if cint(sNbr) >= 5 then
            mid(sDec, iDecCnt, 1) = ltrim(str(iNbr + 1))
        end if
        
        'rounding of the included decimal part
        for iInd = iDecCnt to 1 step -1
            sNbr = mid(sDec, iInd, 1)
            iNbr = cint(sNbr)
            if bRise = TRUE then
                iNbr = iNbr + 1
            end if
            bRise = FALSE
    
            if iNbr >= 10 then
                mid(sDec, iInd, 1) = "0"
                bRise = TRUE
            else
                mid(sDec, iInd, 1) = ltrim(str(iNbr))
            end if
        next iInd

    'iDecCnt = 0: no decimals included to output
    else
    
        'walk all decimals one character at a time from right to left through
        'in case integer part häve to rise
        for iInd =  iDecLen to 1 step -1
            sNbr = mid(sDec, iInd, 1)
            iNbr = cint(sNbr)
            if bRise = TRUE then
                iNbr = iNbr + 1
            end if
    
            if iNbr >= 5 then
                mid(sDec, iInd, 1) = "0"
                bRise = TRUE
            else
                mid(sDec, iInd, 1) = ltrim(str(iNbr))
                bRise = FALSE
            end if
        next iInd
    
    end if
end if

'if necessary, integer part is increased
if bRise = TRUE then
    sInt = ltrim(str(cint(sInt) + 1))
end if

'extend the decimal part if necessary. add zeros
if iDecLen < iDecCnt then
    sDec = sDec + string(iDecCnt - iDecLen, "0")
end if

if iDecCnt > 0 then
    FORMATDBL = sSign + sInt + "." + left(sDec, iDecCnt)
else
    FORMATDBL = sSign + sInt
end if 

end function
hhr
Posts: 211
Joined: Nov 29, 2019 10:41

Re: Round to a specified number of digits after decimal

Post by hhr »

So sprintf also makes mistakes.

I don't know the method you use for rounding. What kind of method is that?
jkr59
Posts: 6
Joined: Oct 22, 2020 5:59

Re: Round to a specified number of digits after decimal

Post by jkr59 »

I just go decimal numbers from right to left one at a time and see, if >= 5 (not coming to output, but results need to rise next decimal to left) or >=10 (are coming to output and result need to rise next decimal to left). Also this >=10 is done to integer part, if needed. Now I have little cleaned code. Maybe this is best I can do. Removed parts are commented in function and removed to column 1. I didn't dare to remove them yet.

Code: Select all

'**************************************
'FORMATDBL.BAS
's.b. = should be, sorry about english: translated with Google
'**************************************
#define debug
#ifdef debug
    declare function FORMATDBL(dpValue as double, iDecCnt as integer) as string
    declare sub deb(iNumero as integer, sDec as string, iInd as integer, sNbr as string, iNbr as integer, bRise as boolean)
    dim as double dpValue
    dim as integer iDecCnt
    dim as string sSb
	
	print "dpValue,                  iDecCnt, FORMATDBL(dpValue, iDecCnt),      s.b."
    'basic cases
    dpValue = 3.1415 : iDecCnt = 3 : sSb = "3.142"
    print dpValue,, iDecCnt, FORMATDBL(dpValue, iDecCnt),, sSb, 
    if FORMATDBL(dpValue, iDecCnt) = sSb then print "OK" else print "FAIL"

    dpValue = 0.55555555555 : iDecCnt = 2 : sSb = "0.56"
    print dpValue, iDecCnt, FORMATDBL(dpValue, iDecCnt),, sSb,  
    if FORMATDBL(dpValue, iDecCnt) = sSb then print "OK" else print "FAIL"

    dpValue = .0095 : iDecCnt = 2 : sSb = "0.01"
    print dpValue,, iDecCnt, FORMATDBL(dpValue, iDecCnt),, sSb,  
    if FORMATDBL(dpValue, iDecCnt) = sSb then print "OK" else print "FAIL"

    dpValue = -.0095 : iDecCnt = 2 : sSb = "-0.01"
    print dpValue,, iDecCnt, FORMATDBL(dpValue, iDecCnt),, sSb,  
    if FORMATDBL(dpValue, iDecCnt) = sSb then print "OK" else print "FAIL"

    dpValue = 123.0091654 : iDecCnt = 4 : sSb = "123.0092"
    print dpValue,, iDecCnt, FORMATDBL(dpValue, iDecCnt),, sSb, 
    if FORMATDBL(dpValue, iDecCnt) = sSb then print "OK" else print "FAIL"

    dpValue = 123 : iDecCnt = 2 : sSb = "123.00"
    print dpValue,, iDecCnt, FORMATDBL(dpValue, iDecCnt),, sSb, 
    if FORMATDBL(dpValue, iDecCnt) = sSb then print "OK" else print "FAIL"

    dpValue = 99.99 : iDecCnt = 2 : sSb = "99.99"
    print dpValue,, iDecCnt, FORMATDBL(dpValue, iDecCnt),, sSb, 
    if FORMATDBL(dpValue, iDecCnt) = sSb then print "OK" else print "FAIL"

    dpValue = 99.9999 : iDecCnt = 2 : sSb = "100.00"
    print dpValue,, iDecCnt, FORMATDBL(dpValue, iDecCnt),, sSb, 
    if FORMATDBL(dpValue, iDecCnt) = sSb then print "OK" else print "FAIL"

    dpValue = 0.991283 : iDecCnt = 2 : sSb = "0.99"
    print dpValue,, iDecCnt, FORMATDBL(dpValue, iDecCnt),, sSb, 
    if FORMATDBL(dpValue, iDecCnt) = sSb then print "OK" else print "FAIL"

    dpValue = 0.995283 : iDecCnt = 2 : sSb = "1.00"
    print dpValue,, iDecCnt, FORMATDBL(dpValue, iDecCnt),, sSb, 
    if FORMATDBL(dpValue, iDecCnt) = sSb then print "OK" else print "FAIL"

    dpValue = 999.4 : iDecCnt = 2 : sSb = "999.40"
    print dpValue,, iDecCnt, FORMATDBL(dpValue, iDecCnt),, sSb, 
    if FORMATDBL(dpValue, iDecCnt) = sSb then print "OK" else print "FAIL"

    dpValue = 999.999 : iDecCnt = 2 : sSb = "1000.00"
    print dpValue,, iDecCnt, FORMATDBL(dpValue, iDecCnt),, sSb, 
    if FORMATDBL(dpValue, iDecCnt) = sSb then print "OK" else print "FAIL"

    dpValue = -7.7713 : iDecCnt = 0 : sSb = "-8"
    print dpValue,, iDecCnt, FORMATDBL(dpValue, iDecCnt),, sSb, 
    if FORMATDBL(dpValue, iDecCnt) = sSb then print "OK" else print "FAIL"

    dpValue = 8.8671399 : iDecCnt = 0 : sSb = "9"
    print dpValue,, iDecCnt, FORMATDBL(dpValue, iDecCnt),, sSb, 
    if FORMATDBL(dpValue, iDecCnt) = sSb then print "OK" else print "FAIL"

    dpValue = 123 : iDecCnt = 0 : sSb = "123"
    print dpValue,, iDecCnt, FORMATDBL(dpValue, iDecCnt),, sSb, 
    if FORMATDBL(dpValue, iDecCnt) = sSb then print "OK" else print "FAIL"

    print

    'problems due to IEEE's format	
    'print 0.009 => 0.008999999999999999
    dpValue = 0.009 : iDecCnt = 3 : sSb = "0.009"
    print dpValue, iDecCnt, FORMATDBL(dpValue, iDecCnt),, sSb,  
    if FORMATDBL(dpValue, iDecCnt) = sSb then print "OK" else print "FAIL"

    'ROUNDDP(1453 / 15, 1) => 96.90000000000001
    dpValue = 1453 / 15 : iDecCnt = 1 : sSb = "96.9"
    print dpValue, iDecCnt, FORMATDBL(dpValue, iDecCnt),, sSb,  
    if FORMATDBL(dpValue, iDecCnt) = sSb then print "OK" else print "FAIL"

    'ROUNDDP(1542 / 20, 1) => 77.09999999999999 
    dpValue = 1542 / 20 : iDecCnt = 1 : sSb = "77.1"
    print dpValue, iDecCnt, FORMATDBL(dpValue, iDecCnt),, sSb,  
    if FORMATDBL(dpValue, iDecCnt) = sSb then print "OK" else print "FAIL"

    '301.1 + 3.1 => 304.2000000000001
    dpValue = 301.1 + 3.1 : iDecCnt = 2 : sSb = "304.20"
    print dpValue, iDecCnt, FORMATDBL(dpValue, iDecCnt),, sSb,  
    if FORMATDBL(dpValue, iDecCnt) = sSb then print "OK" else print "FAIL"

    ?
    ? "sleep.."
    sleep
    end
#endif
'**************************************
'produce double/single neat despite the IEEE format; op can be placed in a variable
'
'the next FORMAT help text doesn't work: 3.1415 and format = 0.000 s.b. 3.142 but is 3.141 
'0 = digit placeholder: if the number has fewer digits than there are zeros (on either side of the  
'decimal) in the format expression, leading or trailing zeros are displayed. 
'if there are more digits to the right of the decimal than zeros in the format, THE NUMBER IS ROUNDED. 
'if there are more digits to the left of decimal than zeros in format the digits are all displayed 
'**************************************
public function FORMATDBL(dpValue as double, iDecCnt as integer) as string

dim as string sFDtmp, sSign, sInt, sDec, sNbr
dim as integer iPointPosi, iIntLen, iDecLen, iInt, iInd, iNbr
dim as boolean bRise

'whole dbl-number
sFDtmp = ltrim(str(dpValue))
'integer and decimal parts of dbl-number
sInt = ""
sDec = ""

'save sign
if left(sFDtmp, 1) = "-" then
    sSign = "-"
    'drop it away
    sFDtmp = mid(sFDtmp, 2)
else
    sSign = ""
end if

'find lengths of parts
iPointPosi = instr(1, sFDtmp, ".")
'take nothing, if there is no decimal part; id est number is like 999
if iPointPosi = 0 then
    iIntLen = len(sFDtmp) 
    iDecLen = 0
else
    iIntLen = iPointPosi - 1 
    iDecLen = len(sFDtmp) - iPointPosi
end if

'separate integer and decimal parts to strings
if iIntLen > 0 then
    sInt = left(sFDtmp, iIntLen)
'sFDtmp is like .999
else
    sInt = "0"
end if
sDec = right(sFDtmp, iDecLen)
 
'may be possible rounding
if iDecCnt < iDecLen then
    bRise = FALSE

    if iDecCnt > 0 then
        'walk decimal part one character at a time from right to left through
        'first extra decimals not coming along output
        for iInd =  iDecLen to iDecCnt + 1 step -1
            sNbr = mid(sDec, iInd, 1)
            iNbr = cint(sNbr)
            if bRise = TRUE then
                iNbr = iNbr + 1
            end if
            bRise = FALSE
    
            if iNbr >= 5 then
                bRise = TRUE
                
'REMOVED from earlier version:
'no need to rise extra decimals when "transition point" -thing is removed
'    mid(sDec, iInd, 1) = "0"
'else
'    mid(sDec, iInd, 1) = ltrim(str(iNbr))

            end if
            
        next iInd
    
'REMOVED from earlier version:
''transition point to iDecCnt (last number to right before iDecCnt)
'sNbr = mid(sDec, iDecCnt + 1, 1)
''last number in iDecCnt, which comes to output
'iNbr = cint(mid(sDec, iDecCnt, 1))
''last number in iDecCnt need to rise?
'if cint(sNbr) >= 5 then
'    mid(sDec, iDecCnt, 1) = ltrim(str(iNbr + 1))
'end if
        
        'rounding of the included decimal part
        for iInd = iDecCnt to 1 step -1
            sNbr = mid(sDec, iInd, 1)
            iNbr = cint(sNbr)
            if bRise = TRUE then
                iNbr = iNbr + 1
            end if
            bRise = FALSE
    
            if iNbr >= 10 then
                mid(sDec, iInd, 1) = "0"
                bRise = TRUE
            else
                mid(sDec, iInd, 1) = ltrim(str(iNbr))
            end if
        next iInd

    'iDecCnt = 0: no decimals included to output
    else
    
        'walk all decimals one character at a time from right to left through
        'in case integer part häve to rise
        for iInd =  iDecLen to 1 step -1
            sNbr = mid(sDec, iInd, 1)
            iNbr = cint(sNbr)
            if bRise = TRUE then
                iNbr = iNbr + 1
            end if
    
            if iNbr >= 5 then
                mid(sDec, iInd, 1) = "0"
                bRise = TRUE
            else
                mid(sDec, iInd, 1) = ltrim(str(iNbr))
                bRise = FALSE
            end if
        next iInd
    
    end if
end if

'if necessary, integer part is increased
if bRise = TRUE then
    sInt = ltrim(str(cint(sInt) + 1))
end if

'extend the decimal part if necessary. add zeros
if iDecLen < iDecCnt then
    sDec = sDec + string(iDecCnt - iDecLen, "0")
end if

if iDecCnt > 0 then
    FORMATDBL = sSign + sInt + "." + left(sDec, iDecCnt)
else
    FORMATDBL = sSign + sInt
end if 

end function
Post Reply