home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / MAGAZINE / MISC / DBMS9108.ZIP / TECHTIP2.AUG < prev    next >
Encoding:
Text File  |  1991-06-17  |  2.5 KB  |  78 lines
  1. * Program.: RTROUND.PRG
  2. * Author..: John D. Hrivnak
  3. * Date....: February 21, 1991
  4. * Notice..: Property of Checker Industries Corporation
  5. * Notes...: FoxPro 1.01
  6.  
  7. FUNCTION RTROUND
  8.  
  9. PARAMETERS dnumber, nlength, decpos
  10. * dnumber = input numerical value
  11. * nlength = maximum total length of number display field
  12. * decpos = minimum number of decimal positions to display
  13.  
  14. PRIVATE numstr, places, tens, newdec, newno, setdeci, decmin
  15. * numstr = string equivalent of input numerical value
  16. * places = number of significant decimal positions in input number
  17. * tens = number of significant digits non-decimal
  18. * newdec = final decimal positions adjusted for final display
  19. * newno = temp rounded dnumber in display shrink calc
  20. * setdeci = SET DECIMALS external setting
  21. * decmin = min. decimal positions to round to when number squeeze
  22.  
  23. * calc number of actual sig decimals (BETWEEN test is actually <> 0)
  24. places = 0
  25. DO WHILE BETWEEN(MOD(ABS(dnumber) * 10 ** (places + 1), 10),
  26.       0.000001, 9.999999)
  27.    places = places + 1
  28. ENDDO
  29.  
  30. * calc number of actual sig digits non-decimal
  31. tens = 0
  32. DO WHILE ABS((dnumber / (10 ** tens))) >= 1.0
  33.    tens = tens + 1
  34. ENDDO
  35. * save one place for zero if value less than one
  36. IF tens = 0
  37.    tens = 1
  38. ENDIF
  39.  
  40. * assure decimals padded with zeroes out
  41. * to desired number of positions
  42. newdec = MAX(places, decpos)
  43.  
  44. IF newdec > places    && must pad out dec places for
  45.                         && ROUND fcn to work right
  46.    setdeci = SYS(2001, "DECIMALS")  && remember current setting
  47.    SET DECIMALS TO newdec        && needed for decimal padding
  48.                                     && calc via VAL()
  49.    newno = VAL(STR(dnumber, tens+newdec+IIF(newdec>0,1,0)+
  50.            IIF(SIGN(dnumber)=-1,1,0), newdec))
  51.    SET DECIMALS TO &setdeci
  52. ELSE
  53.    newno = dnumber
  54. ENDIF
  55.  
  56. * put together string representation of numerical value
  57. numstr = LTRIM(STR(newno, tens+newdec+
  58.          IIF(newdec>0,1,0)+IIF(SIGN(newno)=-1,1,0), newdec))
  59.  
  60. * if string doesn't fit in display field, round off as much
  61. * as necessary or possible
  62. decmin = MIN(places, decpos)
  63. DO WHILE LEN(numstr) > nlength .AND. newdec > decmin
  64.    newdec = newdec - 1
  65.    newno = ROUND(newno, newdec)
  66.    numstr = LTRIM(STR(newno, tens+newdec+
  67.             IIF(newdec>0,1,0)+IIF(SIGN(newno)=-1,1,0), newdec))
  68. ENDDO
  69.  
  70. IF LEN(numstr) <= nlength
  71.    numstr = PADL(numstr, nlength)  && if length OK, right justify
  72. ELSE
  73.    numstr = REPLICATE("*", nlength)  && asterisks show undisplayable
  74. ENDIF
  75.  
  76. RETURN numstr
  77. * EOF:  RTROUND.PRG
  78.