2000-12-04 如何將數字文字轉成數字﹙ＩＢＭ版）

2000-12-04 如何將數字文字轉成數字﹙ＩＢＭ版）

QRPGLESRC RPGLE getNum_P Prototype

      *---------------------------------------------------------
      * getNum - procedure to read a number from a string
      *          and return a 30p 9 value
      * Parameters:
      *   I:      string   - character value of number
      *   I:(opt) decComma - decimal point and digit separator
      *   I:(opt) currency - currency symbol for monetary amounts
      * Returns:  packed(30,9)
      *
      * Parameter details:
      *   string:   the string may have
      *             - blanks anywhere
      *             - sign anywhere
      *               accepted signs are: + - cr CR ()
      *               (see examples below)
      *             - digit separators anywhere
      *             - currency symbol anywhere
      *   decComma: if not passed, this defaults to
      *                 decimal point   = '.'
      *                 digit separator = ','
      *   currency: if not passed, defaults to ' '
      *
      * Examples of input and output (x means parm not passed):
      *
      *        string         | dec | sep | cursym |   result
      *        ---------------+-----+-----+--------+------------
      *          123          | x   | x   | x      |   123
      *          +123         | x   | x   | x      |   123
      *          123+         | x   | x   | x      |   123
      *          -123         | x   | x   | x      |   -123
      *          123-         | x   | x   | x      |   -123
      *          (123)        | x   | x   | x      |   -123
      *          12,3         | ,   | .   | x      |   12.3
      *          12.3         | x   | x   | x      |   12.3
      *          1,234,567.3  | x   | x   | x      |   1234567.3
      *          $1,234,567.3 | .   | ,   | $      |   1234567.3
      *          $1.234.567,3 | ,   | .   | $      |   1234567.3
      *          123.45CR     | x   | x   | x      |   -123.45
      *
      * Author: Barbara Morris, IBM Toronto Lab
      * Date:   March, 2000
      *---------------------------------------------------------
     D getNum          pr            30p 9
     D  string                      100a   const varying
     D  decComma                      2a   const options(*nopass)
     D  currency                      1a   const options(*nopass)

===================================================================================
QRPGLESRC RPGLE GetNum Module

      *<-----* module GETNUM start here ----->

     H NOMAIN

      * Copy prototype for procedure getNum
     D/COPY GETNUM_P

     p getNum          b                   Export
     D getNum          pi            30p 9
     D  string                      100a   const varying
     D  decComma                      2a   const options(*nopass)
     D  currency                      1a   const options(*nopass)

      * defaults for optional parameters
     D decPoint        s              1a   inz('.')
     D comma           s              1a   inz(',')
     D cursym          s              1a   inz(' ')
      * structure for building result
     D                 ds
     D result                        30s 9 inz(0)
     D resChars                      30a   overlay(result)
      * variables for gathering digit information
      * pNumPart points to the area currently being gathered
      * (the integer part or the decimal part)
     D pNumPart        s               *
     D numPart         s             30a   varying based(pNumPart)
     D intPart         s             30a   varying inz('')
     D decPart         s             30a   varying inz('')
      * other variables
     D intStart        s             10i 0
     D decStart        s             10i 0
     D sign            s              1a   inz('+')
     D i               s             10i 0
     D len             s             10i 0
     D c               s              1a

      * override defaults if optional parameters were passed
     C                   if        %parms > 1
     C                   eval      decPoint = %subst(decComma : 1 : 1)
     C                   eval      comma    = %subst(decComma : 2 :1)
     C                   endif

     C                   if        %parms > 2
     C                   eval      cursym = currency
     C                   endif

      * initialization
     C                   eval      len = %len(string)
      * begin reading the integer part
     C                   eval      pNumPart = %addr(intPart)

      * loop through characters
     C                   do        len           i
     C                   eval      c = %subst(string : i : 1)

     C                   select
      * ignore blanks, digit separator, currency symbol
     C                   when      c = comma or c = *blank or c = cursym
     C                   iter
      * decimal point: switch to reading the decimal part
     C                   when      c = decPoint
     C                   eval      pNumPart = %addr(decPart)
     C                   iter
      * sign: remember the most recent sign
     C                   when      c = '+' or c = '-'
     C                   eval      sign = c
     C                   iter
      * more signs: cr, CR, () are all negative signs
     C                   when      c = 'C' or c = 'R' or
     C                             c = 'c' or c = 'r' or
     C                             c = '(' or c = ')'
     C                   eval      sign = '-'
     C                   iter
      * a digit: add it to the current build area
     C                   other
     C                   eval      numPart = numPart + c

     C                   endsl
     C                   enddo

      * copy the digit strings into the correct positions in the
      * zoned variable, using the character overlay
     C                   eval      decStart = %len(result) - %decPos(result)
     C                                      + 1
     C                   eval      intStart = decStart - %len(intPart)
     C                   eval      %subst(resChars
     C                                  : intStart
     C                                  : %len(intPart))
     C                               = intPart
     C                   eval      %subst(resChars
     C                                  : decStart
     C                                  : %len(decPart))
     C                               = decPart
      * if the sign is negative, return a negative value
     C                   if        sign = '-'
     C                   return    - result
      * otherwise, return the positive value
     C                   else
     C                   return    result
     C                   endif
     p                 e
===================================================================================

QRPGLESRC RPGLE 

     ****************************************************************
      *--------------------------------------------------------------*
      *                                                              *
      *  Module Creation:  CRTRPGMOD  MODULE(library/GETNUMTEST)     *
      *                               SRCFILE(library/QRPGLESRC)     *
      *                                                              *
      *  Program Creation: CRTPGM     PGM(library/GETNUMTEST)        *
      *                               MODULE(library/GETNUMTEST)     *
      *                                      library/GETNUM)         *
      *                                                              *
      ****************************************************************
      * Copy prototype for procedure getNum
     D/COPY GETNUM_P

     D res             s                   like(getNum)
     D msg             s             52a

     C     *entry        plist
     C                   parm                    p                32
     C                   parm                    dc                2
     C                   parm                    c                 1

     C                   select
     C                   when      %parms = 1
     C                   eval      res = getNum(p)
     C                   when      %parms = 2
     C                   eval      res = getNum(p : dc)
     C                   when      %parms = 3
     C                   eval      res = getNum(p : dc : c)
     C                   endsl
     C                   eval      msg = '<' + %char(res) + '>'
     C     msg           dsply

     C                   return