25 de diciembre de 2020

La "Guía del hacker para Visual FoxPro" y el "Archivo de Ayuda de Visual FoxPro 9 SP2" ahora en línea

Guía del hacker para Visual FoxPro

Los autores del libro "Hacker's Guide to Visual FoxPro", Tamar Granor, Ted Roche, Della Martin y Doug Hennig, anunciaron que ahora el libro es de código abierto y se encuentra en línea al alcance de todos en el sitio: https://hackfox.github.io

La mayoría de los desarrolladores de Visual FoxPro considera que HackFox es la "biblia", porque va más allá de la ayuda de VFP, y describe cómo funciona realmente VFP. Aconseja que comandos y funciones usar, cuáles evitar y la mejor manera de trabajar.

HackFox se ha demorado un poco, ya que no tuvo actualizaciones después de VFP 7. Hacerlo de código abierto permitirá que prospere a medida que la comunidad actualizan los temas existentes y agregan nuevos temas para VFP 8 y VFP 9.


Archivo de Ayuda de Visual FoxPro 9 SP2

También otro archivo que se encuentra ahora en línea, es el Archivo de ayuda de Microsoft Visual FoxPro 9 SP2, VFPX Edition v.1.08 en el sitio: https://www.vfphelp.com/help/index.htm

Es el mismo archivo actualizado y mejorado por la comunidad a través del Proyecto VFPx que se encuentra para descarga en formato .CHM en el sitio: https://github.com/VFPX/HelpFile


17 de diciembre de 2020

AddProperty() no necesita comprobar la existencia de la propiedad

Puede no ser obvio, pero el método AddProperty() (y la función ADDPROPERTY() agregada en VFP 8.0) es bastante "lista" para no colisionar o para no generar un error cuando usted añade con .AddProperty() una propiedad que ya exista.

En vez de un código semejante a esto:

IF NOT PEMSTATUS(THIS,"AlgunaPropiedad",5)
  THIS.AddProperty("AlgunaPropiedad", AlgunValor)
ENDIF

usted puede escribir esta sola línea de código:

THIS.AddProperty("AlgunaPropiedad", AlgunValor)

Con lo cual VFP agrega la propiedad "AlgunaPropiedad" si no existe ya, y le asigna "AlgunValor" a ésta.

VFP Tips & Tricks - Drew Speedie

1 de diciembre de 2020

Controles Unicode en Visual FoxPro: Un nuevo enfoque más rápido y eficiente

Articulo original: Unicode Controls in Visual FoxPro - A new faster and efficient aproach
https://vfpimaging.blogspot.com/2020/11/unicode-controls-in-visual-foxpro-new.html
Autor: Cesar Ch.
Traducido por: Luis María Guayán


Como continuación de mi último artículo publicado: Iconos Unicode en botones de Visual FoxPro, decidí seguir probando diferentes soluciones para llevar Unicodes a nuestros controles, especialmente como iconos en botones.

La opción más natural sería usar botones de Windows reales como el ejemplo que tenemos en dicho artículo: https://comunidadvfp.blogspot.com/2020/11/iconos-unicode-en-botones-de-visual.html

Pero esto trae la desventaja de que tendríamos que hacer varios cambios en nuestros formularios heredados para adaptar todos los códigos relacionados con el evento Click y otros.

Entonces, decidí probar una solución híbrida - "Dibujar" un control Win32 "Estático", similar a nuestro control Label de VFP sobre CommandButtons y Labels comunes. Estos controles "estáticos" de Win32 permiten Unicodes, y nos permitirían mantener todos nuestros códigos heredados como están.

Así que aquí está FoxyObjects, una clase de VFP personalizada que se puede incluir en nuestros formularios y que "convertirá" todos los botones y etiquetas que tienen contenido entre las etiquetas <UC> </UC> a Unicodes, al igual que el artículo anterior. Esta vez unas 4 ó 5 veces más rápido que GradObjects, con el mismo resultado.

Si no leíste el artículo anterior, mi objetivo es traer algunos íconos atractivos, los mismos que vemos en la interfaz de usuario de Windows 10, especialmente los de "SEGOE MDL2 ASSETS", como se muestra en el siguiente CharMap:

El uso de esta nueva clase es realmente muy simple:

  • Abra el proyecto FoxyObjects
  • Lance una instancia de FoxyObjects a tu formulario
  • Establezca la propiedad FontName del botón de comando en "SEGOE MDL2 ASSETS" o cualquier otra fuente que desee. Configure la propiedad Caption del botón para aceptar unicodes, introduciendo los unicodes entre las etiquetas , por ejemplo:
    • griego <UC> 03b5 03b9 03c1 03ae 03bd 03b7 </UC> - Esto mostrará la palabra "Paz" en caracteres griegos, en cualquier fuente regular, como Arial, Tahoma, Segoe UI, etc.
    • Para obtener el icono de la impresora de la fuente SEGOE MDL2 ASSETS, establezca la propiedad FontName del botón de comando y agregue lo siguiente a la propiedad Caption: "<UC> E749 </UC>"

FoxyObjects trae algunas propiedades, que se aplicarán a todos los controles CommandButton y Label que están en el mismo nivel de objeto que el nivel de FoxyObjects. Por ejemplo, si desea que FoxyObjects aplique cambios a algunos objetos seleccionados, puede insertarlos en un contenedor y agregarle una instancia de la clase. De esta forma, el resto de objetos no se verán afectados.

De forma predeterminada, se aplicará cambios solo a los objetos que tengan la etiqueta <UC> en sus propiedades Caption.

  • BackColor: Numérico, especifica el color de fondo utilizado para mostrar texto y gráficos en un objeto.
  • DisabledForeColor: Numérico, especifica el color utilizado para mostrar el texto cuando el objeto está desactivado.
  • ForeColor: Numérico, especifica el color utilizado para mostrar el texto.
  • MouseOverForeColor: Numérico, especifica el color en el que se convertirá el texto del objeto (y el icono) cuando el mouse esté sobre el objeto especificado. Si no desea este efecto, especifique el valor -1
  • lBindAll: Logical, determina que todos los objetos se verán afectados, incluso si no tienen el en el Caption. Esto significa que puede cambiar el Caption en tiempo de ejecución, y se respetarán los Unicodes
  • lBindLabels: Lógico, determina que tanto los CommandButtons como los Labels se verán afectados
  • lBindResize: Lógico, determina que siempre que se cambie el tamaño o se mueva cualquier control, la máscara de etiqueta también se actualizará.
  • lBindVisible: Lógico, determina que siempre que cualquier control esté oculto o visible, la máscara de etiqueta también se actualizará..

Los Unicodes se pueden obtener directamente a través de CharMap.EXE o en toda la web. Aquí hay un excelente punto de partida: https://docs.microsoft.com/en-us/windows/uwp/design/style/segoe-ui-symbol-font

La fuente "SEGOE MDL2 ASSETS" viene con Windows 10, pero no se permite su distribución a otros sistemas operativos. Esto no es gran cosa, porque Tahoma también nos trae varias opciones, y siempre podemos trabajar con algunas de las fuentes gratuitas disponibles en la web, como "Material.io". Traen toneladas de iconos modernos y hermosos de forma gratuita. Realmente vale la pena una visita: https://material.io/resources/icons/?style=outline

AGRADECIMIENTOS ESPECIALES a Mustapha Bihmuten de Marruecos y Leandro Walfrans de Brasil por probar la versión Pre-Alpha de la clase y por brindar valiosas sugerencias

Descargar de FoxyObjects v.0.4


19 de noviembre de 2020

Iconos Unicode en botones de Visual FoxPro

Articulo original: Unicode button icons in Visual FoxPro
http://vfpimaging.blogspot.com/2020/11/unicode-button-icons-in-visual-foxpro.html
Autor: Cesar Ch.
Traducido por: Luis María Guayán


Una gran dificultad que tienen los foxeros es actualizar sus interfaces de usuario. Dado que perdimos el soporte de MS, necesitamos hacer casi todos los cambios en la interfaz de usuario (UI) por nuestra cuenta. La interfaz de usuario de Windows 10 actual se basa en iconos monocromáticos, los de la familia SEGOE UI, SEGOE UI SYMBOL y SEGOE MDL2 ASSETS. Estas son fuentes de True Type, que traen toneladas de íconos, los que vemos por todas partes en Windows 10.

Desafortunadamente, no podemos acceder a esos iconos directamente en VFP, porque usan un rango mayor al CHR(255) admitido por VFP. Aún tenemos algunas opciones:

  1. Utilizar un ActiveX que admita Unicodes
  2. Utilizar "Real Window buttons", que admiten Unicodes - https://github.com/VFPX/Win32API/blob/master/samples/sample_274.md
  3. Obtener ayuda de GDI+ - gdiplus.dll y dibujarlos nosotros.

La tercera opción es muy buena, pero exige mucho, mucho trabajo. Afortunadamente, hice casi todo el trabajo pesado anteriormente en 2005, en la clase GradObjects, que originalmente se creó para hacer fondos y botones degradados en nuestros formularios. Recreó cada botón del formulario y lo redibujó en un archivo de imagen, lo que permite efectos de degradado, de paso del mouse y de deshabilitado.

Teniendo esto, solo necesito adaptarlo, dejando atrás los degradados ya casi abandonados, agregando soporte a unicodes y algunas adaptaciones para los efectos del mouse.

Aquí hay una versión actualizada de la muy buena y antigua clase GRADOBJECTS, que estaba destinada a generar botones y fondos degradados para nuestros formularios en 2005, en los tiempos de WinXP. Sigue siendo el mismo GradObjects, pero con algunas propiedades y características nuevas.

El uso es realmente muy simple:

  • Abra el proyecto GradObjects
  • Cree un formulario, agregue algunos botones
  • Lance una instancia de Gradobjects en el formulario
  • Establezca la propiedad FontName del botón en "SEGOE MDL2 ASSETS" o cualquier otra que desee.
  • Establezca la propiedad Caption del botón para aceptar unicodes, introduciendo los unicodes entre las etiquetas <UC> </UC>, por ejemplo:
    • Griego <UC> 03b5 03b9 03c1 03ae 03bd 03b7 </UC> - Esto muestra la palabra "Paz" en caracteres griegos, en cualquier fuente regular, como Arial, Tahoma, Segoe UI, etc.
    • Para obtener el icono de la impresora de SEGOE MDL2 ASSETS, establezca la fuente del botón y agregue lo siguiente a la propiedad Caption: "<UC> E749 </UC> "

Las propiedades predeterminadas de "GradObjects" le brindarán un aspecto degradado, pero todo lo que necesita es cambiar solo 5:

  • BackColor1: Numérico, el RGB del color de fondo
  • BackColor2: Configúrelo en .F. (Falso), porque no necesitamos gradientes aquí, ¿verdad?
  • CaptionForeColor: Numérico, el RGB del color de fondo
  • GradientMode: 0 - ¡No necesitamos degradados!
  • SelBackColor: Numérico, el RGB del color de fondo cuando se enfoca el botón o se pasa el mouse sobre él
  • SelForeColor: Numérico, el RGB del color de primer plano cuando se enfoca el botón o se pasa el mouse sobre él

¡Eso es todo!

Los Unicodes se pueden obtener directamente a través de CharMap.EXE o en toda la web. Aquí hay un excelente punto de partida: https://docs.microsoft.com/en-us/windows/uwp/design/style/segoe-ui-symbol-font

Para obtener información más detallada, consulte la publicación original de GradObjects:

El objeto "GradObjects" transformará todos los CommandButtons, Graphical OptionButtons del mismo objeto principal. Utilice contenedores, si necesita efectos diferentes (o ninguno) para algunos controles individuales en sus formularios.

Empiece a jugar con el formulario de muestra "TESTUNICODEBTNS.SCX"

Descarga Botones Unicode


17 de noviembre de 2020

Códigos QR con FoxBarcodeQR v.2.10

Actualización del 28/02/2021: Se libera una nueva versión v.2.10 de FoxBarcodeQR


FoxBarcodeQR es una clase libre que ofrece una solución alternativa para todos los desarrolladores de la comunidad de Visual FoxPro que solicitaron soporte para Códigos QR a la clase FoxBarcode

Ambas clases forman parte del proyecto VFPx:

FoxBarcodeQR utiliza las librerías:

Características de las librerías externas


BarCodeLibrary.dll 

  • Genera códigos QR  funcionales, pero sólo se puede establecer el tamaño y el tipo de la imagen generada. 
  • No tiene ajustes para el nivel de corrección de errores, colores y/o margenes.
  • No soporta cadenas de mas de 255 caracteres.

La librería BarCodeLibrary.dll contiene solo 3 funciones:

  • LibraryVersion: Retorna una cadena con la versión de la librería.
  • SetConfiguration: Método para establecer el tamaño y el tipo de archivo de imagen a generar.
  • GenerateFile: Método responsable de generar la imagen del código de barras QR.

QRCodeLib.dll  (versión 0.1b - www.validacfd.com)

  • Genera códigos QR funcionales con un mayor control de configuración.
  • Soporta cadenas de mas de 255 caracteres.

La librería BarCodeLib.dll contiene los métodos:

  • QRCodeLibVer: Retorna una cadena con la versión de la librería.
  • FastQRCode: Genera la imagen del código de barras QR con el texto a codificar.
  • FullQRCode: Igual que el método anterior, pero con mayor control en la generación de la imagen del código QR.
La API de Google genera códigos QR  a través de una llamada POST a una URL:
  • Requiere conexión a internet.
  • Soporta cadenas de mas de 255 caracteres.

Métodos de FoxBarcodeQR

FoxBarcodeQR encapsula las funciones de las librerías BarCodeLibrary.dllQRCodeLib.dll y la API de Google, en métodos propios de la clase para compatibilidad con las versiones anteriores y poder seleccionar la librería a utilizar .

Los métodos de la clase FoxBarcodeQR son: 

  • QRBarcodeImage() que utiliza la librería BarCodeLibrary.dll y que recibe los siguientes parámetros:
    • tcText: Texto para codificar
    • tcFile: Nombre del archivo de imagen que desea generar. Si no se especifica ninguno, se genera un nombre de archivo aleatorio en la carpeta de archivos temporales de Windows.
    • tnSize: El tamaño de la imagen generada. Recibe un número entero entre 2 y 12
      • 2 = 66 x 66 (en píxeles)
      • 3 = 99 x 99
      • 4 = 132 x 132
      • 5 = 165 x 165
      • 6 = 198 x 198
      • 7 = 231 x 231
      • 8 = 264 x 264
      • 9 = 297 x 297
      • 10 = 330 x 330
      • 11 = 363 x 363
      • 12 = 396 x 396
    •  tnType: El tipo de archivo de imagen generado. Recibe un número entero entre 0 y 2.
      • 0 = BMP
      • 1 = JPG
      • 2 = PNG

