Category : Files from Magazines
Archive   : DBMS9108.ZIP
Filename : TECHTIP2.AUG

* Program.: RTROUND.PRG
* Author..: John D. Hrivnak
* Date....: February 21, 1991
* Notice..: Property of Checker Industries Corporation
* Notes...: FoxPro 1.01

FUNCTION RTROUND

PARAMETERS dnumber, nlength, decpos
* dnumber = input numerical value
* nlength = maximum total length of number display field
* decpos = minimum number of decimal positions to display

PRIVATE numstr, places, tens, newdec, newno, setdeci, decmin
* numstr = string equivalent of input numerical value
* places = number of significant decimal positions in input number
* tens = number of significant digits non-decimal
* newdec = final decimal positions adjusted for final display
* newno = temp rounded dnumber in display shrink calc
* setdeci = SET DECIMALS external setting
* decmin = min. decimal positions to round to when number squeeze

* calc number of actual sig decimals (BETWEEN test is actually <> 0)
places = 0
DO WHILE BETWEEN(MOD(ABS(dnumber) * 10 ** (places + 1), 10),
0.000001, 9.999999)
places = places + 1
ENDDO

* calc number of actual sig digits non-decimal
tens = 0
DO WHILE ABS((dnumber / (10 ** tens))) >= 1.0
tens = tens + 1
ENDDO
* save one place for zero if value less than one
IF tens = 0
tens = 1
ENDIF

* assure decimals padded with zeroes out
* to desired number of positions
newdec = MAX(places, decpos)

IF newdec > places && must pad out dec places for
&& ROUND fcn to work right
setdeci = SYS(2001, "DECIMALS") && remember current setting
SET DECIMALS TO newdec && needed for decimal padding
&& calc via VAL()
newno = VAL(STR(dnumber, tens+newdec+IIF(newdec>0,1,0)+
IIF(SIGN(dnumber)=-1,1,0), newdec))
SET DECIMALS TO &setdeci
ELSE
newno = dnumber
ENDIF

* put together string representation of numerical value
numstr = LTRIM(STR(newno, tens+newdec+
IIF(newdec>0,1,0)+IIF(SIGN(newno)=-1,1,0), newdec))

* if string doesn't fit in display field, round off as much
* as necessary or possible
decmin = MIN(places, decpos)
DO WHILE LEN(numstr) > nlength .AND. newdec > decmin
newdec = newdec - 1
newno = ROUND(newno, newdec)
numstr = LTRIM(STR(newno, tens+newdec+
IIF(newdec>0,1,0)+IIF(SIGN(newno)=-1,1,0), newdec))
ENDDO

IF LEN(numstr) <= nlength
numstr = PADL(numstr, nlength) && if length OK, right justify
ELSE
numstr = REPLICATE("*", nlength) && asterisks show undisplayable
ENDIF

RETURN numstr
* EOF: RTROUND.PRG