31 de mayo de 2005

Grid con múltiples colores

Los Grids de Visual FoxPro tienen la capacidad de cambiar de color sus filas, aquí te presentamos una forma en que puede darle más capacidad.

Los ejemplos que vienen con la documentación de la ayuda en el método SetAll muestran cómo hacer cambiar las filas basándose en la ejecución sencilla de un IIF (If inmediato) como por ejemplo:

Thisform::Init
*** Alternar columnas entre blanco y verde ***
Thisform.MyGrid.SetAll("DynamicBackColor", ;
  "IIF(MOD(RECNO( ), 2)=0, RGB(255,255,255), RGB(0,255,0))", ;
  "Column") 

Hasta aqui puede ser sencillo, pero que tal si deseas tener mas de 2 o 3 colores?, o si es un número finito de posibles colores?, la solución es mandar a ejecutar una función o método que haga lo propio.

Un ejemplo de uso, un form donde se colorean las lineas del grid de acuerdo a la edad de la persona:
Public oForm
oForm = Createobject("myForm")
oForm.Show()

Define Class myForm As Form
  DataSession = 2
  Height = 400
  Width = 600

  Add Object myGrid As Grid With ;
    Height = 400, Width = 600, RecordSource="employee"

  Procedure Load
    OPEN DATABASE (HOME(2)+"\data\testdata.DBC")
    Use employee
  Endproc

  Procedure Init
This.MyGrid.SetAll("DynamicBackColor","Thisform.MyColorByYear(birth_date)","Column")
  Endproc

PROCEDURE myColorbyYear
   LPARAMETERS tdBirthDate
      lnColor = 0xFFFFFF && Blanco por default
      lnAnnios = YEAR(DATE())-YEAR(tdBirthDate)

      DO CASE
        CASE BETWEEN(lnAnnios,20,40)
            lnColor = RGB(100,100,150)
        CASE BETWEEN(lnAnnios,41,45)
            lnColor = RGB(255,255,0)
        CASE BETWEEN(lnAnnios,46,50)
            lnColor = RGB(255,100,0)
        CASE BETWEEN(lnAnnios,51,60)
            lnColor = RGB(255,0,0)
        CASE BETWEEN(lnAnnios,61,90)
            lnColor = RGB(0,255,0)
      ENDCASE

      RETURN lnColor
ENDPROC

  PROCEDURE Unload
     CLOSE TABLES ALL
     CLOSE DATABASES ALL
  ENDPROC

Enddefine



En este caso está establecido a sólo 5 colores, pero podría llevarse hasta el caso en que se utilice una tabla auxiliar donde se tengan almacenados estos datos, para de esta forma darle aún más dinamicidad a esta función.

Espero les sea de utilidad.

Espartaco Palma Martínez

24 de mayo de 2005

Simular un Botón con un Contenedor

Aquí una clase derivada de un objeto Contenedor que simula un Botón de Comandos y permite estas características.

En el siguiente ejemplo vemos la forma de simular un Botón de Comandos con un objeto Contenedor que imita el comportamiento del evento Click y permite colorear su fondo y distribuir a gusto una imagen y una etiqueta contenidas en él.
PUBLIC oForm
oForm = CREATEOBJECT("MiForm")
oForm.SHOW(1)

DEFINE CLASS MiForm AS FORM
  AUTOCENTER = .T.
  CAPTION = "Simular un Botón con un Contenedor"
  ADD OBJECT MiBoton AS MiBoton
ENDDEFINE