A partir de la versión 2.0 de FoxBarcodeQR, los nuevos métodos añadidos utilizan la librería QRCodeLib.dll v.01b (www.validacfd.com)

  • FullQRCodeImage() que recibe los mismos parámetros que QRBarcodeImage()
    •  tcText: Texto para codificar
    • tcFile: Nombre del archivo de imagen que desea generar. Si no se especifica ninguno, se genera un nombre de archivo aleatorio en la carpeta de archivos temporales de Windows.
    • tnSize: El ancho y alto en pixeles de la imagen generada
    • tnType: (solo por compatibilidad) La librería solo genera archivo de imagen tipo 0 = BMP

Para configurar las otras opciones se utilizan las siguientes propiedades:

    • lAutoConfigurate: .T. para seleccionar una versión de código QR más grande si la cantidad de datos lo requiere.
    • lAutoFit: Trabaja conjuntamente con lAutoConfigurate
    • nBackColor: Color del fondo del código QR
    • nBarColor: Color de las barras del código QR
    • nCorrectionLevel: Nivel de corrección  de errores :
      • 0 = Nivel L ( 7 % ) 
      • 1 = Nivel M  ( 15 % ) 
      • 2 = Nivel Q ( 25% ) 
      • 3= Nivel H ( 30% )  
    • nEncoding: Algoritmo de codificación:
      • 0 = Alfabético: Codifica caracteres alfanuméricos  (digitos 0-9;  mayúsculas A-Z;  otros nueve caracteres: Espacio $ % * + – . / : )
      • 1 = Byte = 1: Codifica valores binarios ( 8-bit data) 
      • 2 = Numérico: Codifica unicamente valores numéricos (digitos 0-9) 
      • 3 = Kanji: Codifica caracteres Kanji. Los caracteres Kanji en Código QR pueden tener valores 8140-9FFC y E040-EBBF 
      • 4 = Auto:  Selección automática del algoritmo de codificación. (Recomendado)
    • nMarginPixels: Margen en pixeles
    • nModuleWidth: Tamaño de los módulos en pixeles
    • nHeight: Alto de la imagen en pixeles
    • nWidth: Ancho de la imagen en pixeles
  • FastQRCodeImage() es igual que el método FullQRCodeImage() y solo se pasa el texto a codificar. El resto se configura automáticamente, sin ningún control del usuario. 
    •  tcText: Texto para codificar
    •  tcFile: Nombre del archivo de imagen que desea generar. Si no se especifica ninguno, se genera un nombre de archivo aleatorio en la carpeta de archivos temporales de Windows.
  • GooQRCodeImage()  recibe los mismos parámetros que los métodos anteriores para uniformar la clase:
    •  tcText: Texto para codificar
    •  tcFile: Nombre del archivo de imagen que desea generar. Si no se especifica ninguno, se genera un nombre de archivo aleatorio en la carpeta de archivos temporales de Windows.
    •  tnSize: El ancho y alto en pixeles de la imagen generada
    • tnType: (solo por compatibilidad) La API solo genera archivo de imagen tipo 2 = PNG

        Esta API nos permite ajustar algunas otras propiedades como:

    •     nCorrectionLevel: Nivel de corrección  de errores :
      • 0 = Nivel L ( 7 % ) 
      • 1 = Nivel M  ( 15 % ) 
      • 2 = Nivel Q ( 25% ) 
      • 3= Nivel H ( 30% )  
    • nMarginPixels: Margen en columnas

Todos estos métodos retornan la ruta y el nombre del archivo de la imagen generada con el código QR.

Ejemplos

En el siguiente ejemplo, se crean dos imágenes de Código QR, la primera con el método QRBarcodeImage() y la segunda con el método FullQRCodeImage():


SET PROCEDURE TO LOCFILE("FoxBarcodeQR.prg") ADITIVE
*--- Crear un objeto FoxBarcodeQR
LOCAL loFbc, lcQRImage
loFbc = CREATEOBJECT("FoxBarcodeQR")

*-- Utilizando la librería BarCodeLibrary.dll
lcQRImage1 = loFbc.QRBarcodeImage("http://vfpx.codeplex.com/wikipage?title=FoxBarcode",,6,0)

*-- Utilizando la librería QRCodeLib.dll (www.validacfd.com)
loFbc.nBackColor = RGB(0,255,255) && Yelow
loFbc.nBarColor = RGB(0,0,128) && Blue
loFbc.nCorrectionLevel = 2 && Q 25%
lcQRImage2 = loFbc.FullQRCodeImage("http://vfpx.codeplex.com/wikipage?title=FoxBarcode",,200,0)


Con BarCodeLibrary.dll

 


Con QRCodeLib.dll con mas opciones para configurar


A partir de ésta nueva versión 2.0 de FoxBarcodeQR se pueden codificar cadenas de caracteres mayores a 255 caracteres con la librería QRCodeLib.dll, y a partir de la versión 2.10 con la API de Google también. Ejemplo:

SET PROCEDURE TO LOCFILE("FoxBarcodeQR.prg") ADITIVE
*--- Crear un objeto FoxBarcodeQR
LOCAL loFbc, lcQRImage
loFbc = CREATEOBJECT("FoxBarcodeQR")

lcString = "+ .0010. -"
DO WHILE LEN(lcString) < 500
  lnI = LEN(lcString) + 10
  lcString = lcString + "+ ." + TRANSFORM(lnI, "@L 9999") + ". -"
ENDDO

*-- Utilizando la librería QRCodeLib.dll (www.validacfd.com)
lcQRImage = loFbc.FullQRCodeImage(lcString,,330)


*-- Utilizando la API de Google
lcQRImage2 = loFbc.GooQRCodeImage(lcString,,330)



Con QRCodeLib.dll

Con la API de Google


Para incluir un código de barras QR en un informe, se debe insertar un objeto Image y establecer la propiedad "ControlSource" con una llamada al método QRBarcodeImage(), FullQRCodeImage() o GooQRCodeImage(). Se recomienda ajustar "Escala de contenidos, mantener la forma" si el tamaño de la imagen difiere de la estructura.


Código QR en informes

Importante: Antes de ejecutar el informe y crear el objeto FoxBarcodeQR, se debe declarar la variable como PRIVATE de forma que ésta tenga alcance en el informe:

*--- Crear un objeto FoxBarcodeQR privado
PRIVATE poFbc
m.poFbc = CREATEOBJECT("FoxBarcodeQR")
... 
REPORT FORM FoxBarcodeQR PREVIEW


Distribución

Los únicos archivos necesarios para ser distribuidos para que FoxBarcodeQR funcione correctamente son:

Notas sobre la distribución e instalación del archivo BarCodeLibrary.dll y QRCodeLib.dll:

  • No se registran los archivos BarCodeLibrary.dll y QRCodeLib.dll. Debe estar ambos en la misma carpeta de la aplicación o en la carpeta del sistema de Windows.
  • BarCodeLibrary.dll y QRCodeLib.dll fueron probados y funcionan en Windows XP, 7, 8 y 10 (32 y 64 bits)

1 de noviembre de 2020

Cargar un número grande de archivos mediante ADIR()

La función ADIR() es una manera práctica de cargar todos los archivos (o de un subconjunto de todos los archivos) de una carpeta específica, en un Array. En la mayoría de los usos típicos de ADIR(), el número de archivos y por lo tanto el tamaño del Array, no es una cuestión a discutir.

Sin embargo, en aquellos escenarios donde el número de archivos que Ud. desea cargar es muy grande (mas de 10.000), existen estos problemas:

1) En versiones de VFP anteriores a VFP 9.0, ADIR() estaba limitado a cerca de 12.800 filas, debido al límite de 64.000 items máximos de un Array. Si la carpeta específicada contiene mas de 12.800 archivos, ADIR() genera un error.

2) VFP 9.0 elimina la limitación de 64.000 items, pero cuando usted intenta cargar y después procesar las filas del Array, el rendimiento sufre porque el Array entero se carga en memoria.

El siguiente código muestra una manera de solventar el problema usando la función SYS(2000) que carga un archivo a la vez en un cursor y a) Trabaja en cualquier versión de VFP y b) Consume muy poca memoria, porque solamente una fila del Array a la vez, se almacena en memoria.

CLEAR 
LOCAL xx
*
*  create 12,000 files with the ".TST" extension,
*  the limit when using VFP 8.0 or lower -- feel
*  free to increase this number dramatically in 
*  VFP 9 and higher
*
FOR xx = 1 TO 12000
  STRTOFILE("File " + TRANSFORM(m.xx),"File"+TRANSFORM(m.xx)+".TST",0)
ENDFOR
*
*  try it the ADIR() way
*
start = SECONDS()
CREATE CURSOR FileList (FileName C(60), ;
                        FileSize I, ;
                        LastModD D, ;
                        LastModT C(8), ;
                        FileAttr C(10))
LOCAL laDir[1]
ADIR(laDir,"*.TST")
INSERT INTO FileList FROM ARRAY laDir
end = SECONDS()
? end-start, RECCOUNT("FileList")
USE IN FileList
*
*  try it the SYS(2000) way
*
start = SECONDS()
CREATE CURSOR FileList (FileName C(60), ;
                        FileSize I, ;
                        LastModD D, ;
                        LastModT C(8), ;
                        FileAttr C(10))
LOCAL lcFile
lcFile = SYS(2000,"*.TST")
DO WHILE NOT EMPTY(m.lcFile)
    ADIR(laFile, m.lcFile)
    INSERT INTO FileList FROM ARRAY laFile
    lcFile = SYS(2000,"*.TST",1)
ENDDO
end = SECONDS()
? end-start, RECCOUNT("FileList")
USE IN FileList
ERASE *.TST
RETURN

VFP Tips & Tricks - Drew Speedie

6 de octubre de 2020

Tip: Use _TALLY

_TALLY es una variable de ambiente de VFP, ha estado ahí desde que yo recuerde, su uso puede ser bastante útil cuando se está trabajando con datos. Se utiliza para saber el número de registros que han sido afectados o creados.

En lo particular, utilizo mucho _TALLY para saber si ha sido creado un cursor con SELECT-SQL:

SELECT iID, cClave, cNombre, cTelefono ;
  FROM Empleado ;
  WHERE iID = lnIDEmpleado ;
  INTO CURSOR cEmpleado

IF _TALLY > 0 
  ** Se creó el cursor, hubo datos
  ** por lo que podremos procesar cEmpleado
ELSE
  ** Mensaje al usuario?
ENDIF

Está documentado en la ayuda del producto con qué otros comandos se puede utilizar, no estaría de más darle un vistazo e implementarlo en donde sea conveniente.

Como nota adicional, cabe mencionar que _TALLY no funcionará con cadenas enviadas vía ODBC u OLEDB (hacia un servidor de bases de datos?), ya que le resulta imposible saber (por éste método) cuántos registros han sido afectados.

Espartaco Palma Martínez

9 de septiembre de 2020

Comprobar si una DLL ya está cargada

El programa IsAPIFunction.PRG en una pequeña función que puede hacer mas rápido algún código, comprobando si una función API específica ha sido ya declarada, antes de preocuparse en declararla de nuevo.

*
*  IsAPIFunction.PRG
*  RETURN un valor lógico indicando si el nombre de la función pasada 
*  como parámetro en una función API de Windows (en una Windows .DLL)
*  que está actualmente cargada por el comando DECLARE
*
*  Author:  Drew Speedie
*
*  Esta función usa:
*  1- La función ADLLS() introducida en VFP 7.0
*  2- El sexto parámetro opcional agregado a la 
*     función ASCAN() en VFP 7.0
*
*  Ejemplos:
*!*  IF NOT X7ISAPIF("MessageBeep")
*!*    DECLARE Long MessageBeep IN USER32.DLL Long uType
*!*  ENDIF
*!*  MessageBeep(0)
*
*!*  IF NOT X7ISAPIF("MessageBeepWithAlias")
*!*    DECLARE Long MessageBeep IN USER32.DLL AS MessageBeepWithAlias Long uType
*!*  ENDIF
*!*  MessageBeep(0)
*
*!*  IF NOT X7ISAPIF("MessageBeepWithAlias","MessageBeep")
*!*    DECLARE Long MessageBeep IN USER32.DLL AS MessageBeepWithAlias Long uType
*!*  ENDIF
*!*  MessageBeep(0)
*
*
*  lParameters
*    tcFunctionAlias: El alias de la función API
*                     Por omisión, el alias es el mismo que el
*                     nombre de la función pero se puede hacer:
*                     DECLARE DLL .. AS 
*    tcFunctionName:  Si pasa tcFunctionAlias y necesita estar seguro
*                     que esta función solo retorna .T. cuando
*                     tcFunctionAlias es el alias para una declaración
*                     para un nombre de función específico, pase el 
*                     nombre de la fucnción en este parámetro
*
LPARAMETERS tcFunctionAlias, tcFunctionName
LOCAL laDLLs[1], lnRow
IF ADLLS(m.laDLLs) = 0
  RETURN .F.
ENDIF
lnRow = ASCAN(laDLLs,m.tcFunctionAlias,1,-1,2,15)
IF m.lnRow = 0
  RETURN .F.
ENDIF
IF PCOUNT() = 1 ;
    OR NOT VARTYPE(m.tcFunctionName) = "C" ;
    OR EMPTY(m.tcFunctionName)
  RETURN .T.
ENDIF
*
*  tcFunctionName fue pasado
*
RETURN UPPER(ALLTRIM(m.laDLLs[m.lnRow,1])) == UPPER(ALLTRIM(m.tcFunctionName))

Por favor note que el programa IsAPIFunction.PRG requiere VFP 7.0 o superior para ejecutarse, pero puede ser modificado para correr en la versión anterior de VFP, modificando al lógica de ASCAN(), para no para usar el ASCAN() con los parámetros agregados en VFP 7.0.

VFP Tips & Tricks - Drew Speedie

17 de agosto de 2020

Convertir un cursor SPT en una vista remota

Como convertir un cursor SPT (SQL Pass-Thru) en una vista remota para hacer más fáciles las actualizaciones a los datos.

