14 de noviembre de 2003

Números a letras en formato ORDINAL

Esta rutina sirve para convertir números a letras en formato ordinal.

Ejemplo:

1= primero
2= segundo
...
33=Trigesimo Tercero
...

Espero que les ayude esta rutina como me ayudo a mi.

Atte

Victor Jose Gil Salcedo
************************************
FUNCTION Numero2Ordinal(tnNro)
  IF NOT BETWEEN(tnNro,1,999)
    RETURN "ERROR"
  ENDIF
  LOCAL lnEnt, lcRet, lnUni, lnDec, lnCen
  lnEnt = INT(tnNro)
  lcRet = ''
  lcRet = ''
  lnUni = MOD(lnEnt,10)
  lnEnt = INT(lnEnt/10)
  lnDec = MOD(lnEnt,10)
  lnEnt = INT(lnEnt/10)
  lnCen = MOD(lnEnt,10)
  DO CASE
    CASE lnUni = 1
      lcRet = 'primero'
    CASE lnUni = 2
      lcRet = 'segundo'
    CASE lnUni = 3
      lcRet = 'tercero'
    CASE lnUni = 4
      lcRet = 'cuarto'
    CASE lnUni = 5
      lcRet = 'quinto'
    CASE lnUni = 6
      lcRet = 'sexto'
    CASE lnUni = 7
      lcRet = 'séptimo'
    CASE lnUni = 8
      lcRet = 'octavo'
    CASE lnUni = 9
      lcRet = 'noveno'
  ENDCASE
  DO CASE
    CASE lnDec = 1
      lcRet = 'décimo ' + lcRet
    CASE lnDec = 2
      lcRet = 'vigésimo ' + lcRet
    CASE lnDec = 3
      lcRet = 'trigésimo ' + lcRet
    CASE lnDec = 4
      lcRet = 'cuadragésimo ' + lcRet
    CASE lnDec = 5
      lcRet = 'quincuagésimo ' + lcRet
    CASE lnDec = 6
      lcRet = 'sexagésimo ' + lcRet
    CASE lnDec = 7
      lcRet = 'septuagésimo ' + lcRet
    CASE lnDec = 8
      lcRet = 'octogésimo ' + lcRet
    CASE lnDec = 9
      lcRet = 'nonagésimo ' + lcRet
  ENDCASE
  DO CASE
    CASE lnCen = 1
      lcRet = 'centésimo ' + lcRet
    CASE lnCen = 2
      lcRet = 'ducentésimo ' + lcRet
    CASE lnCen = 3
      lcRet = 'tricentésimo ' + lcRet
    CASE lnCen = 4
      lcRet = 'cuadrigentésimo ' + lcRet
    CASE lnCen = 5
      lcRet = 'quingentésimo ' + lcRet
    CASE lnCen = 6
      lcRet = 'sexacentésimo ' + lcRet
    CASE lnCen = 7
      lcRet = 'septingentésimo ' + lcRet
    CASE lnCen = 8
      lcRet = 'octingentésimo ' + lcRet
    CASE lnCen = 9
      lcRet = 'Nonigentésimo ' + lcRet
  ENDCASE
  RETURN lcRet
ENDFUNC
***********************************

No hay comentarios. :

Publicar un comentario