DEFINE CLASS MiBoton AS CONTAINER
  TOP = 90
  LEFT = 90
  HEIGHT = 50
  WIDTH = 200
  SPECIALEFFECT = 0
  BACKCOLOR = RGB(255,255,0)
  NAME = "Container1"
  ADD OBJECT Image1 AS IMAGE WITH ;
    TOP = 10, ;
    LEFT = 10, ;
    HEIGHT = 25, ;
    WIDTH = 25, ;
    NAME = "Image1", ;
    PICTURE = (HOME(1)+"Fox.bmp")
  ADD OBJECT Label1 AS LABEL WITH ;
    FONTSIZE = 14, ;
    BACKSTYLE = 0, ;
    CAPTION = "Presioname!!!", ;
    TOP = 15, ;
    LEFT = 50, ;
    AUTOSIZE = .T., ;
    NAME = "Label1"
  PROCEDURE CLICK
    MESSAGEBOX("Click del Botón",64,"Aviso")
  ENDPROC
  PROCEDURE MOUSEUP
    LPARAMETERS nButton, nShift, nXCoord, nYCoord
    IF nButton = 1
      THIS.LEFT = THIS.LEFT - 1
      THIS.TOP = THIS.TOP - 1
    ENDIF
  ENDPROC
  PROCEDURE MOUSEDOWN
    LPARAMETERS nButton, nShift, nXCoord, nYCoord
    IF nButton = 1
      THIS.LEFT = THIS.LEFT + 1
      THIS.TOP = THIS.TOP + 1
    ENDIF
  ENDPROC
  PROCEDURE Image1.MOUSEDOWN
    LPARAMETERS nButton, nShift, nXCoord, nYCoord
    THIS.PARENT.MOUSEDOWN(nButton, nShift, nXCoord, nYCoord)
  ENDPROC
  PROCEDURE Image1.MOUSEUP
    LPARAMETERS nButton, nShift, nXCoord, nYCoord
    THIS.PARENT.MOUSEUP(nButton, nShift, nXCoord, nYCoord)
  ENDPROC
  PROCEDURE Image1.CLICK
    THIS.PARENT.CLICK
  ENDPROC
  PROCEDURE Label1.MOUSEUP
    LPARAMETERS nButton, nShift, nXCoord, nYCoord
    THIS.PARENT.MOUSEUP(nButton, nShift, nXCoord, nYCoord)
  ENDPROC
  PROCEDURE Label1.MOUSEDOWN
    LPARAMETERS nButton, nShift, nXCoord, nYCoord
    THIS.PARENT.MOUSEDOWN(nButton, nShift, nXCoord, nYCoord)
  ENDPROC
  PROCEDURE Label1.CLICK
    THIS.PARENT.CLICK
  ENDPROC
ENDDEFINE
Luis María Guayán

23 de mayo de 2005

Personalizar Intellisense - II

Artículo original: Customizing Intellisense - II
http://weblogs.foxite.com/andykramek/archive/2005/04/10/356.aspx 
Autor: Andy Kramek
Traducido por: Ana María Bisbé York


La semana pasada comencé la discusión de la funcionalidad de Intellisense hablando de la configuración de Intellisense y cómo controlar algunas de sus características. La tabla foxcode.dbf es el propio corazón de la funcionalidad de Intellisense en VFP y entender cómo está construida y cómo es utilizada es la clave para el uso completo del poder de Intellisense. Entonces, aun con el riesgo de duplicar información que existe en el fichero de ayuda de Visual FoxPro, he aquí la estructura y una pequeña explicación de cómo es utilizada cada columna por el motor de Intellisense.

Tabla 1: Estructura de la tabla FoxCode

