Hexadecimal a Binario

Función que transforma un número hexadecimal en binaro.

? Hex2Bin("123ABC")

FUNCTION Hex2Bin(tcHex)
  LOCAL lcRet, lnDec, lnI
  lcRet = ""
  FOR lnI = 1 TO LEN(ALLTRIM(tcHex))
    lnDec = EVALUATE("0x"+SUBSTR(tcHex,lnI,1))
    lcRet = lcRet + ;
      IIF(BITTEST(lnDec,3),"1","0") + IIF(BITTEST(lnDec,2),"1","0") + ;
      IIF(BITTEST(lnDec,1),"1","0") + IIF(BITTEST(lnDec,0),"1","0")
  ENDFOR
  RETURN lcRet
ENDFUNC

NOTA: Otra forma mas directa de pasar un número Hexadecimal a Decimal:

? EVALUATE("0x" + "123ABC")

Luis María Guayán

Número de semana

A pesar de que existe la función nativa WEEK() que retorna el número de la semana del año, esta no satisfacía una necesidad que se me presentó, por lo que elaboré la función SEMANA() y su inversa.

Mi necesidad, era la de agrupar una consulta de todo un año, por el número de la semana. Aunque en la función WEEK() se puede especificar por ejemplo si la primer semana del año contiene el 1° de Enero, y cual será el primer día de la semana; ésta puede retornar el mismo valor para la primer semana de Enero como para la última semana de Diciembre, lo que me causaba un problema en el agrupado de mi consulta.

*-- Ejemplo de WEEK()
? WEEK(DATE(2004,1,2),1,1) && Primer semana de Enero de 2004
? WEEK(DATE(2004,12,29),1,1) && Ultima semana de Diciembre de 2004

La diferencia de la función WEEK() con la función SEMANA(), es que ésta última no retorna resultados repetidos para los meses de Enero y Diciembre.

*-- Ejemplo de SEMANA()
? SEMANA(DATE(2004,1,2),1) && Primer semana de Enero de 2004
? SEMANA(DATE(2004,12,29),1) && Ultima semana de Diciembre de 2004

A continuación, el código de las funciones SEMANA() e INVSEMANA(), ejemplos de uso y las diferencias entre WEEK() y SEMANA().

*-- Diferencias entre WEEK() y SEMANA()
ld = DATE(2004,12,15)
FOR ln = 1 TO 30
  ? ld, WEEK(ld,1,1), Semana(ld,1)
  ld = ld + 1
ENDFOR

*-- Ejemplo de INVSEMANA()
FOR ln = 1 TO 7
  ld = InvSemana(3,2005,ln,1)
  ? ld, CDOW(ld)
ENDFOR  

*------------------------------------------------------------
* FUNCTION Semana(tdFecha, tnPriDiaSem)
*------------------------------------------------------------
* Retorna el número de semana de una Fecha
* USO: Semana(DATE(2004,06,03),2)
* PARAMETROS:
*    tdFecha     = Fecha
*    tnPriDiaSem = Primer día de la semana (1=Domingo, ..., 7=Sábado)
* RETORNO: Numérico
*------------------------------------------------------------
FUNCTION Semana(tdFecha, tnPriDiaSem)
  IF EMPTY(tdFecha)
    RETURN 0
  ENDIF
  IF EMPTY(tnPriDiaSem)
    tnPriDiaSem = 1
  ENDIF
  RETURN INT((tdFecha - DATE(YEAR(tdFecha),1,1) + ;
    7 - DOW(tdFecha,tnPriDiaSem)) / 7) + 1
ENDFUNC

*------------------------------------------------------------
* FUNCTION InvSemana(tnSemana, tnAnio, tnNroDiaSem, tnPriDiaSem)
*------------------------------------------------------------
* Retorna una fecha a partir de un número de semana
* USO: InvSemana(23,2004,5,2)
* PARAMETROS:
*    tnSemana    = Número de semana
*    tnAnio      = Año de la semana
*    tnNroDiaSem = Número del día de la semana (1=Domingo, ..., 7=Sábado)
*    tnPriDiaSem = Primer día de la semana (1=Domingo, ..., 7=Sábado)
* RETORNO: Fecha
*------------------------------------------------------------
FUNCTION InvSemana(tnSemana, tnAnio, tnNroDiaSem, tnPriDiaSem)
  IF EMPTY(tnAnio)
    tnAnio = YEAR(DATE())
  ENDIF
  IF EMPTY(tnNroDiaSem)
    tnNroDiaSem = 1
  ENDIF
  IF EMPTY(tnPriDiaSem)
    tnPriDiaSem = 1
  ENDIF
  RETURN DATE(tnAnio,1,1) + (tnSemana * 7) - 7 + ;
    tnNroDiaSem - DOW(DATE(tnAnio,1,1),tnPriDiaSem)