Una vista remota es un cursor SQL Pass-Thru (SPT) con un "envoltorio de vista" especial que permite que el cursor remoto responda a las funciones TABLEUPDATE(), TABLEREVERT() y REQUERY() de VFP, haciendo más fáciles las actualizaciones a los datos (sin necesidad de escribir tediosas declaraciones SQL INSERT, UPDATE y DELETE).

Sin embargo, algunos desarrolladores VFP sienten que SPT es superior a las vistas remotas, y quieren hacer el trabajo extra necesario para escribir el código de las actualizaciones. Ellos también pueden preferir reducir su mantenimiento adicional, eliminando vistas remotas de un contenedor de base de datos de VFP.

Este artículo demuestra que usted puede usar la función CURSORSETPROP() para convertir un cursor SPT en una vista remota, la cual puede ser actualizada facilmente utilizando la función TABLEUPDATE().

El siguiente PRG demuestra esta técnica, usando la tabla Authors (Autores) de la base de datos Pubs (Publicaciones), contenida en los ejemplos de SQL Server. A fin de ejecutar el PRG con éxito, tendrá que modificar la línea SQLSTRINGCONNECT() para especificar una cadena de conexión que funcione en su computadora.

El procedimiento local RemoteSPTCursor2RemoteView() en el PRG, es una rutina genérica que convierte cualquier cursor SPT en una "vista remota", con lo cual las actualizaciones son fácilmente llevadas a cabo con una simple llamada TABLEUPDATE().

La única diferencia entre un cursor SPT convertido en una vista remota en tiempo de ejecución y una vista remota existente (contenida en una base de datos de VFP) es que no puede hacer un REQUERY() a un cursor SPT convertido en una vista remota. Toda la configuración CURSORGETPROP() funciona, el almacenamiento en buffer (y las funciones permitidas) funcionan, y hasta la función REFRESH() funciona.

Este artículo se aplica a todas las versiones de VFP, pero el siguiente código, requiere VFP 7.0 o superior.

*
* Ejemplo de convertir un cursor SPT en una "vista remota"
*
* El código interesante está en el procedimiento local
* RemoteSPTCursor2RemoteView(), que hace todo el
* trabajo, y que puede modificar para su propio uso
*
CLEAR
LOCAL lnHandle, lnGNM
*
* IMPORTANTE!
* La línea siguiente del código tendrá que ser modificada
* para especificar una cadena válida SQLSTRINGCONNECT()
* para establecee una conexión a la base de datos Pubs
*
WAIT WINDOW "Intentanto conectar a la base de datos Pubs." + CHR(13) + ;
  "Si este intento falla, debera modificar el programa en " + CHR(13) + ;
  "la línea SQLSTRINGCONNECT() para especificar una " + CHR(13) + ;
  "cadena de conexión que funcione en su computadora." NOWAIT
*
lnHandle = SQLSTRINGCONNECT("DRIVER=sql server;SERVER=(local);UID=sa;PWD=;DATABASE=Pubs")
*
WAIT CLEAR
IF lnHandle < 1
  MESSAGEBOX("No puede establecer una conexión a la base de datos Pubs en " + ;
    "SQL Server. Modifique la línea SQLSTRINGCONNECT() para especificar " + ;
    "una cadena de conexión que funcione en su computadora.", 16, "Aviso")
  RETURN
ENDIF
IF SQLEXEC(lnHandle,"SELECT * FROM AUTHORS ORDER BY Au_LName") < 0
  MESSAGEBOX("No puede hacer SELECT * FROM AUTHORS", 16, "Aviso")
  SQLDISCONNECT(0)
  RETURN
ENDIF
SELECT SQLResult
*
* Aquí está donde convertimos el cursor SPT en una vista remota
*
IF NOT RemoteSPTCursor2RemoteView("SQLResult", "Authors", "Au_ID", 5)
  MESSAGEBOX("No puede convertir SQLResult en una vista remota.", 16, "Aviso")
  SQLDISCONNECT(0)
  RETURN
ENDIF
WAIT WINDOW "Haga cambios a los datos," + CHR(13) + ;
  "(Insert/Update/Delete)" + CHR(13) + ;
  "y cierre la ventana Examinar" NOWAIT NOCLEAR
BROWSE LAST
WAIT CLEAR
lnGNM = GETNEXTMODIFIED(0,"SQLResult")
IF lnGNM = 0
  MESSAGEBOX("El buffer esta limpio, aparentemente no hizo cambios.", 48, "Aviso")
ELSE
  *
  * El buffer esta 'sucio'
  *
  GOTO (lnGNM)
  MESSAGEBOX('GetNextModified(0,"SQLResult"): ' + ;
    TRANSFORM(GETNEXTMODIFIED(0,"SQLResult")) + CHR(13) + ;
    'GetFldState(-1,"SQLResult"): ' + TRANSFORM(GETFLDSTATE(-1,"SQLResult")) + CHR(13) + ;
    'Presione "OK" para intentar el TABLEUPDATE(.t.,.t.,"SQLResult")', 48, "Aviso")
  IF TABLEUPDATE(.T.,.T.,"SQLResult")
    *
    * Tuvo éxito!
    *
    MESSAGEBOX("Todas las modificaciones se hicieron exitosamente " + ;
      "con TABLEUPDATE() - La ventana Examinar muestra " + ;
      "un nuevo SELECT * FROM AUTHORS.", 48, "Please Note")
    SQLEXEC(lnHandle,"SELECT * FROM AUTHORS ORDER BY Au_LName")
    WAIT WINDOW "Nuevo " + CHR(13) + "SELECT * FROM AUTHORS" + CHR(13) + ;
      "conteniendo cualquier cambio " + CHR(13) + "que Ud. hizo." NOWAIT NOCLEAR
    BROWSE LAST
    WAIT CLEAR
  ELSE
    *
    * Falló
    *
    LOCAL laError[1]
    AERROR(laError)   &&& laError[1] = 1526
    MESSAGEBOX("El TABLEUPDATE() falló porque " + ;
      TRANSFORM(laError[2]) + "/" + TRANSFORM(laError[3]), 16, "Aviso")
  ENDIF
ENDIF
SQLDISCONNECT(0)
RETURN
*
* --
*
PROCEDURE RemoteSPTCursor2RemoteView
  *
  * Convierte un cursor SPT en un vista remota actualizable
  *
  *  lParameters
  *
  *   tcCursorAlias (R) Alias del cursor SPT
  *   tcTableName (R) Nombre de la tabla remota de la cual 
  *                   tcCursorAlias fue recuperado
  *   tcPKFieldName (R) Nombre del campo en tcCursorAlias 
  *                     que es la llave (primaria)
  *   tnBuffering (O) Especifica el modo de almacenamiento de buffer 
  *                   para tcCursorAlias, 
  *                   por defecto 3 - Optimista de Tabla
  *   tnWhereType (O) Especifica la propiedad WhereType, 
  *                   por defecto 3 - Clave y Modificado
  *   tlExcludePK (O) Bandera lógica que indica si hay que excluir el
  *                   campo de PK del UpdatableFieldList - pasa este
  *                   parámetro como .T. cuando el campo de PK es
  *                   poblado en virtud de ser una columna de Identidad
  *
  LPARAMETERS tcCursorAlias, tcTableName, tcPKFieldName, ;
    tnBuffering, tnWhereType, tlExcludePK
  *
  * propiedades de actualización - UpdateNameList y
  * UpdatableFieldList, igual que una vista remota
  *
  LOCAL lnSelect, lcUpdatableFieldList, lcUpdateNameList, ;
    lcField, xx, lnCount, llSuccess
  lcUpdatableFieldList = SPACE(0)
  lcUpdateNameList = SPACE(0)
  lcField = SPACE(0)
  lnSelect = SELECT(0)
  lnCount = 0
  SELECT (tcCursorAlias)
  *
  * añadir cada campo al UpdateNameList y 
  * las propiedades UpdatableFieldList
  *
  FOR xx = 1 TO FCOUNT()
    lcField = UPPER(ALLTRIM(FIELD(xx)))
    lnCount = lnCount + 1
    lcUpdatableFieldList = lcUpdatableFieldList + ;
      IIF(lnCount=1,SPACE(0),",") + lcField
    lcUpdateNameList = lcUpdateNameList + ;
      IIF(lnCount=1,SPACE(0),",") + lcField + ;
      SPACE(1) + tcTableName + "." + lcField
  ENDFOR
  IF tlExcludePK
    *
    * Cuando las PKs no deben ser generadas a mano 
    * (como cuando el PK es una columna Identity), 
    * el campo PK tiene que ser quitado del 
    * UpdatableFieldList para prevenir un TableUpdate()
    * e intentar actualizar el campo PK, que 
    * causaría un crash 
    *
    *  ... por cualquier razón, el campo de PK 
    *  debe permanecer en el UpdateNameList...
    *
    lcUpdatableFieldList = "," + ALLTRIM(lcUpdatableFieldList) + ","
    lcUpdatableFieldList = STRTRAN(lcUpdatableFieldList, ;
      "," + UPPER(tcPKFieldName) + "," , ",")
    *
    * asegurar que no dejamos una coma durante 
    * el principio o el final de la cadena
    *
    IF LEFTC(lcUpdatableFieldList,1) = ","
      lcUpdatableFieldList = SUBSTRC(lcUpdatableFieldList,2)
    ENDIF
    IF RIGHTC(lcUpdatableFieldList,1) = ","
      lcUpdatableFieldList = LEFTC(lcUpdatableFieldList,LENC(lcUpdatableFieldList)-1)
    ENDIF
  ENDIF
  llSuccess = .F.
  DO CASE
    CASE NOT CURSORSETPROP("KeyFieldList",tcPKFieldName)
      ASSERT .F. MESSAGE PROGRAM() + " no se puede configurar KeyFieldList"
    CASE NOT CURSORSETPROP("Tables",tcTableName)
      ASSERT .F. MESSAGE PROGRAM() + " no se puede configurar Tables"
    CASE NOT CURSORSETPROP("UpdatableFieldList",lcUpdatableFieldList)
      ASSERT .F. MESSAGE PROGRAM() + " no se puede configurar UpdatableFieldList"
    CASE NOT CURSORSETPROP("UpdateNameList",lcUpdateNameList)
      ASSERT .F. MESSAGE PROGRAM() + " no se puede configurar UpdateNameList"
    CASE NOT CURSORSETPROP("WhereType", ;
        IIF(VARTYPE(tnWhereType)="N",tnWhereType,3))
      ASSERT .F. MESSAGE PROGRAM() + " no se puede configurar WhereType"
    CASE NOT CURSORSETPROP("Buffering", ;
        IIF(VARTYPE(tnBuffering)="N",tnBuffering,3))
      ASSERT .F. MESSAGE PROGRAM() + " no se puede configurar Buffering"
    CASE NOT CURSORSETPROP("SendUpdates",.T.)
      ASSERT .F. MESSAGE PROGRAM() + " no se puede configurar SendUpdates"
    OTHERWISE
      llSuccess = .T.
  ENDCASE
  SELECT (lnSelect)
  RETURN llSuccess
ENDPROC

VFP Tips & Tricks - Drew Speedie

3 de agosto de 2020

Agregar registro IFND en IntelliSense

El programa IFND_FoxCode.PRG agrega un registro "IFND" a nuestra tabla IntelliSense record que expandira en en un control IF Not Default().

En el editor de métodos o programa ingrese:

IFND{SPACE}

y este registro IntelliSense expadirá esto a:

IF NOT DODEFAULT()
   RETURN .F.
ENDIF
*
*  IFND_FoxCode.PRG
*  Agrega un registro "IFND" a nuestra tabla IntelliSense table para
*  que cuando ingrese:
*    IFND{SPACE}
*  esto se expanda a:
*    IF NOT DODEFAULT()
*      RETURN .F.
*    ENDIF
*
CLEAR ALL
CLOSE ALL
CLEAR
USE (_FOXCODE) IN 0 AGAIN ALIAS UpdateFoxCode
SELECT UpdateFoxCode
**************************************************
LOCATE FOR UPPER(ALLTRIM(Abbrev)) == "IFND"
**************************************************
IF NOT FOUND()
  APPEND BLANK
  REPLACE TYPE WITH "U", ;
    Abbrev WITH "IFND",;
    CASE WITH "U", ;
    SAVE WITH .T., ;
    Cmd WITH "{}", ;
    USER WITH "Mi registro IFND"
  ACTIVATE SCREEN
  ? PROGRAM() + " acaba de agregar el registro 'IFND'"
ENDIF
REPLACE DATA WITH ;
  "*  IF NOT DODEFAULT(), RETURN .F., ENDIF" + CHR(13) + CHR(10) + ;
  "LPARAMETERS oFoxcode" + CHR(13) + CHR(10) + ;
  "IF NOT oFoxcode.Location = 10" + CHR(13) + CHR(10) + ;
  [   RETURN "IFND"] + CHR(13) + CHR(10) + ;
  "ENDIF" + CHR(13) + CHR(10) + ;
  [oFoxcode.ValueType = "V"] + CHR(13) + CHR(10) + ;
  "TEXT TO myvar TEXTMERGE NOSHOW" + CHR(13) + CHR(10) + ;
  "IF NOT DODEFAULT()" + CHR(13) + CHR(10) + ;
  "  RETURN .F." + CHR(13) + CHR(10) + ;
  "ENDIF" + CHR(13) + CHR(10) + ;
  "ENDTEXT" + CHR(13) + CHR(10) + ;
  "RETURN myvar + chr(13) + [~]"
USE IN UpdateFoxCode
RETURN

VFP Tips & Tricks - Drew Speedie

20 de julio de 2020

ExecScript()

La nueva función ExecScript() en VFP 7.0 permite que usted ejecute una secuencia de código "al vuelo".

El ejemplo de abajo también hace uso de la nueva sintaxis TEXT TO para crear la cadena de comandos.

Simule esto es su código PRG o método:

*
* código normal del PRG o método aquí ...
* 

*
* cree una cadena de comandos "al vuelo" 
*
TEXT TO lcCode NOSHOW
LOCAL lcOutput,xx
lcOutput = SPACE(0)
FOR xx = 1 to 10
  lcOutput = lcOutput + ;
  "Line " + TRANSFORM(xx) + ;
  CHR(13) + CHR(10)