Campo Definición Descripción
Type C (1) Identificador que define cómo deben ser procesados los registros:
C (Comando) Auto-completar Desencadenado por " "
F (Función) Elementos de información rápida. Desencadenado por "("
O (COM) El tipo de biblioteca a utilizar al llenar la lista de miembros para las declaraciones "DEFINE AS" para objetos COM
P (Propiedad) Define acciones cuando se accede a una propiedad
S (Script) Ejecuta el Script en el campo Data
T (Type) El contenido a utilizar en la lista de miembros para declaraciones "DEFINE AS" o para objetos que no tengan biblioteca tipo
U (Usuario) Definido por el usuario
V(Versión) Reservado para la información predeterminada de la versión
Z(Especial) No tiene una interpretación automática, define un comportamiento de usuario.
Abbrev C (24) Cadena abreviada para desencadenar una acción determinada
Expanded C (26) La cadena a sustituir la abreviada, cuando es apropiado
Cmd C (15) Nombre del script a ejecutar para este registro. Se encierra entre "{}"
Tip M ( 4) Contenido a mostrar como Quick Tip
Data M ( 4) Guarda cualquier contenido para este registro (Lista de valores, código, texto script, etc
Case C (1) Especifica cómo es el formato del texto expandido para sustituir el texto abreviado
U - Utiliza la función Upper() para el formato
L - Utiliza la función Lower() para el formato
P - Utiliza la función Proper() para el formato
M ó <vacío> No se aplica formato
X No se aplica sustitución
Nota: El valor especificado en el registro Version define el valor predeterminado a utilizar por cualquier registro que no tenga su propia configuración.
Save L (1) Indicador que determina si el registro se preserva durante las actualizaciones (Falso para elementos nativos)
TimeStamp T (8) Marca de tiempo, (sólo para elementos VFP)
Source M ( 4) La fuente a utilizar para el registro contenido (Los elementos nativos utilizan "Reservado")
UniqueID C (10) Identificador único (sólo para elementos VFP)
User M ( 4) Disponible para cualquier información definida por el usuario que sea necesaria

La ficha Advanced del formulario Administrador de Intellisense incluye opciones para recuperar la tabla FoxCode. Esto significa que si la tabla se daña, si ha eliminado, o modificado inadvertidamente cualquier entrada crítica, puede sencillamente restablecer l tabla a su estado original. Lo bueno aquí es que la restauración se realiza de forma que no se eliminan los registros de usuario. Los campos TimeStamp, UniqueID y Save se utilizan al actualizar o recuperar la tabla FoxCode para determinar el origen de la tabla y si puede ser sobre-escrita. De forma predeterminada, las entradas nativas de VFP tienen marca de tiempo y un ID único; pero su campo Save se establece en Falso para que puedan ser sobre-escritos. Las entradas definidas por el usuario, por otra parte, no tienen un ID único o marca de tiempo; pero su campo Save tiene valor .T., así que cuando se actualice la tabla, o se refresque, se conservan los elementos definidos por el usuario.

¿Cómo se utilizan los registros de FoxCode?

Cada uno de los tipos de registro tienen un conjunto de funcionalidades muy específicas asociadas con el, y los diferentes tipos indican cómo los campos son interpretados por el motor de Intellisense.

Registro Versión (Type = 'V')

Existe sólo uno y tiene la intención de ser utilizado sólo internamente por Visual FoxPro. El campo Expanded contiene el número de versión para la tabla actual FoxCode y el campo Case define el valor predeterminado para cualquier elemento que no tenga un valor configurado.

Registro Comando (Type = 'C')

Este tipo es utilizado para definir texto autocompletado, que se desencadena por la tecla espaciadora y que emplea "Default Script", que fue definido en el campo Data del registro con Type = S y el campo Abbrev vacío. Todos lo comandos nativos utilizan esta metodología. Sin embargo, puede crear además sus propios "comandos" que asocien explícitamente Quick Info (del campo Tip) o una lista de miembros (del campo Data) al definir una abreviatura e incluir una llamada al Script controlador del comando (command handler script) ({cmdhandler}) en el campo Cmd.

Registro Función (Type = 'F')

Este tipo es utilizado para definir la acción de auto-completar texto que es desencadenada por el carácter paréntesis izquierdo "(". En este tipo de registro el contenido del campo Tip es utilizado para mostrar la información rápida "inteligente" que incluyen los parámetros de entrada que corresponde al texto que se  escribió al definir el registro).

Registro Propiedad (Type = 'P')

Este tipo es utilizado para asignar un diálogo pop-up (o lista de valores) para mostrar cuando un valor es asignado a la propiedad cuyo nombre coincida con la entrada del campo Abbrev. El campo Cmd se utiliza para indicar si hay un script definido en algún otro lugar de la tabla, o el contenido para el campo Data en el registro actual, para ser utilizado por el registro actual para generar la lista. En la versión 9.0 la tabla FoxCode salió con varios scripts genéricos que son utilizados con este tipo de registro. Por ejemplo, un script (llamado {color}) muestra el diálogo de selección de colores y lo asocia con varias propiedades de definición de colores, (por ejemplo: "BackColor", "BorderColor" y "FillColor"). Otro caso (llamado {picture}) muestra el diálogo para seleccionar imagen cuando se signa un valor a las propiedades "Icon" o "Picture" y existen además, scripts para {Font} y {MemberClassLib}.

Registro Componente COM (Type = 'O')

