23 de septiembre de 2014

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

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

La función SYS(2015) y su inversa

Autor: Luis María Guayán

La función SYS(2015)

En Visual FoxPro, con la función SYS(2015), podemos devolver una cadena "única" de 10 caracteres que puede ser utilizada como nombre de procedimiento, función o archivo. Esta cadena comienza con un guión bajo "_" y continua con una combinación de 9 caracteres de números y letras, y se crea a partir de la fecha y de la hora del sistema. Si llamamos repetidamente a la función SYS(2015) devolverá una cadena de caracteres única por cada intervalo de milisegundos.

El formato de la cadena devuelta por SYS(2015) es el siguiente:

_DDDSSSSSS

en donde:

_: Caracter de guión bajo con el que comienza la cadena.

DDD: Es el número de días transcurridos desde el "01/01/00".La función SYS(2015) tiene dos curiosas caracteristicas:a. No tiene en cuenta la centuria, o sea que solo toma años entre 00 y 99b. Toma a todos los años de 367 días, o sea que para:1 de Enero del '00 = 12 de Enero del '00 = 2...1 de Enero del '01 = 368... etc.

SSSSSS: Es el número de segundos (con las milésimas, y sin la coma decimal) pasados desde la medianoche.

Por ejemplo si la función SYS(2015) nos devuelve la cadena "_08G12H0PC", esto corresponde a:

_: Caracter de guión bajo con el que comienza la cadena.

08G: Es el número de días transcurridos desde el "01/01/00" en años de "367 días"

12H0PC: Es el número de segundos pasados desde la medianoche, con las milésimas, y sin la coma decimal.

Pero como vemos, los valores devueltos no están en el sistema decimal (base 10) que todos conocemos. Estos valores están en un sistema de base 36, que toma los 10 dígitos numéricos y las 26 letras del alfabeto, o sea los 36 caracteres incluidos en los intervalos [0..9] y [A..Z].

La inversa de SYS(2015)

Para conocer entonces la inversa de la función SYS(2015), debemos cortar la cadena devuelta, transformar los valores en base 36 a base 10, calcular la fecha según el año y los días del año transcurridos desde el "01/01/xx" - 1, y calcular la hora según los segundos y milésimas devueltos.

Si cortamos y transformamos la cadena devuelta en el ejemplo "_08G12H0PC" al sistema decimal, el resultado es el siguiente:

08G -> 304 días transcurridos desde el "01/01/00"
Año = INT(304 / 367)
Días transcurridos del "Año"= MOD(304, 367)
12H0PC -> 64619,472 segundos -> 17:56:59,472

Con esto sabemos que la función SYS(2015) retornó el valor "_08G12H0PC" el día 30 de Octubre del '00 a las 17:56:59,472 horas.

La función en código VFP

A continuación se muestra el código de la función que retorna la inversa de SYS(2015). La función se llama Inv2015() e invoca a las funciones:

B36TOB10(): Convierte un valor en el sistema numérico de base 36, a un valor en el sistema numérico de base 10.

S2HMSm(): Convierte los segundos y milésimas pasados desde la medianoche a un formato HH:MM:SS,mmm.
*-------------------------------
* FUNCTION Inv2015(tcCadena)
*-------------------------------
* Función que invierte el retorno de SYS(2015)
* USO: Inv2015("_0AB0123AB")
* RETORNA: Caracter "DD/MM/AAAA HH:MM:SS.mmm"
*-------------------------------
FUNCTION Inv2015(tcCadena)
  LOCAL lnDia, lnAnio
  lnDia = B36TOB10(SUBS(tcCadena, 2, 3))
  lnAnio = INT(lnDia / 367)
  lnDia = MOD(lnDia, 367)
  SET STRICTDATE TO 0
  RETURN DTOC(EVAL("{^"+STR(lnAnio,2)+"/01/01}") ;
    + lnDia - 1) + " " ;
    + S2HMSm(B36TOB10(SUBS(tcCadena, 5, 6))/1000)
ENDFUNC

*-------------------------------
* FUNCTION B36TOB10(tcN36)
*-------------------------------
* Función que pasa un número de base 36 a base 10
* Usada por Inv2015()
* RETORNA: Numérico
*-------------------------------
FUNCTION B36TOB10(tcN36)
  LOCAL lnN10, lcChr, lnLen, lnI, lnAux
  tcN36 = ALLTRIM(UPPER(tcN36))
  lnLen = LEN(tcN36)

  lnN10 = 0
  lnI = 1
  FOR lnI = 1 TO lnLen
    lcChr = SUBS(tcN36, lnI, 1)
    lnAux = ASC(lcChr)-IIF(lcChr < 'A', 48, 55)
    lnN10 = lnN10 + lnAux * 36^(lnLen-lnI)
  ENDFOR
  RETURN INT(lnN10)