ENDFOR
RETURN lcOutput
ENDTEXT
*
* ejecute los comandos aquí 
*
LOCAL lcRetVal
lcRetVal = EXECSCRIPT(lcCode)
*
* continúe ejecutando el PRG o método... 
* 

Solamente tenga cuidado que ExecScript() es relativamente lento.

VFP Tips & Tricks - Drew Speedie

9 de julio de 2020

NULL en archivos CDX

NULL en archivos CDX

Artículo original: NULL in CDX files
http://www.foxpert.com/knowlbits_200708_4.htm
Autor: Christof Wollenhaupt
Traducido por: Ana María Bisbé York


VFP no guarda NULL en el campo. En su lugar, utiliza un campo oculto llamado _NULLFLAGS. Puede que usted se pregunte (bueno, yo no lo hice; pero puede que usted si) sobre cómo VFP puede crear un índice en una columna que contenga NULL, si NULL no se almacena como tal en el campo. La respuesta en realidad es muy sencilla. Un campo que contenga NULL, se guarda como una cadena vacía. Para distinguir valores NULL de campos que en verdad están vacíos, VFP agrega un guión bajo antes de cualquier dato que exista en el campo. Por tanto, en Northwind\Customers.CDX el índice sobre las ciudades contiene "_PARIS" en lugar de "PARIS"

¿Se da cuenta del efecto que esto provoca? Debido al carácter extra que agrega VFP, una expresión de índice sobre un campo NULL puede ser solamente de 239/119 caracteres de largo, en lugar de 240/120 que admiten los campos regulares.

20 de junio de 2020

DISPLAY MEMORY LIKE <Skeleton>

Los desarrolladores de VFP estan familiarizados con estos comandos: DISPLAY MEMORY y LIST MEMORY, sin embargo ambos comandos soportan la cláusula opcional LIKE <Skeleton>

Dado que la lista completa de variables de memorias existentes es tipicamente mas de una pantalla de información, es muy cómodo poder especificar un subconjunto de una o mas variables de memoria:

DISPLAY MEMORY LIKE X*
DISPLAY MEMORY LIKE _*
DISPLAY MEMORY LIKE MemvarName

Si todo lo que Ud. necesita es consultar solo el valor de una variable de memoria, Ud. tipicamente solo comprueba esta directamente con:

? lcMemvar

Sin embargo, cuando usted desea comprobar todos los valores de un Array, es bueno poder hacer:

DISPLAY MEMORY LIKE laMyArray

Aquí estan un par de ejemplos usando Arrays creados con funciones de VFP:

APRINTERS(laPrinters)
DISPLAY MEMORY LIKE laPrinters
AFONT(laFonts)
DISPLAY MEMORY LIKE laFonts

VFP Tips & Tricks - Drew Speedie

3 de junio de 2020

Exporta a Excel datos de un Cursor/Tabla mediante el llamado a una FUNCTION()

Se ha escrito mucho acerca de exportar datos a Excel. Pero esta funcion que modifique gracias a rutinas encontradas en este Blog, me ha sacado de apuros.

*-------------------------------------------------------------------------------------
*----------- FUNCTION EXPORTAR A MS EXCEL --------------------------------------------
*-------------------------------------------------------------------------------------
*-- MarcoMolina("27/07/2006")
*-- Genere una instruccion SQL READWRITE partiendo de una Tabla/Cursor
*-- con el formato que se desea.
*-- Limitacion exporta solo 26 campos a MS Excel
*-- USO:
*-- Exportar_Excel("CursorSQL","Encabezado del Reporte",Dsd,Hst,"Nombre de la Empresa",.f.)
* Dsd        : Fecha que inicia el rango del reporte, si no se requiere deje ""
* Dsd        : Fecha que final  del rango del reporte, si no se requiere deje ""
* CursorSQL  : Nombre de la Tabla/Cursor
* .t./.f.    : Indica que protege la hoja de excel con password

*--Forma de USO:
CLOSE DATABASES
SELECT 0
USE OrigenDatos

SELECT CAST(Camp0 AS N(1)) AS "I",;
  Camp1 AS Campo1,;
  Camp2 AS Campo2,;
  Camp3 AS Campo3;
  FROM OrigenDatos;
  WHERE BETWEEN(Fecha,Dsd,Hst);
  INTO CURSOR CursorSQL READWRITE

*--Instrucciones para dar formato al CursorSQL. Si se requiere.
IF RECCOUNT() > 0
  =Exportar_Excel("CursorSQL","Encabezado del Reporte",Dsd,Hst,"Nombre de Empresa",.F.)
ELSE
  WAIT WIND "No existen registros para procesar"
ENDIF

FUNCTION Exportar_Excel
  PARAMETERS cTabla,cTitulo,cDesde,cHasta,cEmpresa,cproteg
  IF VARTYPE(cProteg) = "U"
    cProteg = .F.      &&la hoja de excel estara protegida=.t. - modificable=.f.
  ENDIF
  IF TYPE("cDesde") = "L" OR TYPE("cHasta") = "L"
    Periodo = ""
  ELSE
    IF !EMPTY(cDesde) AND !EMPTY(cHasta)
      IF TYPE("cDesde") = "D" OR TYPE("cHasta") = "D"
        Periodo = "Desde: " + ALLTRIM(DTOC(cDesde)) +" Hasta: "+ ALLTRIM(DTOC(cHasta))
      ELSE
        Periodo = "Desde: " + ALLTRIM(cDesde) +" Hasta: "+ ALLTRIM(cHasta)
      ENDIF
    ELSE
      Periodo = ""
    ENDIF
  ENDIF
  *--Selecciona la tabla pasada por parametro - Resultado del SQL
  SELECT (cTabla)
  AreaTabla = SELECT()
  COUNT FOR !DELETED() TO Lineas

  *--Identificacion de la columna de la hoja Excel
  *--ID_Col   = Nombres de las columnas A1,B2,C3...
  *--AnchoCol = Ancho de la columna
  *--TipoCmp  = Formato del campo si es Caracter, Numerico, Fecha.
  CREATE CURSOR LargoCol (ID_Col C(10),AnchoCol N(8),TipoCmp C(1))

  *--Separa los campos de la tabla por comas
  *--Identifica la columna en la tabla ...A1,B2,C3,D4.....
  *--Solo 26 campos permite identificar de A-Z

  SELECT (AreaTabla)
  cString = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
  STORE "" TO cLago,cCh,nCampo
  FOR xCta = 1 TO FCOUNT()
    *--Lista de campos separados por comas.
    nCampo = nCampo + FIELD(xCta) + ","
    *--Largo de cada campo
    cLago=FSIZE(FIELD(xCta))
    *--Tipo de campo
    cTipo=TYPE(FIELD(xCta))
    *--Establece el ancho de la columna como minimo 13 espacios
    IF cLago <= 10
      cLago = 13
    ENDIF
    *--Identifica las columnas A1 B2 C3..
    cCh = SUBSTR(cString,xCta,1)
    gCh = cCh+ALLTRIM(STR(xCta))
    *--Guarda la configuracion del tamñano de los campos y nombre etc.
    INSERT INTO LargoCol (AnchoCol,ID_Col,TipoCmp) VALUES (cLago,gCh,cTipo)
    *--Reestablece la tabla
    SELECT (AreaTabla)
  NEXT
  SELECT (AreaTabla)

  *--Quita la ultima "," de la concatenacion de los nombres de campos del cursor
  nCampo = SUBSTR(nCampo,1,LEN(nCampo)-1)

  *--Determinar la ultima columna del reporte
  SELECT LargoCol
  xEnca = LEFT(ALLTRIM(Id_Col),1) + "5"
  xHay = LEFT(ALLTRIM(Id_Col),1) + ALLTRIM(STR(Lineas+7))

  *--Solo 26 campos son exportables
  IF xCta > 26
    =MESSAGEBOX("La tabla... &cTabla tiene...(" + ALLTRIM(STR(xCta)) + ") " + ;
      "campos, de los cuales solo... (26) pueden ser " + CHR(13)+;
      "exportados a MS Excel.",48,Titulo)
    CLOSE DATABASES
    RETURN
  ENDIF
  *---------------------------------------------------------
  *-- EXPORTA LA TABLA
  *---------------------------------------------------------
  WAIT WINDOW "Abriendo MS Excel..." NOWAIT

  SELECT (AreaTabla)
  *-- Nombre y path de la hoja
  TxtFilename = FULLPATH("Temps\Exprt_Excel"+Usuario)

  EXPORT FIELDS &nCampo TO ALLTRIM((TxtFileName)) TYPE XL5
  oExcel = CREATEOBJECT("Excel.Application")
  WITH oExcel
    .DisplayAlerts = .F.
    .Workbooks.OPEN(TxtFilename)
    .ActiveWindow.DisplayZeros = "FALSE"
    *- Renombra la hoja de calculo
    cHoja=RIGHT(TxtFileName,13) &&"Exprt_Excel"+Usuario
    .Sheets("&cHoja").SELECT
    .Sheets("&cHoja").NAME = "MM-Empresarial"
    *--Inserta lineas en blanco para titulos del reporte
    .RANGE("A1:A4").SELECT
    .SELECTION.EntireRow.INSERT
    *--Formatea el ancho de las columnas en la hoja
    SELECT LargoCol
    SCAN ALL
      _Col = ALLTRIM(ID_Col)
      _Cls = LEFT(_Col,1)
      _Ach = AnchoCol
      .COLUMNS("&_Cls:&_Cls").COLUMNWIDTH = _Ach
      *--Si la columna es numerica le da el formato
      IF ALLTRIM(TipoCmp) = "D"
        .RANGE("&_Cls:&_Cls").HorizontalAlignment = -4152
      ENDIF
      IF ALLTRIM(TipoCmp) = "N"
        *--Alinemiento del encabezado de la columna
        .RANGE("&_Cls:&_Cls").HorizontalAlignment = -4152
        _Fin = "&_Cls"+ALLTRIM(STR(Lineas+50))
        .RANGE("A1:&_Fin").SELECT
        .SELECTION.NumberFormat = "#,##0.00"
      ENDIF
      *--Coloca las mayusculas a los encabezados de columna
      _Clu = LEFT(ALLTRIM(ID_Col),1)
      _DsdA5 = "&_Clu"+"5"
      .RANGE("&_DsdA5:&_DsdA5").SELECT
      .RANGE("&_DsdA5:&_DsdA5").VALUE = UPPER(.RANGE("&_DsdA5:&_DsdA5").VALUE)
    ENDSCAN
    *--Inserta nombre de la empresa y titulo del reporte
    .RANGE("A1:A1").SELECT
    .RANGE("A1:A1").VALUE = UPPER(ALLTRIM(lpEmpresa))
    .RANGE("A2:A2").SELECT
    .RANGE("A2:A2").VALUE = cTitulo
    .RANGE("A3:A3").SELECT
    .RANGE("A3:A3").VALUE = Periodo
    *--Formato/Presentacion de hoja
    .RANGE("A1:&xHay").SELECT
    .SELECTION.AutoFormat(1,.T.,.T.,.T.,.T.,.T.,.T.)
    *--Color del fondo de encabezado de columnas
    .RANGE("A5:&xEnca").SELECT
    WITH .SELECTION.Interior
      .ColorIndex = 36
      .PATTERN = 1
    ENDWITH
    *--Fuente para la hoja
    .RANGE("A6:&xHay").SELECT
    WITH .SELECTION.FONT
      .NAME = "Arial"
      .SIZE = 9
    ENDWITH
    *--Fuente para el titulo del reporte
    .RANGE("A1:A1").SELECT
    WITH .SELECTION.FONT
      .NAME = "Arial"
      .SIZE = 12
    ENDWITH
    *--Inserta una columna en blanco
    .SELECTION.EntireColumn.INSERT
    IF xCta > 3
      .COLUMNS("A:A").COLUMNWIDTH = 8
    ELSE
      .COLUMNS("A:A").COLUMNWIDTH = 3
    ENDIF
    *---Protege la hoja con password
    IF cProteg
      *--Proteje la hoja
      .ActiveSheet.PROTECT("MaMh,.t.,.t.")
    ENDIF
    .VISIBLE = .T.
  ENDWITH
  WAIT CLEAR
  RETURN
ENDPROC

Gracias Comunidad de VFP en Español y adelante.

Tonny Molina

15 de mayo de 2020

MESSAGEBOX() ejecuta un TRANSFORM() implícito del texto

El primer parámetro aceptado por MESSAGEBOX() es automáticamente transformado (TRANSFORM()) por VFP 7 y superior.

Así que usted puede hacer lo siguiente sin tener que usar TRANSFORM() con el texto del mensaje ni preocuparse de del tipo de datos:

messagebox(datetime()) 
messagebox(123.45) 
messagebox(date()-date(1999,10,01)) 
messagebox(.f.) 
messagebox(.NULL.)

VFP Tips & Tricks - Drew Speedie

1 de mayo de 2020

Añadiendo funcionalidad al Dataexplorer.App

Script que inserta en un formulario en tiempo de diseño un control label y textbox mediante técnica de arrastrar y soltar desde una columna de una base de datos remota usando la aplicación Dataexplorer.app

Hace poco me puse a investigar el Dataexplorer.App y descubrí que se puede configurar algunas características a fin de hacer mas rápido el desarrollo de aplicaciones, en mi caso particular, cuando trabajo con base de datos remota como SQL Server.

Por defecto el Dataexplorer.app al arrastrar desde una columna de la base de datos remota hacia un Form te inserta un control grid junto con el cursoradapter respectivo. En mi caso particular no me sirve ya que en mis desarrollos tengo clases que me crean el entorno de datos para mis formularios. Me sería mas útil que inserte la columna como un control Textbox y su control Label respectivo. Así es que revisando el código fuente del Script que realiza esa funcionalidad, descubrí que se podía modificar, así es que he creado un script que hace lo que necesito.

Aquí les presento el código:

*  <oParameter> = parameter object
*  oParameter members:
*   DropText - populate this with the text to drop
*   Cancel - set to .T. to cancel the drag/drop operation
*   Continue - set to .F. to stop processing additional add-ins
*   oDataExplorerEngine
*   TreeNode
*   RootNode
*   MouseXPos
*   MouseYPos
*   NodeData
*   CurrentNode
*   ParentNode
*   ControlName
*   ClassName
*   ClassLocation
*   PropertyList
*   Caption
*
LPARAMETERS oParameter

LOCAL lcInc, lcName, loSource, laObjs, lcInitCode, lcAutoOpenCode
LOCAL cConnString, oConn, lcTable, lcAlias, lcSelectStr, lcName2,loForm