Este tipo se utiliza para definir, el motor de Intellisense, el tipo de biblioteca para un componente COM (o control ActiveX). El campo Data es utilizado para guardar la información del GUID (y la versión), y el campo Tip para guardar el nombre completo del control. El contenido del campo Abbrev es incluido en la lista desplegable de objetos asociados con la cláusula AS (DEFINE CLASS…AS…, LOCAL…AS… ). Sin embargo, la forma más sencilla de agregar un objeto COM a la tabla, es utilizar el Administrador de IntelliSense que viene con VFP porque así se evita la necesidad de estar buscando en los registros el GUID y los IDs de clases.

Registro Type (Type = 'T')

Este tipo se utiliza para definir una entrada para la lista de una cláusula AS. La diferencia entre este tipo y el precedente 'O', es que aquí no hay tipo de librería asociada con este tipo de registro. Por tanto, las clases de usuario pueden ser agregadas a la lista desplegable por el comando DEFINE CLASS. El contenido del campo Data se muestra directamente en la lista desplegable y es el único campo que necesita ser completado. Sin embargo, nosotros no recomendamos agregar una descripción al campo Abbrev para seguir manteniendo la tabla fácilmente, y si agrega texto al campo tip va a ser mostrado cuando se desplace por la lista de entrada.

Registro Usuario (Type = 'U')

Este tipo de registro se utiliza para identificar abreviaturas para contenido definido por el usuario. Difiere del tipo Commando en que sustituye el contenido del campo Abbrev con el contenido del campo Expanded. En lugar de sólo completar el texto, en realidad lo substituye - es más una macro de teclado que un auto-completar. No es necesario tener el texto expandido relacionado con la abreviatura que lo expande.Puede además, asociar un script con el registro User Type al incluir llaves vacías  ("{}") en el campo Cmd. Esto indica al motor de Intellisense que el campo Data de los registros contiene código script que debe ser ejecutado.

Registro Script (Type = 'S')

Este tipo es utilizado para guardar código llamado script que puede ser ejecutado por el motor de Intellisense. Para crear un script, todo lo que se necesita es el nombre en el campo Abbrev y un código en el campo Data. Otros registros pueden desencadenar la ejecución de estos scripts incluyendo el nombre (encerrados entre llaves "{}") en su campo Cmd. Mientras el tipo "S" es utilizado para crear script genéricos que pueden ser utilizados por más de una entrada cualquier tipo de registro (con la excepción de registros tipo "T" y "O") pueden incluir un script en su propio campo Data. Sin embargo, para ejecutar ese script, un par de llaves vacías "{}" deben ser insertadas en el campo Cmd.

Registro Extensión de usuario (Type = 'Z')

Este tipo no está recogido en la documentación y está reservado para los registros que Intellisense no procesa automáticamente. Existen dos predeterminados: el primero, "CustomPEMs"  está utilizado para guardar la configuración "avanzada" de la propiedad. La columna Tip contiene el texto para mostrar en el Administrador de Intellisense, mientras la columna Data contiene la configuración como una lista de pares atributo = valor. El segundo, llamado "CustomDefaultScripts"  es utilizado para listar los script que son llamados por el controlador de script predeterminado (por ejemplo, la barra espaciadora). Los scripts llamados en este campo se activan sólo, cuando el valor de la propiedad "lAllowCustomDefScripts" es .T.

Extensión MemberData (Type = 'E')

Se introdujo en la versión 9.0. Este tipo es utilizado para indicar que los datos asociados son concernientes con la extensibilidad ofrecida por MemberData. Para más información sobre  memberdata ver el archivo de ayuda de VFP 9.0

La próxima vez veremos cómo crear acciones personalizadas con IntelliSense y cómo se emplean en Visual FoxPro los diferentes tipos de registros.


20 de mayo de 2005

Buscar texto en un Cuadro de Edición (EditBox)

Una manera de como buscar un texto en un cuadro de edición con la función AT() y las propiedades SelStart y SelLength del control EditBox.

Para ver el ejemplo ejecute el siguiente código:
*-- Creo un archivo de texto
SET SAFETY OFF
LOCAL lc
TEXT TO lc NOSHOW
Este es un texto tomado de un archivo de
texto, para buscar una palabra y remarcarla
si la encuentra.

Escriba en el cuadro de texto una palabra
que se encuentre aquí y haga click en el
botón Buscar.