ENDFUNC

*-------------------------------
* FUNCTION S2HMSm(tnSeg)
*-------------------------------
* Transforma segundos a formato HH:MM:SS.mmm
* Usada por Inv2015()
* RETORNA: Caracter 'HH:MM:SS.mmm'
*-------------------------------
FUNCTION S2HMSm(tnSeg)
  LOCAL lnHor, lnMin, lnSeg, lnMil
  lnHor = INT(tnSeg/3600)
  lnMin = INT(((tnSeg - (lnHor*3600))/60))
  lnSeg = MOD(tnSeg, 60)
  lnMil = (tnSeg - INT(tnSeg))*1000
  RETURN TRANSFORM(lnHor, "@L 99") + ":" + ;
    TRANSFORM(lnMin, "@L 99") + ":" + ;
    TRANSFORM(lnSeg, "@L 99") + "." + ;
    TRANSFORM(lnMil, "@L 999")
ENDFUNC

*-------------------------------
Notas finales

Conocer la inversa de la función SYS(2015), nos puede ser útil cuando guardamos la cadena retornada en un campo de una tabla al grabar o modificar un registro, o para saber cuando se creó un archivo que almacenamos con el nombre devuelto con SYS(2015).

El único problema de conocer la inversa de la función SYS(2015) es que no conocemos la centuria. La función Inv2015() tomará los valores actuales de SET CENTURY y ROLLOVER de VFP, para evaluar por ejemplo: {^00/01/01} ó {^99/01/01}.

22 de septiembre de 2014

Escribir mejor código (Parte 3)

Artículo original: Writing better code (Part 3)
http://weblogs.foxite.com/andykramek/archive/2006/03/20/1308.aspx
Autor: Andy Kramek
Traducido por: Ana María Bisbé York

En el tercer artículo de esta serie voy a hablar sobre Procedimientos y Funciones. Visual FoxPro, como sus ancestros FoxPro y FoxBase admite dos tipos diferentes de declaración y llamada de código.

Crear un procedimiento

Un procedimiento es sencillamente un bloque de código que es llamado por un nombre. Puede; pero no se requiere, que acepte uno o más parámetros y la razón para la creación de un procedimiento, es evitar la necesidad de escribir el mismo código muchas veces. Los procedimientos son llamados empleando el comando DO, y, de forma predeterminada, todos los parámetros se pasan por referencia. Por tanto no existe la necesidad de tener valores de retorno en los procedimientos - pueden modificar cualquier valor y el código llamado que lo pasa.

He aquí un ejemplo sencillo del tipo de código que podría estar en un procedimiento. Todo lo que hace es aceptar un número de registro y Alias de tabla. Valida que el número de registro es válido en el contexto de una tabla específica y, si es así, mueve el puntero de registro. Si falla algo, o si no es válido, se genera un error:
********************************************************************
*** Nombre.....: GOSAFE
*** Autor...: Andy Kramek & Marcia Akins
*** Fecha.....: 03/20/2006
*** Aviso...: Copyright (c) 2006 Tightline Computers, Inc
*** Compilador.: Visual FoxPro 09.00.0000.3504 for Windows 
*** Función.: Si el registro especificado es válido para el alias 
*** ........: especificado va hasta el, de lo contrario genera un error
********************************************************************
PROCEDURE gosafe
  PARAMETERS tnRecNum, tcAlias
  TRY
    *********************************
    *** Comprobación de los parámetros
    *********************************
    *** Debemos recibir un número de registro!
    IF VARTYPE( tnRecNum ) # "N" OR EMPTY( tnRecNum )
      ERROR "Debe pasar un número de registro a GoSafe" 
    ENDIF
    *** Si no se ha especificado un alias, asume el alias actual
    lcAlias = IIF( VARTYPE( tcAlias ) # "C" OR EMPTY( tcAlias ), ;
      LOWER( ALIAS()), LOWER( ALLTRIM( tcAlias )) )
    IF EMPTY( lcAlias ) OR NOT USED( lcAlias )
      *** No hay tabla!
      ERROR "Debe especificar, o seleccionar una tabla " + ;
        "abierta al llamar a GoSafe"
    ENDIF
    *********************************
    *** Verifica que el número de registro es válido para el alias
    *********************************
    IF BETWEEN( tnRecNum, 1, RECCOUNT( lcAlias ) )
      *** Este está bien
      GOTO (tnRecNum) IN (lcAlias)
    ELSE
      *** No, el número de registro no es bueno
      ERROR "El registro " + TRANSFORM( tnRecNum ) + ;
        " no es válido para la tabla " + lcAlias
    ENDIF 
  CATCH TO loErr
    MESSAGEBOX( loErr.Message, 16, "GoSafe ha fallado" )
  ENDTRY
  RETURN
