1 de marzo de 2000

Pasar un importe de numero a letras

Función para pasar un importe de numero a letras para imprimir en una factura, recibo o cheque.

? Num2Let(115.11) -> "CIENTO QUINCE CON ONCE CENTAVOS"

*--------------------------------------------------------------------------
* FUNCTION Num2Let(tnNumero)
*--------------------------------------------------------------------------
* Devuelve un número en letras con centavos
* USO: ? Num2Let(15.11) -> QUINCE CON ONCE CENTAVOS
* RETORNA: Caracter
* AUTOR: LMG
*--------------------------------------------------------------------------
FUNCTION Num2Let(tnNumero)
   LOCAL lnEntero, lnFraccion
   *-- Elegir si se REDONDEA o TRUNCA
   * tnNumero = ROUND(tnNumero, 2)  && Redondeo a 2 decimales
   tnNumero = INT(tnNumero*100)/100 && Trunco a dos decimales
   lnEntero = INT(tnNumero)
   lnFraccion = INT((tnNumero - lnEntero) * 100)
   RETURN N2L(lnEntero, 0) + 'CON ' + ;
      N2L(lnFraccion, 1) + 'CENTAVOS.'
ENDFUNC

*--------------------------------------------------------------------------
* FUNCTION N2L(tnNro, tnFlag)
*--------------------------------------------------------------------------
* Devuelve un número entero en letras
* Usada por Let2Num (deben estar ambas)
* USO: ? N2L(32) -> TREINTA Y DOS
* RETORNA: Caracter
* AUTOR: LMG
*--------------------------------------------------------------------------
FUNCTION N2L(tnNro, tnFlag)
   IF EMPTY(tnFlag)
      tnFlag = 0
   ENDIF
   LOCAL lnEntero, lcRetorno, lnTerna, lcMiles, ;
      lcCadena, lnUnidades, lnDecenas, lnCentenas
   lnEntero = INT(tnNro)
   lcRetorno = ''
   lnTerna = 1
   DO WHILE lnEntero > 0
      lcCadena = ''
      lnUnidades = MOD(lnEntero, 10)
      lnEntero = INT(lnEntero / 10)
      lnDecenas = MOD(lnEntero, 10)
      lnEntero = INT(lnEntero / 10)
      lnCentenas = MOD(lnEntero, 10)
      lnEntero = INT(lnEntero / 10)

      *--- Analizo la terna
      DO CASE
         CASE lnTerna = 1
            lcMiles = ''
         CASE lnTerna = 2 AND (lnUnidades + lnDecenas + lnCentenas # 0)
            lcMiles = 'MIL '
         CASE lnTerna = 3 AND (lnUnidades + lnDecenas + lnCentenas # 0)
            lcMiles = IIF(lnUnidades = 1 AND lnDecenas = 0 AND ;
               lnCentenas = 0, 'MILLON ', 'MILLONES ')
         CASE lnTerna = 4 AND (lnUnidades + lnDecenas + lnCentenas # 0)
            lcMiles = 'MIL MILLONES '
         CASE lnTerna = 5 AND (lnUnidades + lnDecenas + lnCentenas # 0)
            lcMiles = IIF(lnUnidades = 1 AND lnDecenas = 0 AND ;
               lnCentenas = 0, 'BILLON ', 'BILLONES ')
         CASE lnTerna > 5
            lcRetorno = ' ERROR: NUMERO DEMASIADO GRANDE '
            EXIT
      ENDCASE

      *--- Analizo las unidades
      DO CASE
         CASE lnUnidades = 1
            lcCadena = IIF(lnTerna = 1 AND tnFlag = 0, 'UNO ', 'UN ')
         CASE lnUnidades = 2
            lcCadena = 'DOS '
         CASE lnUnidades = 3
            lcCadena = 'TRES '
         CASE lnUnidades = 4
            lcCadena = 'CUATRO '
         CASE lnUnidades = 5
            lcCadena = 'CINCO '
         CASE lnUnidades = 6
            lcCadena = 'SEIS '
         CASE lnUnidades = 7
            lcCadena = 'SIETE '
         CASE lnUnidades = 8
            lcCadena = 'OCHO '
         CASE lnUnidades = 9
            lcCadena = 'NUEVE '
      ENDCASE

      *--- Analizo las decenas
      DO CASE
         CASE lnDecenas = 1
            DO CASE
               CASE lnUnidades = 0
                  lcCadena = 'DIEZ '
               CASE lnUnidades = 1
                  lcCadena = 'ONCE '
               CASE lnUnidades = 2
                  lcCadena = 'DOCE '
               CASE lnUnidades = 3
                  lcCadena = 'TRECE '
               CASE lnUnidades = 4
                  lcCadena = 'CATORCE '
               CASE lnUnidades = 5
                  lcCadena = 'QUINCE '
               OTHER
                  lcCadena = 'DIECI' + lcCadena
            ENDCASE
         CASE lnDecenas = 2
            lcCadena = IIF(lnUnidades = 0, 'VEINTE ', 'VEINTI') + lcCadena
         CASE lnDecenas = 3
            lcCadena = 'TREINTA ' + IIF(lnUnidades = 0, '', 'Y ') + lcCadena
         CASE lnDecenas = 4
            lcCadena = 'CUARENTA ' + IIF(lnUnidades = 0, '', 'Y ') + lcCadena
         CASE lnDecenas = 5
            lcCadena = 'CINCUENTA ' + IIF(lnUnidades = 0, '', 'Y ') + lcCadena
         CASE lnDecenas = 6
            lcCadena = 'SESENTA ' + IIF(lnUnidades = 0, '', 'Y ') + lcCadena
         CASE lnDecenas = 7
            lcCadena = 'SETENTA ' + IIF(lnUnidades = 0, '', 'Y ') + lcCadena
         CASE lnDecenas = 8
            lcCadena = 'OCHENTA ' + IIF(lnUnidades = 0, '', 'Y ') + lcCadena
         CASE lnDecenas = 9
            lcCadena = 'NOVENTA ' + IIF(lnUnidades = 0, '', 'Y ') + lcCadena
      ENDCASE

      *--- Analizo las centenas
      DO CASE
         CASE lnCentenas = 1
            lcCadena = IIF(lnUnidades = 0 AND lnDecenas = 0, ;
               'CIEN ', 'CIENTO ') + lcCadena
         CASE lnCentenas = 2
            lcCadena = 'DOSCIENTOS ' + lcCadena
         CASE lnCentenas = 3
            lcCadena = 'TRESCIENTOS ' + lcCadena
         CASE lnCentenas = 4
            lcCadena = 'CUATROCIENTOS ' + lcCadena
         CASE lnCentenas = 5
            lcCadena = 'QUINIENTOS ' + lcCadena
         CASE lnCentenas = 6
            lcCadena = 'SEISCIENTOS ' + lcCadena
         CASE lnCentenas = 7
            lcCadena = 'SETECIENTOS ' + lcCadena
         CASE lnCentenas = 8
            lcCadena = 'OCHOCIENTOS ' + lcCadena
         CASE lnCentenas = 9
            lcCadena = 'NOVECIENTOS ' + lcCadena
      ENDCASE

      *--- Armo el retorno terna a terna
      lcRetorno = lcCadena + lcMiles + lcRetorno
      lnTerna = lnTerna + 1
   ENDDO
   IF lnTerna = 1
      lcRetorno = 'CERO '
   ENDIF
   RETURN lcRetorno
ENDFUNC

*--------------------------------------------------------------------------

4 comentarios :

  1. ya no funciona portalfox.com?

    ResponderEliminar
    Respuestas
    1. No funciona :-( Los artículos publicados en PortalFox lo iremos recuperando y publicándolos en este nuevo sitio.

      Eliminar
  2. muchas gracias por ese aporte me funcionó muy bien

    ResponderEliminar
  3. el codigo se tiene que compilar en un archivo prg ?

    ResponderEliminar