27 de diciembre de 2001

Conversion de numeros a letras (pesetas y euros)

A lo peor un poco tarde ... pero aqui está ...

Es una modificación a la función enviada por Luis Maria Guayan, pero esta acepta Euros y Pesetas, distingue el genero (masculino o femenino) de la moneda y tiene alguna pequeña corrección.
**********************************************************************
*
* Funcion: Num2Let
*
* Convierte un numero a letras. Valido para Euros y Pesetas
*
* Sintaxis:
*
*        =Num2Let(tnNumero, tlEuro, tnDecimales)
*
* Parametros:
*
*        tnNumero = Número a convertir
*        tlEuro (si se devuelve en Euros .T. o Pesetas .F.)
*        tnDecimales (numero de decimales, por defecto 2)
*
* Ejemplos:
*
*       = Num2Let(125.21, .T.)
*       = Num2Let(63241, .F.)
*
* Retorno:
*
*        El numero en caracter
*
* Nota:
*
* Creación           : Luis Maria Guayan
* Ultima Modificacion: 27/12/2001 Juan Encinar, Oscar Fariña, Pablo Roca
**********************************************************************
FUNCTION Num2Let(tnNumero,tlEuro,tnDecimales)
  LOCAL lnEntero, lnFraccion,lcRet
  lcret = ''
  IF PCOUNT()<2
     tlEuro = .T.
  ENDIF
  IF tnNumero<0
     lcret = 'MENOS '
     tnNumero=ABS(tnNumero)
  ENDIF
  
  IF type("tnDecimales") = "L"
     tnDecimales = 2
  ENDIF
  
  lnEntero   = INT(tnNumero)
  lnFraccion = INT((tnNumero - lnEntero) * 10^tndecimales)
  
  lcret = lcret+N2L(lnEntero, .T., tlEuro) + IIF(MOD(lnEntero,1000000)=0 AND lnEntero > 0,' DE ','')+;
  IIF(tlEuro,IIF(lnEntero=1,'UN EURO','EUROS'),IIF(lnEntero=1,'UNA PESETA','PESETAS'))+;
  IIF(lnFraccion > 0,' CON '+ ;
  N2L(lnFraccion, .T., .T.) + IIF(lnFraccion=1,'UN CENTIMO','CENTIMOS'),'')
  RETURN lcret
ENDFUNC

*--------------------------------
* FUNCTION N2L(tnNro, tlBandera, tlMasculino)
*--------------------------------
* Convierte un número entero en letras
* Usada por Let2Num (deben estar ambas)
* USO: ? N2L(1032) -> "MIL TREINTA Y DOS"
* PARAMETROS: lnNro = Número a convertir
*           : tlBandera (solo para diferenciar cuando retorna "UNO" o "UN")
*           : tlMasculino (para diferenciar si la moneda es genero masculino .T. / femenino .F.)
* RETORNA: Caracter
* AUTOR: LMG
* modificada por Juan Encinar, Oscar Fariña, Pablo Roca 27/12/2001
*--------------------------------
FUNCTION N2L(tnNro, tlBandera, tlMasculino)
  LOCAL lnEntero, lcRetorno, lnTerna, lcMiles, ;
    lcCadena, lnUnidades, lnDecenas, lnCentenas,lcCadena2
    
  lcCadena2 = ''
  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 
        lcMiles = IIF(lnUnidades = 1 AND lnDecenas = 0 AND ;
          lnCentenas = 0, 'UN MILLON ', 'MILLONES ')
      CASE lnTerna = 4 AND (lnUnidades+lnDecenas+lnCentenas # 0)
        lcMiles = 'MIL '
      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
      IF !(allt(str(tnNro)) $ "100,1000,1000000,1000000000")
         IF tlMasculino
            lcCadena = IIF(lnTerna = 1 AND NOT tlBandera, 'UNO ', IIF(lnCentenas#0 or lnDecenas#0,'UN ',' '))
         ELSE
            if lnterna = 1
               lcCadena = 'UNA '
            else
               lcCadena = IIF(lnCentenas#0 or lnDecenas#0,'UN'+IIF(lnTerna < 3,'A ',' '),'')
            endif
            
         ENDIF
      ENDIF
      
      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
    
    lcCadena2 = ''
    DO CASE
      CASE lnCentenas = 1
        lcCadena2 = IIF(lnUnidades = 0 AND lnDecenas = 0, ;
          'CIEN ', 'CIENTO ') 
      CASE lnCentenas = 2
        lcCadena2 = 'DOSCIENTOS ' 
      CASE lnCentenas = 3
        lcCadena2 = 'TRESCIENTOS ' 
      CASE lnCentenas = 4
        lcCadena2 = 'CUATROCIENTOS ' 
      CASE lnCentenas = 5
        lcCadena2 = 'QUINIENTOS ' 
      CASE lnCentenas = 6
        lcCadena2 = 'SEISCIENTOS ' 
      CASE lnCentenas = 7
        lcCadena2 = 'SETECIENTOS ' 
      CASE lnCentenas = 8
        lcCadena2 = 'OCHOCIENTOS ' 
      CASE lnCentenas = 9
        lcCadena2 = 'NOVECIENTOS ' 
    ENDCASE
   IF lnTerna < 3 
      lcCadena2 = IIF(tlMasculino,lcCadena2,STRTRAN(lcCadena2,'TOS','TAS'))
   ENDIF
   lcCadena  = lcCadena2+lcCadena

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

*--------------------------------
Pablo Roca

No hay comentarios. :

Publicar un comentario