ENDPROC
Para llamar al procedimiento utilizamos
SET PROCEDURE TO procfile ADDITIVE
*** Guarda el puntero de registro en Account
lcOldAlias = ‘account’
lnOldRec = RECNO( lcOldAlias )
<<más código aquí>>
*** Restaura el puntero de registro
DO GoSafe WITH lnOldRec, lcOldAlias
Este procedimiento en particular no modifica nada y de hecho (como todos los métodos, funciones y procedimientos de VFP) en realidad devuelve .T. No hay necesidad, o incluso posibilidad de capturar ese valor. Vea que si desea pasar valores a un procedimiento por valor, en lugar de por referencia, entonces tenemos que pasarlos como valores reales y no como variables (Si, podríamos incluso cambiar la configuración de UDFPARMS pero no está recomendado, porque tiene otros efectos colaterales no deseados. Además, utilizar una solución global para un tema local es generalmente una mala idea). Entonces, para pasar un registro de número, "por valor" a este procedimiento podríamos utilizar:
DO GoSafe WITH INT( lnOldRec ), lcOldAlias

Crear una función

El otro método para llamar a código es crear una función. La diferencia básica entre un procedimiento y una función es que la función SIEMPRE devuelve un valor y por tanto siempre que llame a una función, ya sea una función nativa o una propia, siempre debe verificar los resultados. Las funciones se llaman finalizándolas con dos paréntesis. Como los procedimientos, las funciones pueden aceptar uno o más parámetros; pero a diferencia de los procedimientos, los parámetros pasados a las funciones son, de forma predeterminada, pasados por valor. La consecuencia es que esta funciones no modifican los valores en el código que los llama. (Si, esto es un comportamiento exactamente opuesto al comportamientos de los procedimientos). Veamos una sencilla función que devuelve el tiempo como una cadena de caracteres después de unos segundos.
********************************************************************
*** Nombre.....: GETTIMEINWORDS
*** Autor...: Andy Kramek & Marcia Akins
*** Fecha.....: 03/20/2006
*** Aviso...: Copyright (c) 2006 Tightline Computers, Inc
*** Compilador.: Visual FoxPro 09.00.0000.3504 for Windows 
*** Función.: Devolver la cantidad de Días/Horas y minutos a 
*** ........: partir de una cantidad en segundos
*** Valor devuelto.: Cadena de caracteres
********************************************************************
FUNCTION GetTimeInWords( tnElapsedSeconds, tlIncludeSeconds )
  LOCAL lcRetval, lnDays, lnHrs, lnMins
  *** Inicializa las variables
  STORE '' TO lcRetval
  STORE 0 TO lnDays, lnHrs, lnMins*** Handle the Days first
  lnDays = INT( tnElapsedSeconds / 86400 )
  IF lnDays > 0
    lcRetVal = PADL( lnDays, 3 ) + ' Days '
  ENDIF
  *** Calcula las horas
  lnHrs = INT(( tnElapsedSeconds % 86400 ) / 3600 )
  IF lnHrs > 0
    lcRetVal = lcRetVal + PADL( lnHrs, 2, '0' ) + ' Hrs '
  ENDIF
  *** Ahora los minutos
  lnMins = INT(( tnElapsedSeconds % 3600 ) / 60 )
  *** Verifica los segundos
  IF tlIncludeSeconds
    *** Si deseamos los segundos, los agrega explícitamente
    lcRetVal = lcRetVal + PADL( lnMins, 2, '0') + ' Min ' 
    lcRetVal = lcRetVal + PADL( INT( tnElapsedSeconds % 60 ), 2, '0' )+' Sec '
  ELSE
    *** Redondea por exceso los minutos UP Si >= 30 segundos
    lnMins = lnMins + IIF( INT( tnElapsedSeconds % 60 ) >= 30, 1, 0 )
    lcRetVal = lcRetVal + PADL( lnMins, 2, '0') + ' Min ' 
  ENDIF
  RETURN lcRetVal
ENDPROC