ENDFUNC
*------------------------------------------------------------

Hasta la próxima.

Luis María Guayán

Saber si existe un campo en una tabla

Con esta función podemos comprobar si existe un campo en una tabla.

Ejemplo:

? ExisteCampo("MiCampo","MiTabla")

FUNCTION ExisteCampo(tcCampo,tcTabla)
  LOCAL la(1)
  AFIELDS(la,tcTabla)
  RETURN ASCAN(la,tcCampo,1,0,1,15) # 0
ENDFUNC

Luis María Guayán

Relacionar formularios con contenido de Ayuda - HTML Help WorkShop

Resumen de qué debemos hacer para relacionar los objetos de nuestra aplicación con el archivo de Ayuda compilado con HTML Help WorkShop.

1. Debes crear un archivo de alias, donde asignes un nombre lógico a cada
archivo de tópico:

MIAYUDA.ALI
IDH_TOPICO1=topico1.htm
IDH_TOPICO2=topico2.htm
...

2. Debes crear un archivo de cabecera que asigne un TopicID a cada tópico,
usando los nombres lógicos que definiste en el archivo anterior:

MIAYUDA.H
#define IDH_TOPICO1 1
#define IDH_TOPICO2 2
...

3. En el HTML Help WorkShop, pulsa el botón "HtmlHelp API Information", y en
la sección Map incluye el archivo .H, mientras que en la sección Alias
incluyes el archivo .ALI. También puedes hacerlo directamente, modificando
el archivo HHP:

[MAP]
#include miayuda.h

[ALIAS]
#include miayuda.ali

4. Recompilas el archivo de ayuda. Con el comando Set Help de VFP indicas el archivo de ayuda compilado (chm).

Una vez hecho esto, todo lo que tienes que hacer es colocar el valor deseado
en la propiedad HelpContextID de cualquier objeto de VFP que lo soporte.

Saludos

Victor Espina

Obtener la hora del sistema local en formato de 12 horas (AM/PM)

Por diseño, la función TIME() devuelve la hora del sistema local en formato de 24 horas, pero si deseas mostrarla en formato de 12 (AM/PM) hay que hacer algunos pasitos más, aquí te mostramos una función para realizarlo.

La siguiente función se hace necesaria debido a que la función Time() (nativa de VFP) no se ve afectada por la configuración de SET HOURS, la función TTOC() actúa diferente...

*********************************************************
* Function......: GetTime
* Description...: Get the current time of the local machine with 12 hours format (AM/PM)
* Parameters....: none
* Returns......: Character [11 bytes len]
* Date.........: 28-June-2004
* Autor.........: Esparta Palma    esparta[arroba]softhome.net
* Comments...: To get the time with 24 hours, use native VFP Time() function.
*********************************************************
Function GetTime
    LOCAL lcOldHours,;    && Last Hours setting
          lcRetValue       &&Return Value

    *** Save last setting of hours
    lcOldHours = SET("HOURS")
    *** Set the new Hours setting 12 hours (AM/PM)
    SET HOURS TO 12
    *** Get the time of the current Datetime
    lcRetValue = TTOC(DATETIME(),2)
    *** Set the hours setting to the saved setting
    SET HOURS TO &lcOldHours
    RELEASE lcOldHours
    Return lcRetValue
EndFunc

Espero les sea de utilidad.

Espartaco Palma

Redondear a 5 centavos por arriba

Esta función es muy útil para establecimientos donde las monedas de centavos ya no se usan tan frecuentemente y/o por comodidad se cobra 5 centavos arriba, es decir: $145.02 se convierte en $145.05, $145.07 se convierte en $145.10.

function redondeoacincocentimos
  lparameters m.nValor
  return ceiling(m.nvalor * 20) / 20
endfunc

Carlos Yohn Zubiria