Numeros a Letras

Numeros a Letras

Postby antolin » Thu Mar 29, 2012 4:17 pm

Hola amigos.

Aqui os dejo una rutina para pasar numeros a letras que admite hasta 21 digitos y puede ponerse en feminino:

Code: Select all  Expand view
FUNCTION NumALetr(nNum,lMasc)
   LOCAL cNum,c100,cRtn := ""
   LOCAL nLnm,nOri,nGrp,nLtr,cTrio
   LOCAL lGen,lM1 := .F.
   LOCAL nN

   DEFAULT lMasc := .T.
   *
   IF ValType( nNum ) == "C"
      cNum := ALLTRIM(STRTRAN(nNum,".",""))
      nN   := VAL(cNum)
   ELSE
      nN   := nNum
      cNum := LTRIM(str(nN))
   ENDIF
   nLnm := LEN(cNum)
   nOri := nLnm
   nGrp := INT((nLnm+2)/3)
   nLtr := 3-((nGrp*3)-nLnm)
   DO WHILE nGrp > 0 .AND. nN > 0
      cTrio := LEFT(cNum,nLtr)
      IF nLtr = 1
     cTrio := "00"+cTrio
      ELSEIF nLtr = 2
     cTrio := "0"+cTrio
      ENDIF
      nLnm -= nLtr
      cNum := RIGHT(cNum,nLnm)
      nLtr := 3
      lGen := IF(nGrp > 2 , .T. , lMasc )
      c100 := Centenas(cTrio,lGen,nGrp)
      IF c100 = "ún " .OR. RIGHT( c100,4) = " ún "
     c100 := LEFT(c100,LEN(c100)-3) + "un "
      ENDIF
      DO CASE
     CASE nGrp = 5
          cRtn += c100+IF( cTrio = "001" .AND. nOri = 13 , "billón " , "billones " )
          IF LEFT( cNum,6) = "000000"
         cNum := RIGHT(cNum,6)
         nLnm := 6
         nGrp := 3
          ENDIF
     CASE nGrp = 3 .OR. nGrp = 7
          cRtn += c100+IF(cTrio = "001" .AND. ( nOri = 7 .OR. nOri = 19 ) , ;
                  "millón ","millones ")
          IF LEFT(cNum,6) = "000000" .AND. nGrp = 7
         cRtn += "de "
          ENDIF
     CASE nGrp = 2 .OR. nGrp = 4 .OR. nGrp = 6
          cRtn += IF( cTrio = "001" , "" , c100 ) + IF( EMPTY(c100) , "" , "mil " )
     OTHERWISE
          cRtn += c100
      ENDCASE
      --nGrp
   ENDDO
   IF EMPTY(cRtn) .OR. nN = 0
      cRtn := "cero"
   ENDIF
RETURN RTRIM(cRtn)
*
FUNCTION Centenas(cTr,lG,nG)
   LOCAL cC1,cD1,cRet := ""
   *
   cC1 := LTRIM(STR(VAL(LEFT(cTr,1))))
   cD1 := RIGHT(cTr,2)
   DO CASE
      CASE cTr = "100"
       RETURN ("cién ")
      CASE cC1 = "1"
       cRet := "ciento "
      CASE cC1 = "5"
       cRet := "quinient"+IF(lG,"os ","as ")
      CASE cC1 # "0"
       cRet := Unidades(cC1,nG,lG,.T.)
       cRet := LEFT(cRet,LEN(cRet)-1)+"cient"+IF(lG,"os ","as ")
   ENDCASE
   cRet += Decenas(cD1,lG,nG)
RETURN cRet
*
FUNCTION Decenas(cDn,lG,nG)
   LOCAL cD1,cU1,cRet := ""
   *
   cD1 := LTRIM(STR(VAL( LEFT(cDn,1))))
   cU1 := LTRIM(STR(VAL(RIGHT(cDn,1))))
   DO CASE
      CASE cD1 = "9"
       cRet := "noventa "
      CASE cD1 = "8"
       cRet := "ochenta "
      CASE cD1 = "7"
       cRet := "setenta "
      CASE cD1 = "6"
       cRet := "sesenta "
      CASE cD1 = "5"
       cRet := "cincuenta "
      CASE cD1 = "4"
       cRet := "cuarenta "
      CASE cD1 = "3"
       cRet := "treinta "
      CASE cD1 = "2"
       IF cU1 > "0"
          cRet := "veinti"
       ELSE
          RETURN ("veinte ")
       ENDIF
      CASE cDn = "15"
       RETURN ("quince ")
      CASE cDn = "14"
       RETURN ("catorce ")
      CASE cDn = "13"
       RETURN ("trece ")
      CASE cDn = "12"
       RETURN ("doce ")
      CASE cDn = "11"
       RETURN ("once ")
      CASE cDn = "10"
       RETURN ("diez ")
      CASE VAL(cDn) > 10
       cRet := "dieci"
   ENDCASE
   IF cU1 # "0" .AND. cD1 > "2"
      cRet += "y "
   ENDIF
   cRet += Unidades(cU1,nG,lG,.F.)
RETURN cRet
*
FUNCTION Unidades(cUn,nG,lG,lM)
   LOCAL cRet := ""
   *
   DO CASE
      CASE cUn = "1"
       cRet := IF(lG,IF(nG > 1,"ún ","uno "),"una ")
      CASE cUn = "2"
       cRet := "dos "
      CASE cUn = "3"
       cRet := "tres "
      CASE cUn = "4"
       cRet := "cuatro "
      CASE cUn = "5"
       cRet := "cinco "
      CASE cUn = "6"
       cRet := "seis "
      CASE cUn = "7"
       cRet := IF(lM,"sete ","siete ")
      CASE cUn = "8"
       cRet := "ocho "
      CASE cUn = "9"
       cRet := IF(lM,"nove ","nueve ")
   ENDCASE
RETURN cRet
 

Espero que os sea util.

Saludos.
Peaaaaaso de foro...
antolin
 
Posts: 491
Joined: Thu May 10, 2007 8:30 pm
Location: Sevilla

Return to Utilities / Utilidades

Who is online

Users browsing this forum: No registered users and 6 guests