Visual FoxPro. Nada corre como un zorro.
ENDTEXT
STRTOFILE(lc,"MiTxt.txt")
*-- Creo el formulario
PUBLIC goForm
goForm = CREATEOBJECT("Form1")
goForm.SHOW

DEFINE CLASS Form1 AS FORM
  CAPTION = "Ejemplo de búsqueda en un EditBox"
  NAME = "Form1"
  ADD OBJECT Text1 AS TEXTBOX WITH ;
    HEIGHT = 24, ;
    LEFT = 24, ;
    TOP = 12, ;
    NAME = "Text1"
  ADD OBJECT Command1 AS COMMANDBUTTON WITH ;
    HEIGHT = 24, ;
    TOP = 12, ;
    LEFT = 144, ;
    CAPTION = "Buscar", ;
    NAME = "Command1"
  ADD OBJECT Edit1 AS EDITBOX WITH ;
    HEIGHT = 180, ;
    LEFT = 24, ;
    TOP = 48, ;
    WIDTH = 300, ;
    NAME = "Edit1"
  PROCEDURE INIT
    THISFORM.Edit1.VALUE = FILETOSTR("MiTxt.txt")
  ENDPROC
  PROCEDURE Command1.CLICK
    LOCAL lcBusca, lnPos, lnLen
    lcBusca = ALLTRIM(THISFORM.Text1.VALUE)
    lnLen = LEN(lcBusca)
    lnPos = AT(lcBusca,THISFORM.Edit1.VALUE)
    IF lnPos > 0
      THISFORM.Edit1.SELSTART = lnPos - 1
      THISFORM.Edit1.SELLENGTH = lnLen
      THISFORM.Edit1.SETFOCUS
    ELSE
      MESSAGEBOX("No se encuentra",64,"Aviso")
    ENDIF
  ENDPROC
ENDDEFINE
Luis María Guayán

19 de mayo de 2005

Agregar el item "Todos" a un ComboBox

Con el siguiente truco podemos retornar un registro adicional en nuestro SELECT para ser utilizado como ControlSource de un ComboBox.

Con una sentencia SELECT y la cláusula UNION podemos añadir el registo <Todos> para ser mostrado en un control ComboBox:
OPEN DATABASE (HOME(2) + "Tastrade\Data\Tastrade")

SELECT PADR("<Todos>",20) AS Last_Name ;
  FROM Employee ;
  WHERE RECNO() = 1 ;
  UNION ALL ;
  SELECT Last_Name ;
  FROM Employee ;
  INTO CURSOR MiCursor
El siguiente código es un formulario de ejemplo con un ComboBox con el agregado del Item <Todos>:
OPEN DATABASE (HOME(2) + "Tastrade\Data\Tastrade")
PUBLIC oForm
oForm = CREATEOBJECT("miform")
oForm.SHOW
RETURN

DEFINE CLASS MiForm AS FORM
  DOCREATE = .T.
  CAPTION = "Ejemplo de ComboBox"
  NAME = "frmMiForm"
  ADD OBJECT cbomicombo AS ComboBox WITH ;
    ROWSOURCETYPE = 3, ;
    ROWSOURCE = [SELECT PADR("<Todos>",30) AS Nombre ] + ;
    [FROM Employee WHERE RECNO() = 1 UNION ALL ] + ;
    [SELECT PADR(RTRIM(First_Name) + " " + Last_Name,30) AS Nombre ] + ;
    [FROM Employee ORDER BY Nombre INTO CURSOR curEmp ], ;
    HEIGHT = 24, ;
    LEFT = 56, ;
    STYLE = 2, ;
    TOP = 32, ;
    WIDTH = 264, ;
    NAME = "cboMiCombo"
  PROCEDURE INIT
    THISFORM.cboMiCombo.VALUE = 1
  ENDPROC
ENDDEFINE
Luis María Guayán

11 de mayo de 2005

Renombrar un DBC

A continuación un código para automatizar el cambio de nombre de los archivos contenedores de bases de datos (DBC) de Visual FoxPro. Cortesía de Çetin Basöz, MVP de VFP.
RenDBC('testnew','testdata')