DIMENSION laObjs[1]
loForm=SYS(1270)

* Check for DE. Only support for forms
lnCount=ASELOBJ(laObjs,2)  && check for DE
IF lnCount = 0 OR TYPE("loForm") <> 'O'
  oParameter.Continue = .T.
  RETURN
ENDIF

* Get Column Name
DO CASE
  
CASE oParameter.CurrentNode.NodeData.Type == "Column"
  * Handle dragdrop from field node in table/view
  lcTable = oParameter.ParentNode.NodeData.Name
  lcTable = IIF(ATC(" ",lcTable)>0,"["+lcTable+"]", lcTable)
  lcAlias = oParameter.ParentNode.NodeData.Name

ENDCASE


IF UPPER(loForm.Baseclass)=="FORM"
  LOCAL iTop as Integer, iLeft as Integer
  iTop  = MROW(0,3)
  iLeft = MCOL(0,3)

  * Control TextBox
  lcInc = ""
             lcName2 = oParameter.ControlName
  lcName2 = CHRTRAN(lcName2," ","_")
  DO WHILE TYPE("loForm." + m.lcName2 + m.lcInc)#"U"
    m.lcInc = ALLTRIM(STR(VAL(m.lcInc)+1))
  ENDDO
  lcName2 = m.lcName2 + m.lcInc
      loForm.NewObject(lcName2, oParameter.ClassName, oParameter.ClassLocation)
      IF PEMSTATUS(loForm.&lcName2, "ControlSource", 5)
      WITH loForm.&lcName2
         .ControlSource = ALLTRIM(lcTable)+"."+ALLTRIM(oParameter.CurrentNode.NodeData.Name)  
         .Top = iTop
         .Left = iLeft + 100
         .Name = left(LOWER(.Name),3)+PROPER(SUBSTR(.Name,4,50))
      ENDWITH
   ENDIF

  * Control Label
  lcIncLbl=""
  lcNameLabel="lbl"+ALLTRIM(oParameter.CurrentNode.NodeData.Name)
  DO WHILE TYPE("loForm." + m.lcNameLabel + m.lcIncLbl)#"U"
    m.lcIncLbl = ALLTRIM(STR(VAL(m.lcIncLbl)+1))
  ENDDO
  lcNameLabel = m.lcNameLabel + m.lcIncLbl
   loForm.addObject(lcNameLabel, "Label")
   IF PEMSTATUS(loForm.&lcNameLabel, "Caption", 5)
      WITH loForm.&lcNameLabel
         .Name = left(LOWER(.Name),3)+PROPER(SUBSTR(.Name,4,50))
         .Top = iTop
         .Left = iLeft
         .Caption = ALLTRIM(oParameter.CurrentNode.NodeData.Name)
         .Autosize = .t.
      ENDWITH
   ENDIF

ENDIF
oParameter.ClassName = ""  
oParameter.Continue = .F.

Con este Script logro insertar en mi formulario en tiempo de diseño un control Textbox junto con su respectivo control label. En el control textbox se configuran la propiedad ControlSource con el nombre de la Tabla y el nombre de la columna (TableName.ColumnName). La propiedad Name se define anteponiendo la palabra "txt" seguido del nombre de la columna de la tabla (txtColumnName). En el caso del control Label la propiedad Caption se define con el nombre de la columna y su propiedad Name se define anteponiendo la palabra "lbl" mas el nombre de la columna de la tabla.

CONFIGURACION

Llamar al Dataexplorer.App desde la ventana de comandos con DO HOME() + "dataexplorer.app"

Hacer Click en el Boton Options y entrar a Manage Drag/Drop. Seleccionar la opción Drag/Drop to Designe Surface e Insertar un nuevo registro haciendo Click en el Boton New.

En la pestaña General poner en el campo Caption una descripción o etiqueta para el script, por ejemplo "SQL/ADO Fields" sin las comillas. Ir a la pestaña Script to Run y poner en el campo Execute Only for the following Nodes (comma - separated) lo siguiente: "ADOColumnNode,SQLColumnNode" sin las comillas y en el campo Code to Execute upon Drop copiar el script mostrado arriba. Grabar haciendo click en el botón Save o Apply.

Ahora lo único que falta es desactivar la funcionalidad que viene por defecto a fin de que se ejecute nuestro nuevo script. Para hacer esto seleccionar de la lista el registro SQL/ADO Tables, Views and Fields. Ir a la pestaña Script to Run y eliminar del campo Execute Only for the following Nodes (comma - separated) las siguientes etiquetas: ADOColumnNode y SQLColumnNode y grabar con Save o Apply.

Espero este Scrip pueda serle útil a la gran comunidad fox.

Saludos.

Miguel Herbias
Lima - Peru

20 de abril de 2020

TRANSFORM() un poquito mas lento que ALLTRIM(STR()), DTOC() y TTOC()

La función TRANSFORM() fue agregada a VFP hace ya algunas versiones, y es mucho mas conveniente que las equivalentes ALLTRIM(STR()), DTOC() y TTOC().

Sin embargo, es también un poquito más lenta como lo demuestra el siguiente código:

CLEAR
LOCAL lnNumber, ldDate, ltTime, lnStart, lnEnd, xx
lcString = "This is a test"
ldDate = DATE()
ltTime = DATETIME()
lnNumber = 123.456

lnStart = SECONDS()
FOR xx = 1 TO 10000
  TRANSFORM(m.lnNumber)
ENDFOR
lnEnd = SECONDS()
? "TRANSFORM(m.lnNumber)", lnEnd-lnStart

lnStart = SECONDS()
FOR xx = 1 TO 10000
  ALLTRIM(STR(m.lnNumber,7,3))
ENDFOR
lnEnd = SECONDS()
? "ALLTRIM(STR(m.lnNumber,7,3))", lnEnd-lnStart
?

lnStart = SECONDS()
FOR xx = 1 TO 10000
  TRANSFORM(m.ldDate)
ENDFOR
lnEnd = SECONDS()
? "TRANSFORM(m.ldDate)", lnEnd-lnStart

lnStart = SECONDS()
FOR xx = 1 TO 10000
  DTOC(m.ldDate)
ENDFOR
lnEnd = SECONDS()
? "DTOC(m.ldDate)", lnEnd-lnStart
?

lnStart = SECONDS()
FOR xx = 1 TO 10000
  TRANSFORM(m.ltTime)
ENDFOR
lnEnd = SECONDS()
? "TRANSFORM(m.ltTime)", lnEnd-lnStart

lnStart = SECONDS()
FOR xx = 1 TO 10000
  TTOC(m.ltTime)
ENDFOR
lnEnd = SECONDS()
? "TTOC(m.ltTime)", lnEnd-lnStart

Sin embargo, a menos que Ud. este codificando un ciclo apretado, la conveniencia de TRANSFORM() compensa lejos su pérdida de rendimiento. TRANSFORM() es solo un poquito mas lento que DTOC() y TTOC(). La diferencia de rendimiento es mayor al comparar TRANSFORM() con ALLTRIM(STR()) para convertir números a cadenas.

VFP Tips & Tricks - Drew Speedie

2 de abril de 2020

Transacciones de Usuarios en Base de Datos

Tuve la necesidad de crear una solución para ver las transacciones que podrían hacer los usuarios, debido a que trabajo con bases e datos de foxpro(DBC) , y se trataba de no meter mas código o funciones en el mismo sistema realizado, si no que el proceso fuera transparente, osea se trata de escribir un código en los procedimientos almacenados de la DBC y esto si crear prg.

1 - Abrir la base de datos a usar

Crear una tabla con con la siguiente información en la base de datos abierta

NOMBRE: HISTORIAL.DBF

Campo  Campo Nombre  Tipo       Ancho  
1      USUARIO       Caracter   20     
2      TIPO          Caracter   20     
3      FECHA         DateTime   8      
4      TABLA         Caracter   30     
5      EQUIPO        Caracter   50     
6      OBSERVA       Memo       4      

Los indices de la tabla pueden ser creados a su consideración para generar reportes o métodos de consulta propios

2 - Ir a las propiedades de la base de datos y activar la casilla de verificación "SET EVENTS ON " y después dar click a el boton "EDIT CODE", después insertar el siguiente código:

PROCEDURE Hsts(clTipo)
  LOCAL clobser
  STORE SPACE(0) TO clObser,clObservaciones,clValor,clDatos
  IF !TYPE("cp_login")="C"
    cp_login="DESCONOCIDO"
  ENDIF
  clAlias=Alias()
  If Empty("clAlias")
    Return
  Endif
  Select (clAlias)
  clRutaHistorico=ADDBS(justpath(CURSORGETPROP("Database")))+"HISTORIAL.DBF"
  USE IN (SELECT("Historial_cfg"))
  nl_error=0
  ON ERROR nl_error=1
  USE (clRutaHistorico) IN 0 SHARED AGAIN Alias Historial_cfg
  ON ERROR
  IF nl_error=0
    clObser="Campos Modificados"+CHR(13)
    FOR Ind=1 TO FCOUNT(clAlias)
      clObser=clObser+"  "+FIELD(Ind)+"=  "
      clValor=ALLTRIM(clAlias)+"."+FIELD(Ind)
      DO Case
        CASE VARTYPE(&clValor) = "N"
          clDatos=STR(&clValor,16,2)
        CASE VARTYPE(&clValor) = "C"
          clDatos=&clValor
        CASE VARTYPE(&clValor) = "D"
          clDatos=DTOC(&clValor)
        CASE VARTYPE(&clValor) = "T"
          clDatos=TTOC(&clValor)
        OTHERWISE
          clDatos=""
      ENDCASE
      clObser=clObser+clDatos+CHR(13)
    NEXT
    clObservaciones=clObser
    SELECT Historial_cfg
    APPEND BLANK
    Replace Historial_cfg.TIPO WITH clTipo,;
      Historial_cfg.FECHA WITH DATETIME(),;
      Historial_cfg.USUARIO WITH Cp_LOGIN,;
      Historial_cfg.TABLA WITH clAlias,;
      Historial_cfg.EQUIPO WITH LEFT(SYS(0),AT("#",SYS(0))-1),;
      Historial_cfg.OBSERVA WITH clObservaciones
    USE IN (SELECT("Historial_cfg"))
  ENDIF
  IF !EMPTY(clalias)
    SELECT &clAlias
  ENDIF
  ON ERROR
  RETURN
ENDPROC

3 - En la tablas importantes en donde se requiera el registro de transacciones se realizar lo siguiente modificar datos de la tabla, y ir a la pestaña "Table" y en cada Triggers insertar el siguiente código

Insert Trigger = Hsts("AGREGAR")
update Trigger = Hsts("MODIFICAR")
delete Trigger = Hsts("ELIMINAR")

4 - Listo después de esto entonces cada transacción se estará grabando el la tabla de Historial, solo faltaría hacer un reporte para visualizar informacion del historial

Mauricio Mijangos Villalobos

26 de marzo de 2020

Recorrer una planilla Excel desde VFP

Con este código podemos recorrer una Planilla de Excel desde Visual FoxPro y ver el contenido de todas sus celdas.

*-- Creo el objeto Excel
loExcel = CREATEOBJECT("Excel.Application")
WITH loExcel.APPLICATION
  .VISIBLE = .F.
  *-- Abro la planilla con datos
  .Workbooks.OPEN("C:\MiPlanilla.xls")
  *-- Cantidad de columnas
  lnCol = .ActiveSheet.UsedRange.COLUMNS.COUNT
  *-- Cantidad de filas
  lnFil = .ActiveSheet.UsedRange.ROWS.COUNT
  *-- Recorro todas las celdas
  FOR lnI = 1 TO lnCol
    FOR lnJ = 1 TO lnFil
      ? CHR(lnI+64) + ALLTRIM(STR(lnJ)) + ': '
      ?? .activesheet.cells(lnJ,lnI).VALUE
    ENDFOR
  ENDFOR
  *-- Cierro la planilla
  .Workbooks.CLOSE
  *-- Salgo de Excel
  .Quit
ENDWITH
RELEASE loExcel

Al recorrerla también podemos cambiar los valores de las celdas, solo deberiamos guardar los cambios antes de cerrar la planilla con:

loExcel.APPLICATION.activeworkbook.SAVE

24 de marzo de 2020

Agregar un campo Memo a un cursor

Como agregar un campo Memo a un cursor resultado de un comando SELECT-SQL fue preguntado varias veces en el Grupo de Noticias de Visual FoxPro en Español, veamos como hacerlo.

Hugo Ranea nos indica que partir de VFP9 disponemos de la función CAST() que nos hace muy fácil la tarea en una sola línea de código:

OPEN DATABASE (HOME(2) + "\Data\TestData")

SELECT Company, CAST("" as Memo) AS CampoMemo ;
  FROM Customer ;
  INTO CURSOR curVFP9

BROWSE

En versiones anteriores de VFP también podemos añadir un campo Memo a un cursor mediante un pequeño truco que es crear un cursor temporal con un campo Memo y un solo registro; y combinarlo con nuestra consulta:

OPEN DATABASE (HOME(2) + "\Data\TestData")

CREATE CURSOR Temporal (CampoMemo M)
APPEND BLANK IN Temporal

SELECT Customer.Company, Temporal.* ;
  FROM Customer, Temporal ;
  INTO CURSOR curVFPx

BROWSE

Sobre este mismo tema hay artículos en este Blog que vale la pena leerlos y recordarlos:

-- Agregar Columnas a Cursores VFP --

-- Agregar columnas en sentencias SELECT SQL --

 

10 de marzo de 2020

Truco: Agregar Columnas a Cursores VFP

A partir de VFP7 han cambiado algunas cosas, por ejemplo, no es posible utilizar la función ALTER TABLE < TuCursor > ADD COLUMN si es que tu cursor en cuestión tiene algún campo cuyo nombre tiene mas de 10 caracteres, aquí te mostramos como darle solución...

Veamos un ejemplo clásico, tienes un cursor generado por un SELECT-SQL, el cual, además de que deseas que sea editable, poder agregarle una columna para anotaciones, bueno, me podrás decir, en el mismo cursor agregale el campo... Pero que pasaría si deseo que dicho campo sea de tipo Memo??

La solución aparente podría ser utilizar el comando ALTER TABLE.... Pero esto, ya no es posible...

