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

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

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