inc/convert.i

   1 &ANALYZE-SUSPEND _VERSION-NUMBER UIB_v8r12
   2 &ANALYZE-RESUME
   3 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _DEFINITIONS Include
   4 /*--------------------------------------------------------------------------
   5     File        :
   6     Purpose     :
   7
   8     Syntax      :
   9
  10     Description :
  11
  12     Author(s)   :
  13     Created     :
  14     Notes       :
  15   ------------------------------------------------------------------------*/
  16 /*          This .W file was created with the Progress UIB.             */
  17 /*----------------------------------------------------------------------*/
  18
  19 /* ***************************  Definitions  ************************** */
  20
  21 /* _UIB-CODE-BLOCK-END */
  22 &ANALYZE-RESUME
  23
  24
  25 &ANALYZE-SUSPEND _UIB-PREPROCESSOR-BLOCK
  26
  27 /* ********************  Preprocessor Definitions  ******************** */
  28
  29
  30
  31 /* _UIB-PREPROCESSOR-BLOCK-END */
  32 &ANALYZE-RESUME
  33
  34
  35
  36 /* *********************** Procedure Settings ************************ */
  37
  38 &ANALYZE-SUSPEND _PROCEDURE-SETTINGS
  39 /* Settings for THIS-PROCEDURE
  40    Type: Include
  41    Allow:
  42    Frames: 0
  43    Add Fields to: Neither
  44    Other Settings: INCLUDE-ONLY
  45  */
  46 &ANALYZE-RESUME _END-PROCEDURE-SETTINGS
  47
  48 /* *************************  Create Window  ************************** */
  49
  50 &ANALYZE-SUSPEND _CREATE-WINDOW
  51 /* DESIGN Window definition (used by the UIB)
  52   CREATE WINDOW Include ASSIGN
  53          HEIGHT             = .08
  54          WIDTH              = 40.
  55 /* END WINDOW DEFINITION */
  56                                                                         */
  57 &ANALYZE-RESUME
  58
  59
  60
  61
  62 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _MAIN-BLOCK Include
  63
  64
  65 /* ***************************  Main Block  *************************** */
  66
  67 /* _UIB-CODE-BLOCK-END */
  68 &ANALYZE-RESUME
  69
  70
  71 /* **********************  Internal Procedures  *********************** */
  72
  73 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE amount-to-word Include
  74 PROCEDURE amount-to-word :
  75 /*------------------------------------------------------------------------------
  76   Purpose:     Converts a decimal monetary amount to words
  77   Parameters:  <none>
  78   Notes:
  79 ------------------------------------------------------------------------------*/
  80
  81   DEF INPUT  PARAMETER amount AS DEC NO-UNDO.
  82   DEF OUTPUT PARAMETER words  AS CHAR NO-UNDO.
  83
  84   DEF VAR dollars AS INT NO-UNDO.
  85   DEF VAR cents   AS INT NO-UNDO.
  86
  87   DEF VAR dwords AS CHAR NO-UNDO.
  88   DEF VAR cwords AS CHAR NO-UNDO.
  89
  90   dollars = TRUNCATE( amount, 0 ).
  91   cents   = (amount - dollars) * 100.
  92
  93   RUN num-to-word( dollars, OUTPUT dwords ).
  94   RUN num-to-word( cents,   OUTPUT cwords ).
  95
  96   words = "".
  97   IF dwords <> "" THEN
  98   DO:
  99     words = dwords + " dollar" + IF dollars = 1 THEN "" ELSE "s".
 100     IF cwords <> "" THEN
 101       words = words + " and " + cwords + " cent" + IF cents = 1 THEN "" ELSE "s".
 102     words = words + " only".
 103   END.
 104   ELSE
 105   DO:
 106     IF cwords <> "" THEN
 107       words = cwords + " cent" + IF cents = 1 THEN "" ELSE "s".
 108     words = words + " only".
 109   END.
 110
 111   words = TRIM( words ).
 112
 113 END PROCEDURE.
 114
 115 /* _UIB-CODE-BLOCK-END */
 116 &ANALYZE-RESUME
 117
 118
 119 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE date-to-word Include
 120 PROCEDURE date-to-word :
 121 /*------------------------------------------------------------------------------
 122   Purpose:     Converts a date to a word
 123   Parameters:  <none>
 124   Notes:
 125 ------------------------------------------------------------------------------*/
 126
 127   DEF INPUT  PARAMETER in-date AS DATE NO-UNDO.
 128   DEF OUTPUT PARAMETER words AS CHAR NO-UNDO.
 129
 130   DEF VAR dd AS INT NO-UNDO.
 131   DEF VAR mm AS INT NO-UNDO.
 132   DEF VAR yy AS INT NO-UNDO.
 133
 134   DEF VAR dd-suffix AS CHAR NO-UNDO.
 135   DEF VAR mword     AS CHAR NO-UNDO.
 136
 137   dd = DAY( in-date ).
 138   mm = MONTH( in-date ).
 139   yy = YEAR( in-date ).
 140
 141   dd-suffix =
 142     IF dd = 11 OR dd = 12 OR dd = 13 THEN "th" ELSE
 143     IF dd MODULO 10 = 1 THEN "st" ELSE
 144     IF dd MODULO 10 = 2 THEN "nd" ELSE
 145     IF dd MODULO 10 = 3 THEN "rd" ELSE "th".
 146
 147   CASE mm:
 148     WHEN 1  THEN mword = "January".
 149     WHEN 2  THEN mword = "February".
 150     WHEN 3  THEN mword = "March".
 151     WHEN 4  THEN mword = "April".
 152     WHEN 5  THEN mword = "May".
 153     WHEN 6  THEN mword = "June".
 154     WHEN 7  THEN mword = "July".
 155     WHEN 8  THEN mword = "August".
 156     WHEN 9  THEN mword = "September".
 157     WHEN 10 THEN mword = "October".
 158     WHEN 11 THEN mword = "November".
 159     WHEN 12 THEN mword = "December".
 160   END CASE.
 161
 162   words = STRING( dd ) + dd-suffix + ' ' + mword + ', ' + STRING( yy ).
 163
 164 END PROCEDURE.
 165
 166 /* _UIB-CODE-BLOCK-END */
 167 &ANALYZE-RESUME
 168
 169
 170 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE num-to-word Include
 171 PROCEDURE num-to-word :
 172 /*------------------------------------------------------------------------------
 173   Purpose:     Converts a number to a word
 174   Parameters:  <none>
 175   Notes:
 176 ------------------------------------------------------------------------------*/
 177
 178   DEF INPUT  PARAMETER number AS INT NO-UNDO.
 179   DEF OUTPUT PARAMETER words  AS CHAR NO-UNDO.
 180
 181   DEF VAR ones      AS INT NO-UNDO.
 182   DEF VAR hundreds  AS INT NO-UNDO.
 183   DEF VAR thousands AS INT NO-UNDO.
 184   DEF VAR millions  AS INT NO-UNDO.
 185
 186   DEF VAR oword     AS CHAR NO-UNDO.
 187   DEF VAR hword     AS CHAR NO-UNDO.
 188   DEF VAR tword     AS CHAR NO-UNDO.
 189   DEF VAR mword     AS CHAR NO-UNDO.
 190
 191   IF number <=0 THEN RETURN.
 192
 193   ones      = number MODULO 100.
 194   hundreds  = INT( DEC(number) / 100 - 0.5 ) MODULO 10.
 195   thousands = INT( DEC(number) / 1000 - 0.5 ) MODULO 1000.
 196   millions  = INT( DEC(number) / 1000000  - 0.5 ).
 197
 198   words = "".
 199   IF millions > 0 THEN
 200   DO:
 201     RUN num-to-word( millions, OUTPUT mword ).
 202     words = mword + " million ".
 203   END.
 204
 205   IF thousands > 0 THEN
 206   DO:
 207     RUN num-to-word( thousands, OUTPUT tword ).
 208     words = words + tword + " thousand ".
 209   END.
 210
 211   IF hundreds > 0 THEN
 212   DO:
 213     RUN num-to-word( hundreds, OUTPUT hword ).
 214     words = words + hword + " hundred ".
 215   END.
 216
 217   IF ones > 0 THEN
 218   DO:
 219     IF number > 100 THEN words = words + "and ".
 220     DEF VAR digit AS INT NO-UNDO.
 221     oword = "".
 222     digit = INT( DEC(ones) / 10 - 0.5 ).
 223
 224     oword =
 225       IF digit = 2 THEN "twenty "  ELSE
 226       IF digit = 3 THEN "thirty "  ELSE
 227       IF digit = 4 THEN "forty "   ELSE
 228       IF digit = 5 THEN "fifty "   ELSE
 229       IF digit = 6 THEN "sixty "   ELSE
 230       IF digit = 7 THEN "seventy " ELSE
 231       IF digit = 8 THEN "eighty "  ELSE
 232       IF digit = 9 THEN "ninety "  ELSE "".
 233
 234     digit = IF digit = 1 THEN ones ELSE ones MODULO 10.
 235
 236     CASE digit:
 237       WHEN 1  THEN oword = oword + "one".
 238       WHEN 2  THEN oword = oword + "two".
 239       WHEN 3  THEN oword = oword + "three".
 240       WHEN 4  THEN oword = oword + "four".
 241       WHEN 5  THEN oword = oword + "five".
 242       WHEN 6  THEN oword = oword + "six".
 243       WHEN 7  THEN oword = oword + "seven".
 244       WHEN 8  THEN oword = oword + "eight".
 245       WHEN 9  THEN oword = oword + "nine".
 246       WHEN 10 THEN oword = oword + "ten".
 247       WHEN 11 THEN oword = oword + "eleven".
 248       WHEN 12 THEN oword = oword + "twelve".
 249       WHEN 13 THEN oword = oword + "thirteen".
 250       WHEN 14 THEN oword = oword + "fourteen".
 251       WHEN 15 THEN oword = oword + "fifteen".
 252       WHEN 16 THEN oword = oword + "sixteen".
 253       WHEN 17 THEN oword = oword + "seventeen".
 254       WHEN 18 THEN oword = oword + "eighteen".
 255       WHEN 19 THEN oword = oword + "nineteen".
 256     END CASE.
 257
 258     words = words + oword.
 259
 260   END.
 261
 262   words = TRIM( words ).
 263
 264 END PROCEDURE.
 265
 266 /* _UIB-CODE-BLOCK-END */
 267 &ANALYZE-RESUME
 268
 269
 270 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE word-wrap Include
 271 PROCEDURE word-wrap :
 272 /*------------------------------------------------------------------------------
 273   Purpose:
 274 ------------------------------------------------------------------------------*/
 275 DEF INPUT  PARAMETER in-word    AS CHAR NO-UNDO.
 276 DEF INPUT  PARAMETER wrap-width AS INT NO-UNDO.
 277 DEF OUTPUT PARAMETER result   AS CHAR NO-UNDO.
 278
 279   DEF VAR words-left AS CHAR NO-UNDO.
 280   DEF VAR idx        AS INT NO-UNDO.
 281   DEF VAR idx2       AS INT NO-UNDO.
 282
 283   words-left = in-word.
 284   DO WHILE LENGTH( words-left ) > wrap-width :
 285     idx = R-INDEX( words-left, " ", wrap-width ).
 286     IF idx = 0 THEN idx = wrap-width.
 287     idx2 = INDEX( words-left, "~n").
 288
 289     IF idx2 <> 0 AND idx2 < idx THEN DO:
 290       idx = idx2.
 291       result = result + SUBSTR( words-left, 1, idx).
 292     END.
 293     ELSE
 294       result = result + TRIM(SUBSTR( words-left, 1, idx - 1)) + "~n".
 295
 296     words-left = SUBSTR( words-left, idx + 1).
 297   END.
 298   result = result + words-left.
 299
 300 END PROCEDURE.
 301
 302 /* _UIB-CODE-BLOCK-END */
 303 &ANALYZE-RESUME
 304
 305