**** Creamos el cursor, nombres largos...
SELECT * FROM (HOME(2)+"NorthwindEmployees") ;
    INTO CURSOR MiCursor READWRITE
ALTER TABLE MiCursor ADD COLUMN CampoMemo M 

El código anterior generaría un error 1115 : Invalid operation for the cursor.

Esto se debe a que supuestamente no es posible hacer este tipo de operación cuando, el cursor generado por SELECT-SQL (o cualquier otro cursor, no tablas DBFs contenidas en DBCs) contiene algún campo con un nombre de mas de 10 caracteres. Esto según la documentación del producto

"... ALTER TABLE puede no producir los resultado esperados al ser utilizado con cursores creados por el comando CREATE CURSOR. Particularmente, puede crear cursores Visual FoxPro con características como, nombres largos de tablas, que normalmente están disponibles sola para las tablas que son parte de un contenedor de base de datos. ALTER TABLE guarda temporalmente una copia del cursor, que se apliquen las reglas a las tablas libres, y que cualquier característica soportada por la base de datos se pierda o cambie de manera impredecible. Por lo tanto, debe evitar utilizar ALTER TABLE con cursores Visual FoxPro, a menos que haya comprobado o entendido el resultado ...."

Otro ejemplo de esto sería algo tan sencillo como esto:

**** Con esto no obtenemos error ****
CREATE CURSOR cTest (iid int)
ALTER TABLE cTest ADD COLUMN CampoMemo M

**** Pero si intentamos esto  ******
CREATE CURSOR cTest2 (Masde10letras int)
ALTER TABLE cTest2 ADD COLUMN CampoMemo M 

Bueno, ya hemos demostrado cuándo y cómo falla, ahora iremos directo a una solución... La cual es, hacer una proyección de tu cursor, junto con otro cursor que tenga nada mas que el o los campos que deseas agregar, esto a través de una cláusula SELECT-SQL, como se muestra a continuación:

**** Creamos el cursor, nombres largos...
SELECT * FROM (HOME(2)+"NorthwindEmployees") ;
    INTO CURSOR MiCursor 
**** Creamos un cursor Dummie con el tipo de datos buscado, por ejemplo, un campo Memo  ****
**** e insertamos un registro en blanco ****
CREATE CURSOR Dummie (CampoMemo M)
APPEND BLANK  IN "Dummie"
**** Juntamos los dos cursores forzando su unión ****
SELECT * FROM MiCursor, Dummie ;
      INTO CURSOR MiCursor READWRITE
BROW

Con esto ya tenemos lo que deseabamos, aunque quizás sea un poco mas laborioso, al final, se llega al objetivo deseado.

Además, esta misma técnica puede ser utilizada para simplificar el agregar varias columnas, con sólo tres instrucciones, considerando que de otra manera se tendrían que utilizar varias instrucciones ALTER TABLE (cuando fuere posible) :

**** Creamos un cursor de prueba ****
CREATE CURSOR miEjemplo (iid int)
**** Creamos el cursor con los campos a agregar ****
CREATE CURSOR cAgregar (cName char(80), cEmail char(60), cNotes M)
APPEND BLANK IN "cAgregar"
SELECT * FROM MiEjemplo, cAgregar ;
     INTO CURSOR miEjemplo READWRITE

Espero les sea de utilidad.

Esparta Palma

22 de febrero de 2020

Instalar versiones nuevas de ejecutables de VFP

Instalar versiones nuevas de ejecutables de VFP.

Autor: Mike Lewis
Texto original:
-- Installing new copies of VFP executables --
http://www.ml-consult.co.uk/foxst-30.htm
Traducido por: Ana María Bisbé York


¿Cómo instalar el archivo EXE actualizado sin forzar a los usuarios a cerrar su aplicación?

¿Alguna vez ha necesitado instalar una copia nueva de un archivo .EXE después que la aplicación empezó a funcionar? Si le ha ocurrido, sabrá que no puede simplemente copiar el nuevo archivo sobre el existente. Si trata de hacerlo mientras los usuarios están corriendo la aplicación, Windows reportará “Violación de archivos compartidos”. Su única solución es esperar a que todos hayan finalizado su sesión, lo cual puede ser inconveniente.

Andew Connor, el IT Manager en Mids & Horsey Ltd en el Reino Unido, ha llegado a una simple solución a este problema. Andrew sugiere que suministre un pequeño lanzador de programa el que busca el EXE con la versión más reciente. Una vez encontrado, toma el control del fichero que hasta ahora ejecuta la aplicación.

El programa lanzador es un sencillo programa de VFP. Es completamente genérico, no necesita saber el nombre del archivo EXE o del directorio que lo contiene. Sin embargo, es necesario seguir normas sencillas para nombrar los archivos.

Nombrar los archivos

El programa lanzador debe ser compilado a un archivo EXE, su nombre debe ser igual al de la aplicación principal. Este es el archivo que los usuarios van a lanzar cuando deseen correr la aplicación.

El nombre del archivo EXE actual de la aplicación debe contener además dos dígitos numéricos para la versión. Es decir, si la aplicación se llama Ventas, el programa lanzador se llamará Ventas.EXE. El archivo EXE principal de la aplicación puede llamarse entonces Ventas01.EXE, Ventas02.EXE, y así sucesivamente. Cada vez que desee distribuir una nueva versión del EXE principal, solo necesita cambiar el número de la versión.

Sus números de versión pueden ser cualquiera que decida, no es necesario que sean consecutivos o en orden ascendente. Pero deben tener exactamente dos dígitos.

Asegúrese de colocar el lanzador en el mismo directorio que el archivo ejecutable principal. Luego configúrelo para que los usuarios ejecuten el lanzador cuando deseen correr la aplicación.

El código

Aquí está el código para el programa lanzador. Puede pegarlo en un archivo de programa PRG y luego compilarlo y generar un .EXE

* Programa Lanzador (genérico).
LOCAL lcExecPath, lcFileName, lcSkeleton, lnFileCount
LOCAL lcExe, ltLatest, lnI
LOCAL ARRAY laFiles(1)
* Toma la ruta del directorio del archivo ejecutable
lcExecPath = JUSTPATH(SYS(16))
* Establece este directorio como predeterminado (Default)
SET DEFAULT TO (lcExecPath)
* Toma la raíz del nombre del archivo ejecutable
lcFileName = JUSTSTEM(SYS(16))
* Crea una matriz con los nombres de los EXEs posibles
lcSkeleton = lcFileName+"??.EXE"
&& lcSkeleton es un archivo comodín
&& para ADIR()
lnFileCount = ADIR(laFiles,lcSkeleton)
* Busca el archive EXE más reciente
lcEXE = ""
ltLatest = {}
FOR lnI = 1 TO lnFileCount
  IF FDATE(laFiles(lnI,1),1) > ltLatest
    ltLatest = FDATE(laFiles(lnI,1),1)
    lcExe = laFiles(lnI,1)
  ENDIF
ENDFOR
* Lanza la ejecución del EXE más reciente.
IF NOT EMPTY(lcExe)
  DO (lcEXE)
ENDIF

Como puede ver, el programa lanzador crea un arreglo que contiene los nombres de todos los archivos EXE que cumplan con la convención de nombre. Luego toma el control del más reciente de estos archivos.

Actualizar la aplicación

A partir de ahora, cuanto desee distribuir una nueva versión de su aplicación, puede copiar el EXE actualizado dentro del directorio donde están los ejecutables. Esto se puede hacer incluso si hay usuarios trabajando en la aplicación debido a que tendrá diferente número de versión que el archivo existente. La próxima vez que el usuario llame la aplicación, el lanzador encontrará automáticamente la versión correcta. En caso necesario, puede borrar la versión anterior.

Mike Lewis Consultants Ltd. Mayo 2003

18 de febrero de 2020

Obtener configuracion regional mediante API

Rutina para obtener la configuracion regional de Windows mediante API.

DIMENSION aDatos(1)
? GetConfiRegi( @aDatos )
DISPLAY MEMORY LIKE aDatos

*-------------------------------------------------------
* Retorna en una array pasado por referencia, algunos
* valores de la configuración regional
* PARAMETROS: aDatos
* USO:  DIMENSION aDatos(1)
*       GetConfiRegi( @aDatos )
* DEVUELVE: aDatos(1) = Símbolo decimal
*    aDatos(2) = Símbolo separador de miles
*    aDatos(3) = Número de dígitos decimales
*    aDatos(4) = Símbolo de signo negativo
*    aDatos(5) = Formato de números negativos
*-------------------------------------------------------
FUNCTION GetConfiRegi(aDatos)
  #DEFINE LOCALE_USER_DEFAULT  0x400 && 1024
  #DEFINE LOCALE_SDECIMAL  0xE
  #DEFINE LOCALE_STHOUSAND  0xF
  #DEFINE LOCALE_IDIGITS 0x11
  #DEFINE LOCALE_SNEGATIVESIGN  0x51
  #DEFINE LOCALE_INEGNUMBER  0x1010
  LOCAL sRetval AS STRING, nRET AS LONG
  IF PCOUNT() < 1 THEN
    RETURN .F.
  ENDIF
  DECLARE LONG GetLocaleInfo IN WIN32API  LONG LOCALE, ;
    LONG LCTYPE, STRING LPLCDATA, LONG CCHDATA
  DIMENSION aDatos(5)
  FOR nRET = 1 TO 5
    m.aDatos(nRET) = ""
  NEXT
  m.sRetval = REPLICATE(CHR(0),256)
  * Símbolo decimal
  m.nRET = GetLocaleInfo(LOCALE_USER_DEFAULT, ;
    LOCALE_SDECIMAL, @sRetval, LEN(m.sRetval))
  IF m.nRET > 0 THEN
    m.aDatos(1) = LEFT(m.sRetval,m.nRET-1)
  ENDIF
  m.sRetval = REPLICATE(CHR(0),256)
  * Símbolo separador de miles
  m.nRET = GetLocaleInfo(LOCALE_USER_DEFAULT, ;
    LOCALE_STHOUSAND, @sRetval,LEN(m.sRetval))
  IF m.nRET > 0 THEN
    m.aDatos(2) = LEFT(m.sRetval,m.nRET-1)
  ENDIF
  m.sRetval = REPLICATE(CHR(0),256)
  * Número de dígitos decimales
  m.nRET = GetLocaleInfo(LOCALE_USER_DEFAULT, ;
    LOCALE_IDIGITS, @sRetval,LEN(m.sRetval))
  IF m.nRET > 0 THEN
    m.aDatos(3) = LEFT(m.sRetval,m.nRET-1)
  ENDIF
  m.sRetval = REPLICATE(CHR(0),256)
  * Símbolo de signo negativo
  m.nRET = GetLocaleInfo(LOCALE_USER_DEFAULT, ;
    LOCALE_SNEGATIVESIGN, @sRetval,LEN(m.sRetval))
  IF m.nRET > 0 THEN
    m.aDatos(4) = LEFT(m.sRetval,m.nRET-1)
  ENDIF
  m.sRetval = REPLICATE(CHR(0),256)
  * Formato de números negativos
  m.nRET = GetLocaleInfo(LOCALE_USER_DEFAULT, ;
    LOCALE_SNEGATIVESIGN, @sRetval,LEN(m.sRetval))
  IF m.nRET > 0 THEN
    m.aDatos(5) = LEFT(m.sRetval,m.nRET-1)
    DO CASE
      CASE m.aDatos(5) = "0"
        m.aDatos(5) = "(1.1)"
      CASE m.aDatos(5) = "1"
        m.aDatos(5)= " -1.1"
      CASE m.aDatos(5) = "2"
        m.aDatos(5) = "- 1.1"
      CASE m.aDatos(5) = "3"
        m.aDatos(5) = "1.1-"
      CASE m.aDatos(5) = "4"
        m.aDatos(5) = "1.1 -"
    ENDCASE
  ENDIF
ENDFUNC
*-------------------------------------------------------

21 de enero de 2020

Chequear si una conexión a internet esta activa

La mejor manera para chequear si una conexión a Internet se encuentra disponible es beneficiarse de un acceso PING. He aquí una función pequeña que recibe una dirección de servidor como parámetro para chequear si una conexión a Internet se encuentra disponible. Nótese que puede ser que usted quiera especificar otra dirección de servidor y así asegurarse probando con otro servidor

? CheckInternetConnection("http://www.google.com")

FUNCTION CheckInternetConnection
LPARAMETERS tcWebAddress
DECLARE Integer InternetCheckConnection ;
   IN WININET.DLL ;
   String Url, Long dwFlags, Long Reserved
IF InternetCheckConnection(tcWebAddress,1,0) # 0
   RETURN .T.
ELSE
   RETURN .F.
ENDIF

6 de enero de 2020

La programación orientada a objetos (OOP) directa: enlace de eventos y acoplamiento flexible

La programación orientada a objetos (OOP) directa: enlace de eventos y acoplamiento flexible


Artículo original: The Straight OOP: Event binding and loose coupling
Autor: Nancy Folsom
Traduccion: Luis María Guayán


Este mes eche un vistazo a una nueva característica en VFP 8.0 y la relaciono con el concepto de programación orientada a objetos de acoplamiento flexible.

Lo siento, pero me temo que esto tiene clasificación para Publico General, por lo que este artículo no será así. En este contexto, el acoplamiento se refiere al grado de dependencia entre objetos. Si hay poca dependencia, entonces un sistema está débilmente acoplado. Si los objetos se refieren directamente a otros objetos, entonces están estrechamente acoplados. Siempre ha habido al menos cierta dependencia entre los contenedores y sus objetos contenidos, aunque ha sido posible eliminar la mayoría, si no toda, la dependencia entre los objetos dentro de un contenedor, ya sea una clase de control, contenedor, formulario, etc.

¿Por qué? Una de las primeras preguntas con las que la mayoría de la gente se encuentra cuando comienza a usar Visual FoxPro es el problema de lo que sucede cuando se cambia el nombre, o incluso se elimina, un objeto en un contenedor al que se refieren otros objetos. Cuando los objetos están estrechamente acoplados, es difícil cambiar su comportamiento, cambiarlos por otros objetos y rastrear errores, ya que puede ser difícil encontrar en qué parte de la jerarquía de objetos se esconde el problema.

¿Dónde entra el acoplamiento?


La mayoría de nosotros creamos formularios detallados de entrada de datos que realizan una serie de tareas comunes. Los usuarios pueden ingresar datos, cambiar datos, guardar o deshacer ediciones, y podrían bloquear un registro contra la edición. La Figura 1 muestra un ejemplo simple de un formulario de entrada de datos.