Function RenDbc
lparameters OldName, NewName
Open data (oldName)
lnTables=adbobject(arrTables,'TABLE')
For ix=1 to lnTables
  lcTable = arrTables[ix]+'.DBF'
  handle=fopen(lcTable,12)
  =fseek(handle,8,0)
  lnLowByte = asc(fread(handle,1))
  lnHighByte = asc(fread(handle,1))*256
  lnBackLinkstart = lnHighByte + lnLowByte - 263
  =fseek(handle,lnBackLinkstart,0)
  Fwrite(handle,forceext(newName,'dbc')+replicate(chr(0),263),263)
  =fclose(handle)
Endfor
Close data all
Rename (forceext(oldName,'dbc')) to (forceext(newName,'dbc'))
Rename (forceext(oldName,'dcx')) to (forceext(newName,'dcx'))
Rename (forceext(oldName,'dct')) to (forceext(newName,'dct'))
Çetin Basöz

2 de mayo de 2005

Fecha y hora de un Servidor

Con esta función podemos tomar la fecha y hora de un servidor Windows NT o superior, desde Visual FoxPro, con funciones de la API de Windows.
? ServerTime("\\MiServidor")

*----------------------------------------------------
* FUNCTION ServerTime(tcServerName, tlUtcTime)
* Retorna la hora del servidor pasado como parametro
* PARAMETROS:
*    tcServerName = Nombre del servidor
*    tlUtcTime = .T. FH UTC - .F. FH Local
* RETORNO: FechaHora ó .Null. si hubo error
* USO: ? ServerTime("\\MiServidor")
*----------------------------------------------------
FUNCTION ServerTime(tcServerName, tlUtcTime)
  IF PARAMETERS() < 2
    tlUtcTime = .F.
  ENDIF
  DECLARE INTEGER NetRemoteTOD IN netapi32 ;
    STRING @,  INTEGER @
  DECLARE INTEGER RtlMoveMemory IN win32api ;
    STRING @outbuffer, ;
    INTEGER inbuffer, ;
    INTEGER bytes2copy
  tdbuffout = REPLICATE(CHR(0), 48)
  tdbuffin = 0
  lcTryServerName = STRCONV(tcServerName, 5)
  rc = NetRemoteTOD(@lcTryServerName, @tdbuffin)
  IF rc = 0
    =RtlMoveMemory(@tdbuffout, tdbuffin, 48)
  ELSE
    lcTryServerName = STRCONV("\\" + tcServerName, 5)
    rc = NetRemoteTOD(@lcTryServerName, @tdbuffin)
    IF rc = 0
      =RtlMoveMemory(@tdbuffout, tdbuffin, 48)
    ELSE
      *-- Error con NetRemoteTOD()
      RETURN .Null.
    ENDIF
  ENDIF
  tod_month = str2long(SUBSTR(tdbuffout, 37, 4))
  tod_day = str2long(SUBSTR(tdbuffout, 33, 4))
  tod_year = str2long(SUBSTR(tdbuffout, 41, 4))
  tod_hours = str2long(SUBSTR(tdbuffout, 9, 4))
  tod_mins = str2long(SUBSTR(tdbuffout, 13, 4))
  tod_secs = str2long(SUBSTR(tdbuffout, 17, 4))
  tod_timezone = str2long(SUBSTR(tdbuffout, 25, 4)) * 60
  serverdatetime = DATETIME(tod_year, tod_month, tod_day, ;
    tod_hours, tod_mins, tod_secs)
  IF tlUtcTime
    tdServerTime = serverdatetime
  ELSE
    tdServerTime = serverdatetime - tod_timezone
  ENDIF
  RETURN tdServerTime
ENDFUNC

*----------------------------------------------------
FUNCTION str2long(tcLongStr)
  LOCAL ln, lnRetVal
  lnRetVal = 0
  FOR ln = 0 TO 24 STEP 8
    lnRetVal = lnRetVal + (ASC(tcLongStr) * (2^ln))
    tcLongStr = RIGHT(tcLongStr, LEN(tcLongStr) - 1)
  ENDFOR
  RETURN lnRetVal
ENDFUNC

*----------------------------------------------------
Esta función fue tomada y ligeramente modificada del siguiente artículo de la Base de Conocimientos de Microsoft:

-- Cómo utilizar la función NetRemoteTOD para obtener información de fecha y hora de un servidor --
http://support.microsoft.com/kb/249716

Luis María Guayán