home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / CLIPPER / MISC / CLFUNC01.ZIP / DLSTRING.PRG
Encoding:
Text File  |  1987-04-03  |  4.5 KB  |  100 lines
  1. *=======================================================================
  2. * QUICK INTRO
  3. *
  4. * Public Domain Clipper utilities.  Permission for dist.
  5. * only if file header descriptions remain.
  6. * If someone can simplify this please, have at it. Maybe an incremented
  7. * loop on the case execution???  I am not perfekt.
  8. * If you do minimize it, please write me about it.
  9. * I needed this function to get away from the picture @B 999,999,999
  10. * for printing and screening dollar amounts.  Just compile the whole
  11. * thing for an example..............................................
  12. *
  13. *=======================================================================
  14. ************************************************************************
  15. *** PROGRAM  Program to see DOL_STR work
  16. ************************************************************************
  17. CLEAR
  18. DO WHILE .T.
  19.    CLEAR
  20.    @20,0 SAY "0 Exits"
  21.    STORE 900000000000.00 TO DOLGET
  22.    @3,0 SAY "ENTER THE DOLLAR AMOUNT..."GET DOLGET PICTURE ;
  23.         "999999999999.99"
  24.    READ
  25.    CLEAR
  26.    IF EMPTY(DOLGET)
  27.       EXIT
  28.    ENDIF
  29.    ?
  30.    ?DOL_STR(DOLGET)
  31.    ?
  32.    WAIT
  33. ENDDO
  34. *
  35. *
  36. *-- EOP FUNC0001
  37. ************************************************************************
  38. ************************************************************************
  39. * FUNCTION LTN                               Merlin Comp Sys.
  40. * syntax LTN( <numeric> )                    Jeff Morgan
  41. * returns numeric left trimmed as a string   274 Woodstream Ct.
  42. *                                            Langhorne, Pa.
  43. *                                            19047
  44. *-----------------------------------------------------------------------
  45. FUNCTION LTN
  46. *-----------------------------------------------------------------------
  47. PARAMETER cl_numb
  48. RETURN(LTRIM(STR(cl_numb)))   && found myself 4ever (L) trimming numerics
  49. *
  50. *
  51. *-- EOF LTN()
  52. ************************************************************************
  53. ************************************************************************
  54. * FUNCTION DOL_STR
  55. * syntax DOL_STR( < <numeric> )
  56. * returns numeric left trimmed in dollar format with comma and leading
  57. * $ sign. additional decimal spaces by adjusting line 67
  58. *
  59. * DATE    :        4/3/87
  60. * AUTHOR  :        MERLIN COMPUTER SYSTEMS
  61. *                  Jeff Morgan
  62. *                  274 Woodstream Court
  63. *                  Langhorne, Pa. 19047
  64. *
  65. * ADDITIONAL - LTN() = left trimmed numeric string
  66. * ACCURACY   - GOOD UP TO 999,999,999,999.99
  67. *-----------------------------------------------------------------------
  68. FUNCTION DOL_STR
  69. *-----------------------------------------------------------------------
  70. PARAMETERS cl_d_amt
  71. STORE AT(".",LTN(cl_d_amt)) TO cl_d_len                    && *** located decimal position
  72. STORE SUBSTR(LTN(cl_d_amt),1,(cl_d_len-1)) TO cl_d_amt1    && *** substring up to decimal position
  73. STORE LEN(cl_d_amt1) TO cl_d_len1                          && *** length of the substring up to decimal
  74. STORE SUBSTR(LTN(cl_d_amt),(cl_d_len),3) TO cl_dlrst2      && *** store substring with decimal to end of numeric from decimal position
  75. STORE LTN(cl_d_amt) TO cl_dlrst1                           && *** store for when not fitting in case statments ie < 3
  76. DO CASE
  77.    CASE cl_d_len1 > 9 .AND. cl_d_len1 < 13                 && *** if > 999999999 and < 999999999999
  78.       STORE SUBSTR(cl_d_amt1,1,(cl_d_len1-9)) ;            && *** find how much above 999999999 and comma it
  79.        + "," + SUBSTR(cl_d_amt1,((cl_d_len1-9)+1),3) ;
  80.        + "," + SUBSTR(cl_d_amt1,((cl_d_len1-6)+1),3) ;
  81.        + "," + SUBSTR(cl_d_amt1,((cl_d_len1-3)+1),3) ;
  82.        TO cl_dlrst1
  83.    CASE cl_d_len1 > 6 .AND. cl_d_len1 < 10                 && *** if > 999999 and < 999999999
  84.       STORE SUBSTR(cl_d_amt1,1,(cl_d_len1-6)) ;            && *** find how much above 999999 and comma it
  85.        + "," + SUBSTR(cl_d_amt1,((cl_d_len1-6)+1),3) ;
  86.        + "," + SUBSTR(cl_d_amt1,((cl_d_len1-3)+1),3) ;
  87.        TO cl_dlrst1
  88.    CASE cl_d_len1 > 3 .AND. cl_d_len1 < 7                  && if > 999 and < 999999
  89.       STORE SUBSTR(cl_d_amt1,1,(cl_d_len1-3)) ;            && *** find how much above 999 and comma it
  90.        + "," + SUBSTR(cl_d_amt1,((cl_d_len1-3)+1),3) ;
  91.        TO cl_dlrst1
  92. ENDCASE
  93. DOLRSTRG = "$"+IF(cl_d_len1 < 4,cl_dlrst1,(cl_dlrst1 ;     && *** if comma inserted or not and add $
  94.                + cl_dlrst2))
  95. RETURN(DOLRSTRG)                                           && *** return string dollars with leading $ and commas
  96. *
  97. *
  98. *** EOF DOL_STR()
  99. ************************************************************************
  100.