Figura 1 Estado de la interfaz de usuario cuando se abre un formulario por primera vez en modo de edición

Para ayudar a los usuarios a tomar decisiones sensatas, es útil deshabilitar los botones que no tienen sentido en un contexto dado. En el ejemplo, una vez que se modifican los datos, se habilitan los botones Guardar y Deshacer, lo que indica al usuario que hay cambios pendientes. La figura 2 muestra este estado. Si hago clic en el botón Editar para bloquear los datos de la edición accidental, los campos de datos se deshabilitan, como muestra la Figura 3.


Figura 2 Estado de los elementos de la interfaz de usuario cuando los datos han cambiado


Figura 3 Vista de la interfaz de usuario después de desactivar el modo de edición


Miembros coordinadores


La coordinación de varios elementos en el formulario que tienen que interactuar y, sin embargo, son componentes independientes puede ser difícil de implementar para que las dependencias sean mínimas. En el ejemplo, el contenedor que tiene los datos es una unidad lógica, y el contenedor de botones es otra. Los botones deben ser reutilizables en cualquier formulario de entrada de datos, y los datos existirán independientemente de las acciones que puedan estar disponibles. Hay una tercera unidad formada por la relación entre el contenedor del botón y el contenedor de datos.

La relación entre los datos y las funciones disponibles (Guardar, Deshacer, Editar) está representada por el formulario, en este ejemplo. El formulario coordinará los dos contenedores. Cuanto menos se conozcan los dos contenedores, mejor será la reutilización. Es posible que desee guardar (o deshacer) los cambios no solo en datos relacionados con la persona, sino también en modelos de automóviles, artículos de inventario, etc. El contenedor de datos relacionados con la persona puede reutilizarse en una página en un marco de página, mostrarse como de solo lectura para informes, etc. Cada clase tiene algunas responsabilidades fundamentales. El contenedor de botones debe ser capaz de habilitar y deshabilitar botones, y debe tener algún método que sea paralelo a la funcionalidad representada por los botones. En otras palabras, el contenedor de botones tendrá un método para cada una de las funciones de los botones que los botones pueden llamar cuando se hace clic en ellos.

¿Por qué no poner la funcionalidad en el botón? Podría decirse que el primer paso para lograr el estado iluminado de acoplamiento débil es eliminar las referencias que los objetos hacen a los objetos contenidos dentro de otro contenedor. Entonces, por ejemplo, elimine referencias como las siguientes:

*!* SomeForm.SomePageFrame.SomePage.SomeButton.Click()
THIS.PARENT.Page2.Text1.VALUE = "I've changed!"

En cambio, deje que los contenedores simplemente notifiquen al mediador (el formulario) que algo ha ocurrido, pero luego deje que el formulario haga algo con la información. El Listado 1 muestra una forma simplista de desacoplar el botón y los contenedores de datos en un formulario de entrada de datos. En este escenario, un formulario tiene dos contenedores: uno muestra datos de un registro y el otro contenedor tiene 3 botones para Guardar, Deshacer y Editar. Cuando se modifican los datos, se habilitan los botones Guardar y Deshacer. Cuando el modo de Editar es falso, los objetos de datos están deshabilitados. Cuando se guardan o invierten los cambios, los botones Guardar y Deshacer deben deshabilitarse y los datos deben guardarse o revertirse. Cuando el modo Editar está desactivado, se guardan los cambios pendientes. Entonces, en resumen, los botones y los objetos de datos tienen efectos más allá de sus responsabilidades inmediatas. Para lograr esto, los botones pasan sus mensajes a su contenedor propietario, que pasa los mensajes al formulario, que luego pasa los mensajes al contenedor de datos, que, finalmente, hace algo (o no) con el objetos de datos.

Irónicamente, para desacoplar la lógica en un cuadro de texto de Apellido de la lógica en un botón Guardar, deben involucrarse muchos objetos. Sin embargo, es solo una aparente ironía. Cualquier acoplamiento apretado ocurre entre un objeto y su padre, lo cual es aceptable siempre que el contenedor sea el único responsable de comunicarse con el mundo. Sin embargo, hay muchos acoplamientos ajustados, sin embargo.

La lista de códigos muestra que los contenedores tienen métodos que son paralelos a los eventos que mediarán. Cuando se hace clic en el botón Guardar, llama al método Guardar del contenedor de botones, que llama al Guardar del mediador. El mediador (el formulario) llama a Save() del contenedor de datos. Esto es lo que quiero decir cuando digo un acoplamiento perfecto.

Aunque el contenedor de botones y el contenedor de datos en este ejemplo están desacoplados, todavía hay más dependencia entre el formulario y los contenedores de lo que es cómodo. Primero, es difícil obtener la sincronización correcta (es mejor implementar un bit de funcionalidad a la vez y probarlo), segundo, es difícil recordar en qué lugar de la jerarquía se coloca el código crítico y, tercero, si desea soltar el contenedor del botón en un formulario diferente, por ejemplo, debe asegurarse de que los métodos de mediación (como Guardar) estén presentes.


Enlace de eventos (Event binding)


Afortunadamente, Visual FoxPro 8.0 nos permite desacoplar la lógica de mensajería compleja como en mi ejemplo anterior, al permitirnos generar, vincular y encadenar eventos juntos. Incluso podemos tratar los eventos como objetos. Primero, deja yo retrocedo un momento rápido. Los eventos son diferentes de los métodos de esta manera: los eventos ocurren automáticamente, bajo ciertas circunstancias. Los métodos solo se ejecutan cuando los invocamos mediante programación, por ejemplo. Todavía se pueden llamar eventos como se invocarían métodos, pero es mejor no hacerlo.

Los eventos solo deberían ejecutarse cuando VFP crea que deberían ejecutarse. Entonces, en lugar de llamar al clic de un botón, por ejemplo, es mejor tener un método de nivel de formulario llamado, por ejemplo, OnClick() que pueden llamar tanto su código en otro lugar como el evento Click() del botón. En el ejemplo anterior, los botones Guardar y Deshacer llaman al código del método en el contenedor que guarda o revierte los cambios, respectivamente.

El enlace de eventos significa que podemos asociar los eventos que ocurren en un objeto con eventos en otro objeto. No es necesario que los eventos tengan el mismo nombre en ambos objetos. Hay algunas complejidades en la sintaxis y el uso, que no son el tema de este artículo en particular.

Lo que es importante tener en cuenta con respecto al acoplamiento es que mi mediador ahora puede reemplazar todos sus métodos personalizados para Guardar, Deshacer, etc., y los contenedores pueden ignorar la notificación a un padre sobre eventos. Depende del mediador configurar el enlace del evento entre los objetos. Veamos un ejemplo. El listado 2 reescribe el primer ejemplo para hacer uso de la función BindEvent(), nueva en VFP 8.0. Las diferencias críticas entre las dos metodologías es que los contenedores no tienen métodos paralelos que contengan objetos que llaman cuando su estado cambia, y hay menos necesidad de métodos de acceso y asignación. Estos son algunos de los fragmentos de código relevantes de la lista.

LOCAL loForm AS FORM
loForm = NEWOBJECT("BindEvents")
loForm.SHOW(1)
DEFINE CLASS BindEvents AS FORM
  ...

  PROCEDURE INIT
    *!* Set up event bindings.
    *!* When the edit button is clicked, trigger the data container's enable method.
    BINDEVENT(THIS.objDataCmd,"SetEdit",THIS.objPerson,"EnableControls",2)
    *!* If we're switching out of edit mode, save any changes.
    BINDEVENT(THIS.objDataCmd,"SetEdit",THIS.objDataCmd,"Save",2)
    *!* When data is being changed, trigger the button container refresh.
    BINDEVENT(THIS.objPerson,"OnChange",THIS.objDataCmd,"OnChange",2)
    *!* When Save is clicked, trigger the data container to save.
    BINDEVENT(THIS.objDataCmd,"Save",THIS.objPerson,"Save",2)
    *!* When Undo is clicked, trigger the data
    *!* container to revert changes.
    BINDEVENT(THIS.objDataCmd,"Undo",;
      THIS.objPerson,"Undo",2)
  ENDPROC
ENDDEFINE

Si bien el formulario todavía tiene dos contenedores: uno con botones y otro con objetos de datos, el formulario ya no necesita tener métodos paralelos coincidentes (como Guardar). En cambio, el formulario establece la relación entre los datos y los botones al relacionar los dos métodos relevantes en los contenedores. Observe también que los eventos pueden estar vinculados a más de un evento. En el ejemplo anterior, SetEdit guardará y habilitará controles. Esto está al más alto nivel. Incluso dentro de los contenedores, el enlace de eventos simplifica la tarea de los objetos comunicándose con sus padres.

Agregué un método personalizado al contenedor de botones para Guardar, Deshacer y Editar llamado BindEvents(), al que llamo desde Init(). Este método permite que el contenedor se enganche en los eventos interesantes de los botones. En este caso, se notifica al contenedor cuando cambia el modo Editar y cuando se hace clic en Guardar o Deshacer. Los eventos de clic Guardar y Deshacer ni siquiera tienen ningún código en ellos.

DEFINE CLASS DataCommands AS CONTAINER
  ...

  PROCEDURE BindEvents
    *!* Instead of button's click() calling a
    *!* method in the parent container. Simply
    *!* use the edit button's own event to trigger
    *!* the parent to some action.
    BINDEVENT(THIS.btnEdit,"InteractiveChange",;
      THIS,"SetEdit",2)
    BINDEVENT(THIS.btnEdit,"ProgrammaticChange",;
      THIS,"SetEdit",2)
    BINDEVENT(THIS.btnUndo,"Click",THIS,"Undo",2)
    BINDEVENT(THIS.btnSave,"Click",THIS,"Save",2)
  ENDPROC

Hago algo similar con el contenedor de datos. Ato un método contenedor de cliente (OnChange) a los eventos InteractiveChange() de cada TextBox. Entonces, en lugar de llamar al método personalizado EntityContainer.OnChange desde TextBox InteractiveChange(), EntityContainer define, una vez, que los eventos InteractiveChange() ejecutarán no solo cualquier código que pueda estar en ellos, sino también el método OnChange(). En este caso, el método OnChange() no hace nada, sin embargo, el formulario puede vincular este método al método del contenedor de botones, llamado OnChange(), casualmente, que habilita los botones Guardar y Deshacer cuando hay cambios pendientes.


¿Por qué es esto algo bueno?


BindEvent() nos lleva un paso más cerca de implementaciones poco acopladas. Las clases se pueden escribir para administrar su propia unidad de trabajo, sin tener que estar diseñadas para pasar acciones y mensajes a un padre, que luego pasa la acción o el mensaje a otros objetos. La misma funcionalidad se logra simplemente uniendo los eventos en el contexto en el que cooperan, como en un formulario. Además, esto significa que incluso nuestro código de tiempo de ejecución puede, sobre la marcha, crear enlaces de eventos para un sistema dinámico. Y los controladores de eventos se pueden objetivar y, por lo tanto, adjuntar a los objetos tal como nos estamos acostumbrando a hacer con las reglas comerciales. Visual FoxPro 7.0 y ahora 8.0 ofrecen cada vez más formas de implementar la orientación a objetos en nuestras aplicaciones.


Listado de programas


Listado 1

LOCAL loForm AS FORM
loForm = NEWOBJECT("NoBindEvents")
loForm.SHOW(1)
DEFINE CLASS NoBindEvents AS FORM
  HEIGHT = 170
  WIDTH = 334
  CAPTION = "Acoplamiento suelto sin BindEvents"
  EditMode = .T.
  DirtyBuffer = .F.
  NAME = "NoBindEvents"
  *!* Container responsible for displaying data
  ADD OBJECT ObjPerson AS EntityContainer WITH ;
    TOP = 20, ;
    LEFT = 38, ;
    NAME = "objPerson", ;
    Label1.NAME = "Label1", ;
    Label2.NAME = "Label2", ;
    txtFirst.NAME = "txtFirst", ;
    txtLast.NAME = "txtLast"
  *!* Container responsible for managing buttons that can
  *!* trigger actions
  ADD OBJECT ObjDataCmd AS DataCommands WITH ;
    TOP = 100, ;
    LEFT = 38, ;
    NAME = "objDataCmd", ;
    btnEdit.NAME = "btnEdit", ;
    btnUndo.NAME = "btnUndo", ;
    btnSave.NAME = "btnSave"
  *!* When the edit mode changes, alert the data container
  PROCEDURE EditMode_Assign
    LPARAMETERS vNewVal
    THIS.EditMode = m.vNewVal
    THIS.ObjPerson.EnableControls(m.vNewVal)
  ENDPROC
  *!* Method parallels container actions. Used for mediation.
  PROCEDURE SAVE
    THIS.ObjPerson.SAVE()
  ENDPROC
  *!* Method parallels container actions. Used for mediation.
  PROCEDURE UNDO
    THIS.ObjPerson.UNDO()
  ENDPROC
  PROCEDURE DirtyBuffer_Assign
    LPARAMETERS vNewVal
    THIS.ObjDataCmd.OnChange()
  ENDPROC
  *!* One of the significant (public) events is when data changes.
  PROCEDURE ObjPerson.DirtyBuffer_Assign
    LPARAMETERS vNewVal
    STORE m.vNewVal TO ;
      THIS.DirtyBuffer, ;
      THIS.PARENT.DirtyBuffer
  ENDPROC
  *!* One of the significant (public) events is when the edit mode changes.
  PROCEDURE ObjDataCmd.EditMode_Assign
    LPARAMETERS vNewVal
    STORE vNewVal TO THIS.EditMode, THIS.PARENT.EditMode
  ENDPROC
  *!* When Undo is selected, the button container first tells the
  *!* mediator (form), so it can do whatever it needs to, and then
  *!* the container takes care of its internal business. In this case,
  *!* the container resets the buttons' enabled property.
  PROCEDURE ObjDataCmd.UNDO
    THIS.PARENT.UNDO()
    DODEFAULT()
  ENDPROC
  *!* When Save is selected, the button container first tells the
  *!* mediator (form), so it can do whatever it needs to, and then
  *!* the container takes care of its internal business. In this case,
  *!* the container resets the buttons' enabled property.
  PROCEDURE ObjDataCmd.SAVE
    THIS.PARENT.SAVE()
    DODEFAULT()
  ENDPROC
