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"
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))
exit for
end if
next iInd
'transition point to iDecCnt (last number to right before iDecCnt)
sNbr = mid(sDec, iDecCnt + 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))
exit for
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