ENDDEFINE
*!* Container of Save, Undo, and Edit buttons...like a CommandGroup
DEFINE CLASS DataCommands AS CONTAINER
  WIDTH = 271
  HEIGHT = 49
  EditMode = .T.
  NAME = "DataCommands"
  DirtyBuffer = .F.
  *!* Uncheck Edit to lock the data against edits
  ADD OBJECT btnEdit AS CHECKBOX WITH ;
    TOP = 10, ;
    LEFT = 180, ;
    HEIGHT = 27, ;
    WIDTH = 79, ;
    CAPTION = "\<Editar", ;
    VALUE = .T., ;
    CONTROLSOURCE = "THIS.PARENT.EditMode", ;
    STYLE = 1, ;
    NAME = "btnEdit"
  *!* Button will undo changes since the last save
  ADD OBJECT btnUndo AS COMMANDBUTTON WITH ;
    TOP = 10, ;
    LEFT = 12, ;
    HEIGHT = 27, ;
    WIDTH = 84, ;
    CAPTION = "\<Deshacer", ;
    ENABLED = .F., ;
    NAME = "btnUndo"
  *!* Save pending changes
  ADD OBJECT btnSave AS COMMANDBUTTON WITH ;
    TOP = 10, ;
    LEFT = 96, ;
    HEIGHT = 27, ;
    WIDTH = 84, ;
    CAPTION = "\<Guardar", ;
    ENABLED = .F., ;
    NAME = "btnSave"
  *!* Provide Assign methods to properties that
  *!* represent significant (i.e. public) events. This is
  *!* helpful for leaving a hook for a container to tell a
  *!* mediator that something has happened.
  PROCEDURE EditMode_Assign
    LPARAMETERS vNewVal
    THIS.EditMode = m.vNewVal
  ENDPROC
  *!* Dirty buffer is a logical property reflecting whether
  *!* there are any changes to the data.
  PROCEDURE DirtyBuffer_Assign
    LPARAMETERS vNewVal
    THIS.DirtyBuffer = m.vNewVal
  ENDPROC
  *!* Only enable save and undo buttons if there are changes
  *!* to save or undo.
  PROCEDURE OnChange
    STORE .T. TO ;
      THIS.btnUndo.ENABLED, ;
      THIS.btnSave.ENABLED
  ENDPROC
  *!* Set the edit mode of the data (lock data against edits)
  PROCEDURE setedit
    LPARAMETERS tlEditMode
    THIS.EditMode = tlEditMode
  ENDPROC
  *!* In real life, the container might notify the
  *!* business object to save.
  PROCEDURE SAVE
    STORE .F. TO THIS.DirtyBuffer
    THIS.OnSave()
  ENDPROC
  *!* In real life, the container might notify the
  *!* business object to undo changes.
  PROCEDURE UNDO
    STORE .F. TO THIS.DirtyBuffer
    THIS.OnSave()
  ENDPROC
  *!* Once changes are saved or reversed, there aren't any more
  *!* pending changes, so disable these buttons.
  PROCEDURE OnSave
    STORE .F. TO THIS.btnUndo.ENABLED, THIS.btnSave.ENABLED
  ENDPROC
  *!* Container buttons simply call the container's parallel method
  PROCEDURE btnUndo.CLICK
    THIS.PARENT.UNDO()
  ENDPROC
  PROCEDURE btnSave.CLICK
    THIS.PARENT.SAVE()
  ENDPROC
ENDDEFINE
*!* Container of data objects, for editing, viewing, and so on.
DEFINE CLASS EntityContainer AS CONTAINER
  WIDTH = 227
  HEIGHT = 64
  NAME = "EntityContainer"
  DirtyBuffer = .F.
  *!* The usual textboxes and labels for displaying or editing
  *!* a first name and a last name.
  ADD OBJECT Label1 AS LABEL WITH ;
    BACKSTYLE = 0, ;
    CAPTION = "Nombre", ;
    HEIGHT = 17, ;
    LEFT = 19, ;
    TOP = 14, ;
    WIDTH = 60, ;
    NAME = "Label1"
  ADD OBJECT Label2 AS LABEL WITH ;
    BACKSTYLE = 0, ;
    CAPTION = "Apellido", ;
    HEIGHT = 17, ;
    LEFT = 117, ;
    TOP = 14, ;
    WIDTH = 60, ;
    NAME = "Label2"
  ADD OBJECT txtFirst AS TEXTBOX WITH ;
    HEIGHT = 23, ;
    LEFT = 14, ;
    TOP = 30, ;
    WIDTH = 100, ;
    VALUE = "Grace", ;
    NAME = "txtFirst"
  ADD OBJECT txtLast AS TEXTBOX WITH ;
    HEIGHT = 23, ;
    LEFT = 115, ;
    TOP = 30, ;
    WIDTH = 100, ;
    VALUE = "Hopper", ;
    NAME = "txtLast"
  PROCEDURE EnableControls
    LPARAMETERS tlEnable
    STORE tlEnable TO ;
      THIS.txtFirst.ENABLED, ;
      THIS.txtLast.ENABLED
  ENDPROC
  *!* Normally a save would result in data changing.
  PROCEDURE SAVE
    LOCAL loi AS OBJECT
    FOR EACH loi IN THIS.CONTROLS
      IF PEMSTATUS(loi,'OldVal',5)
        loi.OLDVAL = loi.VALUE
      ENDIF
    NEXT loi
  ENDPROC
  PROCEDURE UNDO
    LOCAL loi AS OBJECT
    FOR EACH loi IN THIS.CONTROLS
      IF PEMSTATUS(loi,'OldVal',5)
        loi.VALUE = loi.OLDVAL
      ENDIF
    NEXT loi
  ENDPROC
  PROCEDURE DirtyBuffer_Assign
    LPARAMETERS vNewVal
    THIS.DirtyBuffer = m.vNewVal
  ENDPROC
  PROCEDURE OnChange
  ENDPROC
  PROCEDURE txtFirst.INIT
    THIS.ADDPROPERTY('OldVal',THIS.VALUE)
  ENDPROC
  PROCEDURE txtFirst.GOTFOCUS
    THIS.OLDVAL = THIS.VALUE
  ENDPROC
  *!* Interactive change is important trigger for starting the process
  *!* of alerting all who might care that data has changed.
  PROCEDURE txtFirst.INTERACTIVECHANGE
    THIS.PARENT.DirtyBuffer = THIS.OLDVAL <> THIS.VALUE
  ENDPROC
  PROCEDURE txtLast.GOTFOCUS
    THIS.OLDVAL = THIS.VALUE
  ENDPROC
  PROCEDURE txtLast.INIT
    THIS.ADDPROPERTY('OldVal',THIS.VALUE)
  ENDPROC
  PROCEDURE txtLast.INTERACTIVECHANGE
    THIS.PARENT.DirtyBuffer = THIS.OLDVAL <> THIS.VALUE
  ENDPROC
ENDDEFINE

Listado 2

LOCAL loForm AS FORM
loForm = NEWOBJECT("BindEvents")
loForm.SHOW(1)
DEFINE CLASS BindEvents AS FORM
  HEIGHT = 170
  WIDTH = 334
  CAPTION = "Acoplamiento suelto con BindEvents"
  NAME = "BindEvents"
  *!* Container responsible for displaying data
  ADD OBJECT objPerson AS EntityContainer WITH ;
    TOP = 20, ;
    LEFT = 38, ;
    NAME = "objPerson", ;
    Label1.NAME = "Label1", ;
    Label2.NAME = "Label2", ;
    txtFirst.NAME = "txtFirst", ;
    txtLast.NAME = "txtLast"
  *!* Container responsible for managing buttons that can
  *!* trigger actions
  ADD OBJECT objDataCmd AS DataCommands WITH ;
    TOP = 100, ;
    LEFT = 38, ;
    NAME = "ObjDataCmd", ;
    btnEdit.NAME = "btnEdit", ;
    btnUndo.NAME = "btnUndo", ;
    btnSave.NAME = "btnSave"
  PROCEDURE INIT
    *!* Set up event bindings.
    *!* When the edit button is clicked, trigger the data container's enable method.
    BINDEVENT(THIS.objDataCmd,"SetEdit",THIS.objPerson,"EnableControls",2)
    *!* When data is being changed, trigger the button container refresh.
    BINDEVENT(THIS.objPerson,"OnChange",THIS.objDataCmd,"OnChange",2)
    *!* When Save is clicked, trigger the data container to save.
    BINDEVENT(THIS.objDataCmd,"Save",THIS.objPerson,"Save",2)
    *!* When Undo is clicked, trigger the data container to revert changes.
    BINDEVENT(THIS.objDataCmd,"Undo",THIS.objPerson,"Undo",2)
  ENDPROC
ENDDEFINE
DEFINE CLASS DataCommands AS CONTAINER
  WIDTH = 271
  HEIGHT = 49
  NAME = "DataCommands"
  DirtyBuffer = .F.
  ADD OBJECT btnEdit AS CHECKBOX WITH ;
    TOP = 10, ;
    LEFT = 180, ;
    HEIGHT = 27, ;
    WIDTH = 79, ;
    CAPTION = "\<Editar", ;
    VALUE = .T., ;
    STYLE = 1, ;
    NAME = "btnEdit"
  ADD OBJECT btnUndo AS COMMANDBUTTON WITH ;
    TOP = 10, ;
    LEFT = 12, ;
    HEIGHT = 27, ;
    WIDTH = 84, ;
    CAPTION = "\<Deshacer", ;
    ENABLED = .F., ;
    NAME = "btnUndo"
  ADD OBJECT btnSave AS COMMANDBUTTON WITH ;
    TOP = 10, ;
    LEFT = 96, ;
    HEIGHT = 27, ;
    WIDTH = 84, ;
    CAPTION = "\<Guardar", ;
    ENABLED = .F., ;
    NAME = "btnSave"
  PROCEDURE BindEvents
    *!* Instead of button's click() calling a method in the parent container,
    *!* Simply use the edit button's own event to trigger the parent to some action.
    BINDEVENT(THIS.btnEdit,"InteractiveChange",THIS,"SetEdit",2)
    BINDEVENT(THIS.btnEdit,"ProgrammaticChange",THIS,"SetEdit",2)
    BINDEVENT(THIS.btnUndo,"Click",THIS,"Undo",2)
    BINDEVENT(THIS.btnSave,"Click",THIS,"Save",2)
  ENDPROC
  *!* Method that can be called when data is changed.
  PROCEDURE OnChange
    IF .NOT. THIS.DirtyBuffer
      STORE .T. TO ;
        THIS.DirtyBuffer, ;
        THIS.btnUndo.ENABLED, ;
        THIS.btnSave.ENABLED
    ENDIF
  ENDPROC
  *!* Method that can be called when data is saved.
  PROCEDURE SAVE
    STORE .F. TO THIS.btnSave.ENABLED, ;
      THIS.btnUndo.ENABLED, ;
      THIS.DirtyBuffer
  ENDPROC
  *!* Method that can be called when data is reverted.
  PROCEDURE UNDO
    STORE .F. TO THIS.btnSave.ENABLED, ;
      THIS.btnUndo.ENABLED, ;
      THIS.DirtyBuffer
  ENDPROC
  PROCEDURE INIT
    THIS.BindEvents()
  ENDPROC
  PROCEDURE SetEdit
  ENDPROC
ENDDEFINE
DEFINE CLASS EntityContainer AS CONTAINER
  WIDTH = 227
  HEIGHT = 64
  NAME = "EntityContainer "
  ADD OBJECT Label1 AS LABEL WITH ;
    BACKSTYLE = 0, ;
    CAPTION = "Nombre", ;
    HEIGHT = 17, ;
    LEFT = 19, ;
    TOP = 14, ;
    WIDTH = 60, ;
    NAME = "Label1"
  ADD OBJECT Label2 AS LABEL WITH ;
    BACKSTYLE = 0, ;
    CAPTION = "Apellido", ;
    HEIGHT = 17, ;
    LEFT = 117, ;
    TOP = 14, ;
    WIDTH = 60, ;
    NAME = "Label2"
  ADD OBJECT txtFirst AS TEXTBOX WITH ;
    HEIGHT = 23, ;
    LEFT = 14, ;
    TOP = 30, ;
    WIDTH = 100, ;
    VALUE = "Grace", ;
    NAME = "txtFirst"
  ADD OBJECT txtLast AS TEXTBOX WITH ;
    HEIGHT = 23, ;
    LEFT = 115, ;
    TOP = 30, ;
    WIDTH = 100, ;
    VALUE = "Hopper", ;
    NAME = "txtLast"
  PROCEDURE EnableControls
    THIS.txtFirst.ENABLED = !THIS.txtFirst.ENABLED
    THIS.txtLast.ENABLED = !THIS.txtLast.ENABLED
  ENDPROC
  PROCEDURE BindEvents
    *!* When data is changed, alert the parent container.
    BINDEVENT(THIS.txtFirst,"InteractiveChange",THIS,"OnChange",3)
    BINDEVENT(THIS.txtLast, "InteractiveChange",THIS,"OnChange",3)
  ENDPROC
  PROCEDURE SAVE
    LOCAL loi AS OBJECT
    FOR EACH loi IN THIS.CONTROLS
      IF PEMSTATUS(loi,'OldVal',5)
        loi.OLDVAL = loi.VALUE
      ENDIF
    NEXT loi
  ENDPROC
  PROCEDURE UNDO
    LOCAL loi AS OBJECT
    FOR EACH loi IN THIS.CONTROLS
      IF PEMSTATUS(loi,'OldVal',5)
        loi.VALUE = loi.OLDVAL
      ENDIF
    NEXT loi
  ENDPROC
  PROCEDURE INIT
    THIS.BindEvents()
  ENDPROC
  PROCEDURE OnChange
  ENDPROC
  PROCEDURE txtFirst.INTERACTIVECHANGE
  ENDPROC
  PROCEDURE txtFirst.GOTFOCUS
    THIS.OLDVAL = THIS.VALUE
  ENDPROC
  PROCEDURE txtFirst.INIT
    THIS.ADDPROPERTY('OldVal',THIS.VALUE)
  ENDPROC
  PROCEDURE txtLast.INIT
    THIS.ADDPROPERTY('OldVal',THIS.VALUE)
  ENDPROC
  PROCEDURE txtLast.GOTFOCUS
    THIS.OLDVAL = THIS.VALUE
  ENDPROC
ENDDEFINE