19 de septiembre de 2017

El dilema de controlar una excepción en Visual FoxPro

Artículo original: Exception Handling Dilemma in VFP
http://west-wind.com/weblog/posts/4538.aspx
Autor: Rick Strahl
Traducido por: Ana María Bisbé York


Me ha llamado la atención, hace un par de días, que cambiando el mecanismo de control de errores de Web Connection por uno nuevo basado en TRY/CATCH, en lugar del método tradicional de controlar el error, que tiene mucha menos funcionalidad.

En Web Connection 4.0 todas las clases para procesar errores se controlan en el método Error en la clase Process la que básicamente captura todos los errores no controlados. El problema con el método de error es que no puede inhabilitarlo fácilmente, entonces, para tener un entorno de desarrollo donde los errores no sean controlados y el entorno de ejecución donde están tengo que utilizar un código como este:

*** Este bloque anula el método Error para que pueda tener los errores en
*** tiempo de depuración interactiva mientras ejecuta dentro de VFP.
#IF !DEBUGMODE
**************************************
FUNCTION Error(nError, cMethod, nLine)
**************************************
  LOCAL lcLogString, llOldLogging, lcOldError
  *** ¿Hemos sobrecargado la pila de llamadas? Si es así, nos vamos
  IF PROGLEVEL() > 125
    RETURN TO PROCESSHIT
  ENDIF
  nError = IIF(VARTYPE(nError) = "N", nError, 0)
  cMethod = IIF(VARTYPE(cMethod) = "C", cMethod, "")
  nLine = IIF(VARTYPE(nLine) = "N", nLine, 0)
  *** Guardamos el valor actual
  lcOldError = ON("ERROR")
  ON ERROR *
  *** Cerramos esta petición con una página de error 
  *** - SAFE MESSAGE (no confiar en ningún objeto)
  This.ErrorMsg("Ha ocurrido un error..",;
    "En este momento no se puede servir esta petición " + ;
    "debido a dificultades técnicas.<P>" + ;
    "No. Error: " + STR(nError) + "<BR>" + CRLF + ;
    "Error: " + MESSAGE()+ "<P>" + CRLF + ;
    "Método: " + cMethod + "<BR>" + CRLF + ;
    "Código actual: "+ MESSAGE(1) + "<BR>" + CRLF + ;
    "Línea de código actual: " + STR(nLine) + "<p>" + ;
    "Excepción controlada por " + This.CLASS + ".Error()")
  *** Obriga a cerrar el archivo y es recuperable por wc.dll/exe
  *** NOTA: Los objetos HTML no se liberan aquí debido a otra
  *** referencia de objeto como Response.
  IF TYPE("This.oResponse") = "O" AND !ISNULL(This.oResponse)
    This.oResponse.DESTROY()
  ENDIF
  * wait window MESSAGE() + CRLF + MESSAGE(1) + ;
  *   CRLF + "Método: " + cMethod nowait
  IF TYPE("This.oServer") = "O" AND !ISNULL(This.oServer)
    *** Intenta obtener un log del error - Fuerza el log!!!
    * llOldLogging = This.oServer.GetLogToFile()
    llOldLogging = This.oServer.lLogToFile
    lcLogString = "Procesando Error - " + ;
      This.oServer.oRequest.GetCurrentUrl() + ;
      CRLF + CRLF + "<PRE>" + CRLF + ;
      " Error: " + STR(nError) + CRLF + ;
      " Mensaje: " + MESSAGE() + CRLF + ;
      " Código: " + MESSAGE(2) + CRLF + ;
      " Programa: " + cMethod + CRLF + ;
      " Línea No: " + STR(nLine) + CRLF + ;
      " Cliente: " + This.oRequest.GetIpAddress() + CRLF + ;
      "Post Buffer: " + This.oRequest.cFormVars + CRLF + ;
      "</PRE>" + CRLF + ;
      "Excepción controlada por: " + This.CLASS+".Error()"
    This.oServer.LogRequest(lcLogString,"Local",0,.T.)
    This.oServer.SetLogging(llOldLogging)
    This.SendErrorEmail("Web Connection Error - " + ;
      This.oServer.oRequest.GetCurrentUrl(), lcLogString)
  ENDIF
  ON ERROR &lcOldError
  *** Regresa al método Process!
  RETURN TO ROUTEREQUEST
ENDFUNC
* EOF wwProcess::Error
#ENDIF 

Ahora está trabajando bien; pero siempre ha sido un esquema que huele mal. El primer punto es que existe un requerimiento del compilador para habilitar y deshabilitar el interruptor para el modo debug. Entonces, necesita ser recompilado para hacer que cambie entre los dos.

El otro problema más delicado, es que confía en RETURN TO para devolver a un método especificado que lo haya llamado, lo que no es siempre confiable. De hecho, si en algún lugar en la cadena de llamada causa error una ejecución EVAL() el mecanismo de error entero se rompe porque VFP 8 y 9 no admiten RETURN TO en llamadas EVALUATE(). Cuando este es el caso, RETURN TO hace return sencillo y usted termina la ejecución del código SIGUIENDO el error.

Nunca me había gustado el método Error en estos casos porque no existe una forma determinista para devolverlo a algún lugar, entonces VFP 8 llegó con algo que me gustó mucho ver: TRY/CATCH y la capacidad de tener más control determinista del error que permite volver a un lugar específico del código.

Entonces, con Web Connection 5.0 el método Error y el proceder DEBUGMODE (el que de paso, es aplicado también a otras clases) fue sustituido por un controlador TRY/CATCH como centro del motor de proceso. He aquí la implementación que no tiene ningún método de error especial; pero en su lugar, el lo llama:

************************
FUNCTION Process()
************************
  LOCAL loException
  PRIVATE Response, REQUEST, Server, Session, Process
  Process = THIS
  Server = This.oServer
  Request = This.oRequest
  Response = This.oResponse
  Session = This.oSession
  Config = This.oConfig
  *** Método gancho
  IF !This.OnProcessInit()
    RETURN
  ENDIF
  IF Server.lDebugMode
    This.RouteRequest()
  ELSE
    TRY
      This.RouteRequest()
    CATCH TO loException
      This.OnError(loException)
    ENDTRY
  ENDIF
  This.OnProcessComplete()
  RETURN .T.
ENDFUNC
* EOF wwProcess::Process 

El controlador TRY/CATCH captura cualquier error y entonces, sencillamente llama a un método sobreescribible que es utilizado para controlar el error. Un controlador predeterminado es proporcionado o el desarrollador puede sustituir OnError para hacer cualquier cosa que necesite. Desde la perspectiva del diseñador esto está mucho más claro y no tiene un error potencial utilizando RETURN TO.

Pero, existe desafortunadamente, una funcionalidad perdida. TRY/CATCH está bien; pero su empleo termina con algunas limitaciones. Este controlador:

  • No nos brinda una información detallada del error
  • No tenemos la pila de llamada - el control se devuelve al nivel que lo llama.

CATCH permite recibir un objeto exception; pero desafortunadamente este objeto no brinda mucha información y la información disponible no está completa como en el método Error. La razón principal para esto es que cuando ocurre una operación CATCH limpia la pila de llamada con lo que lo coloca en el método inicial que ha realizado la llamada. Esto significa que puede obtener información detallada del error desde el nivel de la pila de llamadas donde, realmente ocurra el error. Cualquier variable, PRIVATE o LOCAL se habrá perdido y ASTACKINFO() solamente devolverá la pila actual, la que en realidad no se corresponde con callstack de el lugar donde ocurrió el error.

Esto significa además, que su información de error está limitada por lo que provee el objeto Exception y no es tan completa como lo que brinda LINENO(), PROCEDURE y SYS(16). El resultado es que en muchas situaciones puede obtener LineNo y ejecutar el nombre del programa de la forma en que tiene en el método Error, especialmente en tiempo de ejecución sin tener información de depuración.

Alternativas? Realmente no ...

Entonces, estuve intentando obtener algunas soluciones para esta limitación - desafortunadamente no he encontrado la forma correcta de hacerlo. Mi primera idea fue hacer que funcione el método Error además del controlador TRY/CATCH. Un par de ideas que vinieron a mi mente:

  • Sobreescribir Try/Catch con el método Error
  • Utilizar un método Error junto al Try/Catch y emplear THROW para crear una excepción personalizada
FUNCTION Error(lnerror,lcMethod,lnLine)
  *** Aquí su controlador de error personalizado
  RETURN TO RouteRequest
ENDFUNC

Desafortunadamente esto no va a funcionar: VFP no permitirá RETURN TO ni RETRY dentro de un bloque TRY/CATCH. Denegado.

La segunda opción tendría un proceder similar; pero en su lugar de devuelve la información del error capturado y luego crea una excepción personalizada que contenga información adicional:

FUNCTION Error(lnerror,lcMethod,lnLine)
  This.StandardPage("Error Ocurrido","Prueba")
  LOCAL loException as Exception
  loException = CREATEOBJECT("Exception")
  loException.LineNo = lnLine
  loException.ErrorNo = lnError
  loException.Message = MESSAGE()
  THROW loException
ENDFUNC

Desafortunadamente, esto tampoco funciona el error arrojado en el método Error es arrojado a su vez, al nuevo controlador de errores. Lo único que puede controlar una excepción en el método Error es ON ERROR. Por tanto, esto tampoco funciona.

Próxima idea: Capturar la excepción y adjuntarla en una propiedad, para que la información adicional esté disponible. Entonces, sencillamente devolvemos el Error del método Error. Desafortunadamente esto tampoco funciona, porque no se puede acortar el circuito de procesamiento del error - Cualquier código siguiente al error original continúa ejecutándose.

Entonces, al final está claro que el método Error() que necesita mostrar la cadena de error no coexiste de manera limpia con el controlador TRY/CATCH. No veo al forma que puedo hacer que esto funcione utilizando un proceder donde se empleen ambos .

Al final, mi solución es agregar un indicador lUseErrorMethodErrorHandling a la clase que procesa y luego, basarme en el salto de la llamada TRY/CATCH

IF Server.lDebugMode OR ;
  This.lUseErrorMethodErrorHandling
  This.RouteRequest()
ELSE
  TRY
    This.RouteRequest()
  CATCH TO loException
    This.OnError(loException)
  ENDTRY
ENDIF

Entonces, el controlador de error funciona como en la versión vieja de Web Connection, excepto en que el desarrollador es responsable por hacer su propio controlador de error. Para simular un comportamiento similar y para componer el mensaje de error como TRY/CATCH puede hacer lo siguiente:

FUNCTION Error(lnerror,lcMethod,lnLine)
  LOCAL loException as Exception
  loException = CREATEOBJECT("Exception")
  loException.LineNo = lnLine
  loException.LineContents = MESSAGE(1)
  loException.ErrorNo = lnError
  loException.Message = MESSAGE()
  loException.Procedure = SYS(16)
  This.OnError(loException)
  RETURN TO RouteRequest
ENDFUNC

Esto funciona; pero no es lo que yo considero la implementación más limpia. Sería muy bueno que VFP nos permitiera alguna opción para tener un gancho que pueda controlarse cuando es creado un objeto Exception. En lugar de pasar una referencia a un objeto Exception podría pasar un tipo - VFP podría instanciar el tipo y usted podría sobreescribir, digamos el Init() de ese tipo para reunir toda la información relevante de la pila de llamadas hasta ese punto. O tener la referencia que tenga un método que sea llamado en la inicialización. O al menos, si TRY/CATCH admite THROW para encadenar el método error.

Bueno, esto funciona aunque tiene truco...


15 de septiembre de 2017

Guardar y restaurar configuraciones en aplicaciones VFP

Artículo original: Saving and restoring settings in VFP applications
http://www.sweetpotatosoftware.com/SPSBlog/PermaLink,guid,e5d49608-9752-42a5-b7f7-867df325a780.aspx
Autor: Craig Boyd
Traducido por: Ana María Bisbé York


El problema

Muchas veces, los desarrolladores Visual FoxPro van a encontrarse a si mismo guardando estados previos de alguna configuración para restaurarlo una vez que está ejecutando el código. Los más usuales son:

  • comandos SET (tales como SET SAFETY, SET DELETED, etc.)
  • comandos ON (ON ERROR, ON ESCAPE, etc.)
  • posición del puntero de registro
  • área de trabajo actual

La solución

En lugar de escribir las mismas líneas de código una y otra vez en sus programas, podríamos crear una clase que lo controle. Esto hace la siguiente clase SettingHandler, que he escrito y he preparado unos ejemplos de cómo utilizarla. Notará que cuando instancio la clase envío el comando que estoy por ejecutar (tales como SET SAFETY OFF) como un parámetro tipo cadena. La clase va a guardar la configuración actual del parámetro Safety y luego lo iguala a OFF. Cuando deseo restablecer la configuración anterior, libero la instancia de SettingHandler y la clase restablece el valor de Safety a lo que hubiera antes de que yo lo hubiera cambiado.

Inconvenientes y ventajas

El único inconveniente que encuentro en este proceder es que no trabaja IntelliSense cuando escribo el comando como parámetro de cadena. Y sobre las mejoras, puedo pensar en más de una, por ejemplo, operaciones sobre tablas. Se podría agregar que permita guardar la sesión actual de datos y que luego la restablezca (habrá probablemente otros parámetros que también se podrían proporcionar Captions, ForeColor, BackColor, Tag, etc) Además, se podría agregar alguna lógica para controlar si un desarrollador cambia las áreas de trabajo; pero no especifica un área de trabajo en el comando GOTO.

He aquí un ejemplo listo para correr y la definición de clase (copie y pegue el código que aparece a continuación en un prg y ejecútelo)

*************************
*!* EJEMPLO DE USO
*************************
CLEAR
LOCAL loSetting
? "SET COMMANDS:"
SET SAFETY ON
? SET("SAFETY")
**  Guarda y cambia el valor de Safety 
loSetting = CREATEOBJECT("SettingHandler", "SET SAFETY OFF")
? SET("SAFETY")
** Restaura el valor previo de Safety 
RELEASE loSetting 
? SET("SAFETY")
?
? "ON COMMANDS:"
ON ERROR ? "Controlador de error previo "
? ON("ERROR")
** Guarda y cambia el valor del controlador de error
loSetting = CREATEOBJECT("SettingHandler", "ON ERROR ?'New Error Handler'") 
? ON("ERROR")
** Restaura el valor previo del controlador de error
RELEASE loSetting 
? ON("ERROR")
?
? "RECORD NUMBER:"
IF !USED("customers")
  USE (HOME(2) + "northwind\customers.dbf") IN 0 SHARED
ENDIF
GOTO 5 IN "customers"
? RECNO("customers")
** Guarda y cambia el valor de la posición del puntero de registro
loSetting = CREATEOBJECT("SettingHandler", "GO 12 in [customers]") 
? RECNO("customers")
** Restaura el valor previo de la posición del puntero de registro
RELEASE loSetting 
? RECNO("customers")
?
? "SELECT:"
IF !USED("orders")
  USE (HOME(2) + "northwind\orders.dbf") IN 0 SHARED
ENDIF
SELECT "Orders"
? ALIAS()
** Guarda y cambia el valor del Alias actual
loSetting = CREATEOBJECT("SettingHandler", "Select Customers") 
? ALIAS()
** Restaura el valor previo del Alias actual
RELEASE loSetting 
? ALIAS()
USE IN SELECT("Customers")
USE IN SELECT("Orders")
*
******* Final de los ejemplos ******
*
************************************
*!* DEFINICIÓN DE CLASE
************************************
DEFINE CLASS SettingHandler as custom
  PROTECTED PreviousValue
  PreviousValue = .NULL.
  PROTECTED SettingCommand
  SettingCommand = ""
  PROTECTED SettingType && 0 = SET/ON, 1 = RECNO
  SettingType = -1
  #DEFINE SETTINGDELIMITERS [('" ] + "[])"

  PROCEDURE Init (tcCommand)
    This.Setup(tcCommand)
  ENDPROC

  PROTECTED PROCEDURE Destroy
    This.RevertSetting()
  ENDPROC

  PROCEDURE Setup (tcCommand)
    This.SettingCommand = ALLTRIM(tcCommand)
    This.SaveSetting()
    This.UpdateSetting()
  ENDPROC

  PROTECTED PROCEDURE SaveSetting
    LOCAL lcFirstPart, lcSecondPart, lnSecondPosition, lcCommand
    lcFirstPart = UPPER(ALLTRIM(GETWORDNUM(this.SettingCommand, ;
      1, SETTINGDELIMITERS)))
    DO CASE
      CASE INLIST(lcFirstPart, "SET", "ON")
        lcSecondPart = UPPER(ALLTRIM(GETWORDNUM(this.SettingCommand, ;
          2, SETTINGDELIMITERS)))
        lcCommand = lcFirstPart + [("] + lcSecondPart + [")]
        This.SettingType = 0
      CASE INLIST(lcFirstPart, "GOTO", "GO")
        lnSecondPosition = ATC(" IN ", this.SettingCommand)
        IF lnSecondPosition > 0
          lcSecondPart = SUBSTR(this.settingcommand, lnSecondPosition + 4)
        ELSE
          lcSecondPart = ""
        ENDIF
        lcCommand = [RECNO(] + lcSecondPart + [)]
        This.SettingType = 1
      CASE lcFirstPart = "SELECT"
        lcSecondPart = UPPER(ALLTRIM(GETWORDNUM(this.SettingCommand, ;
          2, SETTINGDELIMITERS)))
        lcCommand = [ALIAS()]
        This.SettingType = 2
    ENDCASE
    IF !EMPTY(lcCommand)
      This.PreviousValue = EVALUATE(lcCommand)
    ENDIF
  ENDPROC

  PROTECTED PROCEDURE UpdateSetting
    EXECSCRIPT(This.SettingCommand) && Cambia los valores
  ENDPROC

  PROTECTED PROCEDURE RevertSetting
    LOCAL lcCommand, lnStuffPosition, lnStuffLength, lcAliasWas
    DO CASE
      CASE This.SettingType = 0 && SET/ON
        lnStuffPosition = AT(" ", this.Settingcommand, 2) + 1
        lnStuffLength = LEN(this.settingcommand) - lnStuffPosition + 1
      CASE This.SettingType = 1 && GOTO/GO
        lnStuffPosition = AT(" RECORD ", UPPER(this.Settingcommand), 1) + 8
        IF lnStuffPosition < 9
          lnStuffPosition = AT(" ", this.Settingcommand, 1) + 1
          lnStuffLength = AT(" ", this.Settingcommand, 2)
          IF lnStuffLength > 0
            lnStuffLength = lnStuffLength - lnStuffPosition + 1
          ELSE
            lnStuffLength = LEN(this.settingcommand) - lnStuffPosition + 1
          ENDIF
        ELSE
          lnStuffLength = LEN(this.settingcommand) - lnStuffPosition + 1
        ENDIF
      CASE This.SettingType = 2 && SELECT
        lnStuffPosition = AT(" ", this.Settingcommand, 1) + 1
        lnStuffLength = LEN(this.settingcommand) - lnStuffPosition + 1
    ENDCASE
    IF !EMPTY(lnStuffPosition)
      lcCommand = STUFF(This.SettingCommand, lnStuffPosition, ;
        lnStuffLength, TRANSFORM(this.PreviousValue))
      ** Restablece el estado inicial antes de que fueran cambiado
      EXECSCRIPT(lcCommand) 
    ENDIF
  ENDPROC
ENDDEFINE

11 de septiembre de 2017

Detectar y solucionar conflictos de actualización en VFP

Detectar y solucionar conflictos de actualización en VFP

Artículo original: Detecting and resolving update conflicts in VFP
http://weblogs.foxite.com/andykramek/archive/2006/02/18/1155.aspx
Autor: Andy Kramek
Traducido por: Ana María Bisbé York


En el último artículo en esta serie veré el problema acerca de cómo detectar y solucionar que Visual FoxPro piensa actualizar conflictos. La idea detrás de esto es que queremos asegurar que cuando VFP informa aquí el conflicto es realmente uno. La razón por la que aquí existe una duda es que VFP va a reportar un conflicto de actualización en algún cambio se ha hecho en la copia de disco del registro que se va a guardar - aunque los cambios hechos por el usuario actual realmente crean un conjunto con los datos generados o no. Como un ejemplo, considere el siguiente caso:

  • Usuario # 1 abre un registro cliente para modificar un número de teléfono
  • Usuario # 2 abre el mismo registro cliente para agregar el código postal y cuatro valores
  • El Usuario # 1 guarda sus cambios en el número de teléfono.
  • El usuario # 2 trata de guardar sus cambios del código postal y puede ser un error de "conflicto de actualización", incluso pensando que el valor que este usuario está cambiando no estuvo afectado por los cambios y fueron hechos y guardados por el usuario # 1.

Con un pequeño esfuerzo, puede detectar y solucionar este tipo de errores y solamente rechaza un cambio de usuario cuando realmente entra en conflicto con el dato existente. Para hacer esto podría aprovechar la capacidad de Visual FoxPro para devolver los valores CurVal() y OldVal() para cada columna (para una explicación del rol de estas funciones vea mi artículo Diciembre 2005 en "Handling buffered data in Visual FoxPro").

El proceso consiste en varios pasos y es mostrado aquí (por claridad) como un simple programa con alguna función asociada, por supuesto, puede ser creado en una clase e instanciado como un objeto. El programa mostrado aquí solamente devuelve Verdadero cuando el conflicto ha sido solucionado. Si devuelve Falso indica o que un error ocurre, o que se mantiene este conflicto. En el último caso un cursor contiene el detalle de todo el conflicto no resuelto.

[1] Lo primero que necesita verificar es que tenemos un nombre de tabla que está actualmente en buffer. Por tanto, como veremos, la solución del problema se basa en utilizar TableUpdate(), podemos solamente controlar los conflictos para tablas en buffer. El programa crea un cursor, el que utilizaremos para guardar todos los detalles de cualquier conflicto que no podemos solucionar programáticamente hasta su culminación, pueden ser presentados por el usuario para su revisión y decisión.

LPARAMETERS tuTable
LOCAL llRetval, lnBuffMode, lcTable, lnOldArea, lnNextRec, lnRows
*** Verificar parámetros
IF EMPTY(tuTable)
  *** No pasa nada, utiliza la tabla actual
  lcTable = ALLTRIM( ALIAS() )
  IF EMPTY( lcTable )
    *** No hay tabla, por tanto no podemos dar 
    *** seguimiento a ningún conflicto - return 
    RETURN lLRetVal
  ENDIF
ELSE
  DO CASE
    CASE TYPE( "tuTable" ) = "C"
      *** Asume que la cadena de caracteres es el Alias requerido
      lcTable = ALLTRIM( tuTable)
    CASE TYPE( "tuTable" ) = "N"
      *** Toma el Alias para el área de trabajo especificado
      lcTable = ALIAS( tuTable )
    OTHERWISE
      *** Parámetro no válido
      RETURN llRetVal
  ENDCASE
ENDIF 
*** Crea un cursor local para guardar los conflictos
CREATE CURSOR curcflix ( ;
  cfxRecNum C ( 8), ; && Número del conflicto
  cfxFldNam C (200), ; && Nombre del campo
  cfxOldVal C (200), ; && Valor original 
  cfxCurVal C (200), ; && Valor actual en el disco
  cfxUsrVal C (200), ; && Cambia en el buffer
  cfxForcit N ( 1) ) && Acción definida por el usuario
*** Verifica BufferMode
llRetVal = .T.
lnBuffMode = CURSORGETPROP( 'Buffering', lcTable )
IF lnBuffMode < 2
  *** Si la tabla no tiene Buffer devuelve Falso
  ***  no podemos confiar en TableUpdate() 
  RETURN .F.
ELSE
  *** Guarda el área de trabajo actual y 
  *** selecciona la tabla requerida
  lnOldArea = SELECT()
  SELECT (lcTable)
ENDIF

[2] La otra parte del proceso depende del tipo de buffering que va a ser utilizado. Si la tabla tiene buffer de filas, entonces podemos necesitas solamente verificar la fila actual. Cuando está en efecto de Buffer de Tabla necesitamos procesar todos los registros con cambios pendientes. Esto significa envolver la verificación a nivel de fila dentro del código que utiliza GetNextModified() para encontrar todos los registros con cambios pendientes.

*** Si tiene buffer de fila, sólo procesa esta fila
IF lnBuffMode < 4
  *** Buffer de fila
  llRetVal = CheckRow( RECNO(), lcTable )
ELSE
  *** Buffer de Tabla - necesita encontrar todos los registros modificados
  *** Lo que significa llamar a GetNextModified() hasta tanto devuelva 0
  *** indicando que no existen más registros con cambios
  lnNextRec = 0
  DO WHILE .T.
    lnNextRec = GETNEXTMODIFIED( lnNextRec )
    IF lnNextRec = 0
      EXIT
    ENDIF
    *** Intenta y actualiza el registro
    llRetVal = CheckRow( lnNextRec, lcTable )
    IF ! llRetVal
      *** Si falla, salir 
      EXIT
    ENDIF
  ENDDO
ENDIF

[3] La función CheckRow() (o el método si está creando un objeto para esto) es donde se hace el trabajo real. Para cada campo en el registro, este método lee el valor actual del usuario en el buffer, los valores OldVal() y CurVal() y los pasa a través de una verificación lógica, como sigue:

SI el usuario no ha cambiado este campo, y los valores Old y Current son idénticos.
  ignora este campo - igualmente, no ocasionará un conflicto 
SI_NO
  SI el usuario no ha cambiado el campo, pero los valores Old y Current son diferentes
    actualiza el buffer directamente con el valor Current
  SI_NO
    SI el usuario no ha cambiado este campo, pero el valor en el buffer es en realidad idéntico
      al valor Current, ignora este cambio
    SI_NO
      Esto ES realmente un conflicto, así que lo grabamos

Pero, esto se basa en saber si el usuario actual cambia realmente cualquier campo dado. Para obtener la lista de los campos que VFP recuerda que están siendo cambiados utilizamos una función llamada GetUserChanges() que devuelve una lista separada por comas de columnas con cambios pendientes:

FUNCTION GetUserChanges
LOCAL lcRetVal, lcTable, lcFldState, lnCnt, lcStatus
*** Initializa el valor de retorno
lcRetVal = ''
*** Y el alias actual - que está controlada en el código llamado antes
lcTable = ALIAS()
*** Primero verifica los campos que VFP ve al tener valores cambiados
lcFldState = NVL( GETFLDSTATE( -1, lcTable ), "")
IF EMPTY( CHRTRAN( lcFldState, '1', ''))
  *** Nada; pero '1', por tanto no cambia nada
  RETURN lcRetVal
ENDIF
*** Entonces, TENEMOS, al menos un campo modificado! 
*** Pero primero tenemos que controlar el indicador DELETED.
*** Aquí podemos utilizar "DELETED()" como nombre de campo!
IF ! INLIST( LEFT( lcFldState, 1), "1", "3" )
  lcRetVal = "DELETED()"
ENDIF
*** Ahora podemos olvidarnos del indicador de borrado
lcFldState = SUBSTR( lcFldState, 2 )
*** Toma el nombre de los campos para los campos modificados
FOR lnCnt = 1 TO FCOUNT()
  *** Hacemos un lazo con los campos
  lcStatus = SUBSTR( lcFldState, lnCnt, 1 )
  IF INLIST( lcStatus, "2", "4" )
    lcRetVal = lcRetVal + ;
      IIF( ! EMPTY( lcRetVal ), ",", "") + FIELD( lnCnt )
  ENDIF
NEXT
*** Devuelve la lista de campos modificados
RETURN lcRetVal

Vea que cuando utilizamos la función nativa DELETED() como un nombre de campo en esta función. Ambos, CurVal() y OldVal() aceptarán este como "nombre válido" de campo (devolviendo un valor lógico indicando si el campo fue eliminado en la tabla original) así que pueda verificar tanto lo datos eliminados, como los datos modificados.

[4] Como ha visto antes, la función CheckRow se llama una vez por cada línea que necesite verificar y es donde se toma la decisión y si la intervención del usuario es requerida o no. Para las filas donde un conflicto no se puede solucionar por programa escribimos los detalles del cursor que creamos antes. Esta es la función:

FUNCTION CheckRow( tnRecNum, tcTable )
LOCAL lnCnt, luCurVal, luOldVal, lnRows, llRetVal, lcFldList, lcFldName, luUsrVal
*** Fuerza el registro correcto a ser el actual
SELECT (tcTable)
IF RECNO() # tnRecNum
  GOTO tnRecNum
ENDIF
*** Toma la lista de campos cambiados por el usuario actual
lcFldList = ""
lcFldList = ThisForm.GetUserChanges( tcTable )
*** Recorre todos los campos
FOR lnCnt = 1 TO FCOUNT()
  lcFldName = FIELD( lnCnt )
  luCurVal = CURVAL( FIELD( lnCnt ))
  luOldVal = OLDVAL( FIELD( lnCnt ))
  luUsrVal = EVAL( FIELD( lnCnt ))
  *** ¿Este campo causará un conflicto?
  IF luCurVal == luOldVal
    *** No se han hecho cambios en este campo
    *** Por tanto, no hay problemas
  ELSE
    *** Se han hecho cambios en este campo
    IF ! FIELD( lnCnt ) $ lcFldList
      *** Pero el usuario actual no ha modificado este campo
      *** Por lo que podemos actualizarlo con el valor de CurVal()
      REPLACE (FIELD(lnCnt)) WITH luCurVal
    ELSE
      *** ¡Algo ha cambiado! La pregunta es ¿QUÉ?
      IF EVAL( FIELD(lnCnt) ) == luCurval
        *** El usuario no ha cambiado nada
        LOOP
      ELSE
        *** Este es un conflicto que no podemos solucionar por programa
        *** Entonces, escribe la información como cadena de caracteres al cursor
        INSERT INTO curcflix ( cfxRecNum, cfxFldNam, cfxOldVal, cfxCurVal, ;
          cfxUsrVal, cfxForcit) VALUES ;
          ( TRANSFORM(RECNO()), lcFldName, TRANSFORM(luOldVal), ;
          TRANSFORM(luCurVal), TRANSFORM(luUsrVal), 2 )
      ENDIF 
    ENDIF
  ENDIF
NEXT

[5] La sección final del proceso principal meramente verifica la cantidad de registros en el cursor de conflicto para ver si algo necesita ser hecho por el usuario. Si no existen registros en ese cursor, todos los conflictos se han resuelto al forzar el buffer de usuario para que coincida con el dato original donde haya discrepancias. Entonces, nosotros ahora utilizamos TableUpdate() e incluimos el parámetro FORCE para actualizar el dato y limpia el buffer:

*** Verifica el cursor de conflictos
IF RECCOUNT( "curcflix") = 0
  *** No hay conflictos sin resolver, 
  *** por tanto fuerza la actualización
  llRetVal = TableUpdate( .T., .T., lcTable )
ELSE
  GO TOP IN curcflix
  llRetVal = .F.
ENDIF
*** Devuelve el estado final
RETURN llRetVal

Obviamente si hay registros en el cursor de conflictos necesita permitir al usuario que decida qué hacer y entonces, o fuerza la actualización, o la revierte. Pero esto es un ejercicio para usted, el lector.


7 de septiembre de 2017

Redimensionar automáticamente las columnas del ListView

Artículo original: Automatically Sizing ListView Columns
http://doughennig.blogspot.com/2007/01/automatically-sizing-listview-columns.html
Autor: Doug Hennig
Traducido por: Ana María Bisbé York


Utilizo el control ActiveX Microsoft ListView hace un tiempo. Brinda varios beneficios sobre los grid de sólo lectura, incluyendo múltiple selección de filas y fácil soporte para imágenes. Usualmente, yo trato de evadir el tener una barra horizontal si es posible, entonces yo dimensiono el ListView y sus columnas y los datos caben muy bien.

Sin embargo, se desordena cuando aparece la barra de movimiento vertical, lo que ocurre automáticamente cuando hay más filas que las que el ListView puede mostrar. En este caso, si ha definido el tamaño de sus columnas, de tal modo que quepan exactamente en el ancho del ListView, tendrá una barra de desplazamiento horizontal porque la barra de desplazamiento vertical ocupa algo del ancho del ListView, que ya fue utilizado por las columnas.

Para solucionar esto, he decidido que era mejor iniciar el tamaño de las columnas un poco mayor que lo necesario para mostrar sus datos (si es posible), entonces estrecharlas si la barra de desplazamiento vertical aparece. El único problema: ¿cómo saber cuando la barra de desplazamiento vertical es visible? No hay ninguna propiedad que lo indique, entonces decidí calcularlo por el método de la fuerza bruta.

El siguiente código asume que el control ListView se llama oList y tiene dos columnas, la segunda de ellas se redimensiona después de cargar la lista. Hay un par de números mágicos aquí, el 1 es la altura de la línea de la cuadrícula en el ListView y el 22 es la altura de los encabezados de columnas. El código determina si aparece una barra de desplazamiento vertical al calcular la altura de cada elemento (la altura de la fuente más la línea de la cuadrícula), al multiplicar por el número de filas, y agregar la altura de los encabezados de columnas. Si esto es mayor que la altura del ListView, hay una barra de desplazamiento vertical, entonces, se ajusta el ancho de las columnas, teniendo en cuenta el ancho del ListView, el ancho de la primera columna, el ancho del borde del ListView y el ancho de la barra de desplazamiento vertical.

with This.oList
llScroll = .ListItems.Count * ;
  (fontmetric(1, .Object.Font.Name, .Object.Font.Size) + ;
  fontmetric(5, .Object.Font.Name, .Object.Font.Size) + 1) + ;
  22 > .Height
.ColumnHeaders.Item(2).Width = .Width - ; .ColumnHeaders.Item(1).Width - sysmetric(4) - ; iif(llScroll, sysmetric(7), 0) endwith

Ajuste este código tanto como sea necesario, si tiene más de dos columnas, o desea redimensionar una columna diferente, o más de una columna.


31 de julio de 2017

VFP9 - Novedades - Manipulación de entorno de datos en el diseñador

El Diseñador de informes de VFP 9.0 ha sido modificado en muchos de sus aspectos. El entorno de datos ha sido uno de los aspectos cuyo tratamiento se ha modificado. Este artículo pretende comentar y mostrar algunos de estos cambios.

Muchas veces encontramos que el entorno de datos necesario para la ejecución de determinado grupo de informes es exactamente igual, o muy parecido. Antes de VFP 9.0 teníamos que valernos de código de programación para establecer un entorno adecuado, o en el peor de los casos rehacerlo a mano desde el Diseñador de Informes.

El Generador de informes de VFP 9.0 nos permite compartir fácilmente Entornos de datos con otros informes. El entorno de datos puede ser guardado como una clase y luego cargado en informes, según la necesidad. Esto brinda nuevas posibilidades para definir y reutilizar entornos en informes con escenarios similares.

Veamos las diferencias en el menú Archivo.

Menú Archivo para VFP 8.0 y VFP 9.0

Una opción nueva salta a la vista: Guardar como clase

Para guardar un Entorno de datos como clase, una vez definido, seleccione la opción Guardar como clase…en el menú Archivo. No es necesario tener el entorno de datos abierto.

Como vemos la única posibilidad disponible es Guardar como clase DataEnvironment. Este tipo de clase base fue incorporada a VFP en la versión 8.0.

Si va a crear una clase nueva, basta con escribir su nombre y localizar la biblioteca de clases donde se va a almacenar, al seleccionar el botón de comandos junto a Archivo se muestra la ventana Guardar como

Veamos otro menú, en este caso el de Informes comparemos:

Menú Informe para VFP 8.0  y VFP 9.0

Además de varios cambios en materia de organización de opciones y algunas otras novedades nos detenemos en la opción Carga el Entorno de Datos. Al seleccionarla, vemos que se muestra la nueva ventana Propiedades del Informe con la ficha Entorno de datos activa.

VFP 90, además de permitirnos definir manualmente el Entorno de datos para un nuevo informe, ofrece la opción de cargar un Entorno de datos de un informe ya existente o de una clase DataEnvironment guardada previamente. La opción Carga el Entorno de Datos… en el menú Informe permite seleccionar el origen del Entorno de datos a cargar. Tenemos dos posibilidades:

  • Copiar desde otro archivo de Informe
    Al cargar el Entorno de datos desde otro informe, todo el código y los miembros del Entorno original se copian en el nuevo informe. Esto significa que cualquier cambio que se realice en el Entorno del informe original, después de ser copiado, no se va a reflejar en el informe creado a partir del informe original.
  • Enlazar con una clase DataEnvironment visual
    Al cargar un Entorno de datos desde una clase, se agrega código al Entorno de datos del nuevo informe para enlazarlo con la clase DataEnvironment original e instanciarla en tiempo de ejecución. Esto debería significar que los cambios que pueden realizarse en el futuro sobre la clase DataEnvironment se van a propagar a cualquier informe que emplee esta clase DataEnvironment. Pero no es así, porque el código se escribe sólo la primera vez y no verifica si hubo cambios en la clase.

Veamos como se traduce esta explicación teórica en un ejemplo práctico.

Supongamos que tenemos un nuevo informe, aun vacío, al que deseamos establecer un Entorno de datos, a partir de una clase guardada previamente. Al seleccionar la clase deseada nos muestra lo siguiente:

Esta pregunta se va a hacer siempre que se intente copiar el Entorno de datos, ya sea de otro informe o de una clase DataEnvironment

Al responder nos muestra la fuente que da origen al Entorno de datos y el mensaje:

Veamos qué ha ocurrido en el Entorno de Datos del Diseñador de informes

Pues lo que ha ocurrido es que se ha generado código en algunos métodos del DataEnvironment y de los cursores que lo integran. Vamos a aclarar que en el informe original no existía ningún código en estos métodos. El código que se agrega es para poder enlazar el informe con esa clase.

El enlace con la clase original se produce en el método BeforeOpenTables como se puede ver a continuación

Algunos de los métodos tienen un código tan simple como un único comando DODEFAULT(). La razón para esto es que BindEvents() no funciona si al menos no hay una línea de código. BindEvent() se emplea en BeforeOpenTables para enlazar con los eventos Init y Destroy. El evento INIT no tiene código adicional.

En cuanto al tratamiento de Entorno de datos hay un aspecto muy interesante, que ha resultado un tanto sorprendente para algunos desarrolladores Visual FoxPro y se trata de la forma en que se vinculan con la ventana Expresión de informe.

Comportamiento actual para las tablas abiertas en el Entorno de datos del Diseñador de Informe:

Si la variable de sistema _reportbuilder está vacía, todos los campos de tablas contenidas en el entorno de datos se muestran en la lista Campos (Fields). Las tablas abiertas fuera del entorno de datos no se muestran.

Si la variable de sistema _reportbuilder apunta a alguna aplicación, por ejemplo, _ reportbuilder = ’reportbuilder.app’ significa que se está empleando el nuevo Diseñador de informes, por lo que el comportamiento, y las ventanas son un tanto diferentes.

Se muestra el nuevo cuadro para generar expresiones con un cuadro combinado para seleccionar la tabla que mostrará sus campos en la lista de campos. Es aquí donde debemos prestar atención, se van a mostrar solamente las tablas que estén realmente en uso. Las tablas definidas en el Entorno de datos del informe no se abren automáticamente por el Diseñador de informes, por tanto, no aparecerán en este cuadro combinado.

Esta característica, que no es muy intuitiva al inicio, nos reporta gran beneficio, ya que es la forma más segura y limpia para garantizar que el usuario va a manipular solamente las tablas a las que le demos acceso. Se trata de extender los informes y brindar al usuario final posibilidades para su configuración; pero evitando todo tipo de riesgos. Entonces, las tablas que vamos a utilizar y no queremos que el usuario manipule las creamos en el Entorno de Datos y solo abrimos por fuera aquellas que el usuario necesita manipular.

Podemos además, proteger el Entorno de Datos y no permitir al usuario que acceda, por cierto, que la posibilidad de proteger datos es otra gran novedad del Diseñador de Informes en VFP 9.0

En tiempo de ejecución, el nuevo motor de informe de VFP 9.0 cambia el tratamiento de la sesión actual de datos, agrega sesiones nuevas, su dominio y correcta manipulación, son esenciales para la correcta obtención de los datos… de este importante tema hablaremos otro día.

Espero que haya resultado de utilidad.

Saludos,

Ana María Bisbé York
www.amby.net

25 de julio de 2017

Registrando cambios a vistas locales - Actualización

Artículo original: Logging Changes to Local Views - Updated
Autor: Nancy Folsom
Traducido por: Luis María Guayán


Escribí un artículo en el boletín de noticias de VFUG sobre una sencilla manera de rastrear los cambios a las vistas y a las tablas usando eventos de la base de datos. Este artículo muestra los retoques que he hecho durante los dos últimos dos meses, que incluye un sencillo informe de cambios.

Nota del traductor: El artículo que indica Nancy se lo puede ver en: Registrando cambios a vistas locales

¿Eventos de la base de datos con código en un archivo PRG  externo o en procedimientos almacenados?

Originalmente,  he planeado utilizar un archivo PRG externo para los eventos de la base de datos en vez de los procedimientos almacenados del contenedor de la base de datos. Mi razón para esto era porque utilizo múltiples contenedores de base de datos en mis proyectos y no quise cortar y pegar código, ya que es tan difícil mantener los cambios sincronizados. Esta opción funcionó bien durante el desarrollo. Sin embargo, esto causó problemas cuando actualicé las bases de datos de un cliente, que son usadas para abastecer una aplicación ASP.NET. Confieso que yo no tuve el tiempo ni los recursos para comprender completamente el problema. Sin embargo, en resumen, la aplicación en ASP.NET devolvió errores de OLEDB. Entiendo la razón por la cual un evento de la base de datos en un archivo PRG externo causaría el problema para una interfase Web; sin embargo no he tenido tiempo para investigar a fondo porqué el desencadenante dbc_AfterModifyView se dispararía.

Otro asunto surgió conjuntamente con usar la herramienta Stonefield Data Toolkit (SDT) (versión 6.1c). Esta herramienta permite que utilice los eventos de una base de datos en archivos PRG externos, así que esto no era el problema, y creará el código SDT para los eventos de la base de datos. SDT utiliza los procedimientos almacenados (SPs), sin embargo, no utilizará el archivo PRG externo que he seleccionado. Los eventos de la base de datos basados en archivos PRG tienen prioridad sobre los procedimientos almacenados. Eso no es un problema insuperable, puesto que es fácil mover el código de SDT desde el SPs. Considerando el primer problema, sin embargo, he decidido utilizar el SPs. Por motivos simples, continuaré utilizando un PRG externo para este artículo.

Nueva versión del programa para crear los eventos de base de datos y la tabla de registro

El siguiente código es una versión revisada del código de instalación del último artículo. Esto crea una base de datos de registro de modificaciones y la tabla. Añadí un pequeño campo de comentario para mostrar en el informes de modificaciones, y agregué valores por defecto para tTimeStamp y cComment. El campo cComment pretende cumplir el objetivo de contener los comentarios en el código ya que no podemos comentar las vistas locales. Además está actualizado.

* ModifyViewTracker_Part_II.PRG
*
* 2005.05.20 Nancy Folsom, Pixel Dust Industries
* Este programa crea un contenedor de base de datos y una tabla
* para registrar las modificaciones en vistas y tablas
*
* * Se asume que se ejecuta en el directorio de desarrollo
* * ¡Cuidado! Como cualquier código que cambia datos, primero 
* * haga un respaldo de sus datos, y pruebe el código sobre algunos
* * datos de prueba antes de ejecutarlo sobre datos de producción
*
* Creamos el registro de modificaciones
*
Close Databases All
If File(Fullpath('ChangeLog.DBC'))
  Delete File (Fullpath('ChangeLog.DBC'))) recycle
Endif
Create Database ChangeLog
  Set Database To ChangeLog
If File(Fullpath('ChangeLogEvents.DBF'))
  Delete File (Fullpath('ChangeLogEvents.DBF'))) recycle
Endif
Create Table ;
  ChangeLogEvents (;
  IID I Autoinc, ;
  cObjectName C(254), ;
  cAction C(254) Default Program(), ;
  mValue M, ;
  cComment C(254) Default Iif(Version(2)=2,;
  InputBox("Comment:","Comment Change",""),""),    ;
  tTimeStamp T Default Datetime())

Local lcDBC, lcLogFile, lcPRG
*
* Creamos los eventos PRG usando los comandos TEXT y StrToFile()
*
TEXT to lcPrg textmerge noshow

Procedure dbc_AfterCreateView(cViewName,lRemote)
  * Almacenamos la estructura de la sentencia SQL
  Local lnSelect
    lnSelect = Select()
  * Almacenamos la definición SQL
  Insert Into ChangeLog!ChangeLogEvents ( ;
    mValue,cObjectName ) Values ( ;
    DBGetProp(cViewName,"VIEW","SQL"),cViewName)
  Use In ChangeLogEvents
    Select (lnSelect)
Endproc
Procedure dbc_AfterModifyView(cViewName,lChanged)
  * Almacenamos la estructura de la sentencia SQL
  If lChanged
    Local lnSelect
    lnSelect = Select()
    * Almacenamos la definición SQL
    Insert Into ChangeLog!ChangeLogEvents ( ;
      mValue,cObjectName ) Values ( ;
      DBGetProp(cViewName,"VIEW","SQL"),cViewName)
    Use In ChangeLogEvents
    Select (lnSelect)
  Endif
Endproc
Procedure dbc_AfterCreateTable(cTableName,cLongTableName)
  * Almacenamos la estructura y la información acerca de los índices de la tabla
  Local lcAlias
    lcAlias = JustStem(cTableName)
  Insert Into ChangeLog!ChangeLogEvents (;
    mValue,cObjectName) Values (;
    GetStructure(lcAlias),Justfname(cTableName))
  Use In ChangeLogEvents
  Select (lcAlias)
Endproc

Procedure dbc_AfterModifyTable(cTableName,lChanged)
  * Almacenamos la estructura y la información acerca de los índices de la tabla
  If lChanged
    Local lcAlias
      lcAlias = JustStem(cTableName)
    Insert Into ChangeLog!ChangeLogEvents (;
      mValue,cObjectName) Values (;
      GetStructure(lcAlias),cTableName)
    Use In ChangeLogEvents
    Select (lcAlias)
  Endif
Endproc
Procedure GetStructure(tcAlias)
  Local lni,lnj,laArray[1],lcStructure
    lcStructure = "Field structures"+Chr(13)
  Select (tcAlias)
  * Por cada campo en la tabla ...
  For lni = 1 To Afields(laArray)
    For lnj = 1 To Alen(laArray,2) - 1
      * ... capturamos la estructura de la tabla
      lcStructure = lcStructure+;
      Transform(laArray[lni,lnj])+","
    Next lnj
    lcStructure = lcStructure+;
    Transform(laArray[lni,lnj])+Chr(13)
  Next lni
  lcStructure = lcStructure+Chr(13)+"Indices"+Chr(13)
  * Por cada etiqueta de índice ...
  For lni=1 To Ataginfo(laArray)
    For lnj=1 To Alen(laArray,2) - 1
      * ... capturamos el nombre de la etiqueta y la expresión
      lcStructure=lcStructure+laArray[lni,lnj]+","
    Next lnj
    lcStructure=lcStructure+laArray[lni,lnj]+Chr(13)
  Next lni
  Return lcStructure
Endproc
ENDTEXT
* Guardamos la cadena que hicimos con TEXT en un PRG.
lcLogFile="DataBaseEvents.PRG"
If File(Fullpath("DataBaseEvents.PRG"))
  lcLogFile=Forceext(Putfile("Save PRG As","DataBaseEvents","PRG"),;
    'PRG')
Endif
Strtofile(lcPRG,lcLogFile)
Compile (lcLogFile) 

La siguiente porción de código puede ser copiada a un PRG y ejecutada como una prueba. Este código creará una base de datos, una tabla y una vista de ejemplo. Esto también modificará la tabla. Cuando la tabla y la vista son creadas, y cuando la estructura de tabla es modificada, las entradas de registro serán hechas. Ingreso por teclado un cComment. Generalmente cada vez que un registro es insertado en la tabla de registro de modificaciones, le será solicitado un breve comentario a raíz del valor por omisión.

* DemoChangeLog.PRG
*
Close Databases All
Set Exclusive On
If File(Fullpath('ChangeLogExample.DBC'))
  Delete File Fullpath('ChangeLogExample.DBC') recycle
Endif
Create Database ChangeLogExample
Set Database To ChangeLogExample
* Habilitamos los eventos de la base de datos y apuntamos al 
* archivo PRG creado en el PRG de instalación
DBSetProp("ChangeLogExample","Database","DBCEvents",.T.)
DBSetProp("ChangeLogExample","Database","DBCEventFilename",;
  lcLogFile)
If File(Fullpath('ChangeLogExample.DBF'))
  Delete File Fullpath('ChangeLogExample.DBF') recycle
Endif
* Creamos la tabla: Ingresamos un comentario por teclado
Keyboard "Created table 'ChangeLogExample'" + Chr(13)
Create Table ChangeLogExample (;
  IID I Autoinc Primary Key, ;
  tTimeStamp T Default Datetime())
Close Tables All
* Creamos la vista: Ingresamos un comentario por teclado
Keyboard "Created view 'cDescription'" + Chr(13)
Create Sql View lv_ChangeLogExample As ;
  select * From ChangeLogExample
* Modificamos la tabla
Keyboard "Added field 'cDescription'" + Chr(13)
Alter Table ChangeLogExample ;
  Add Column cDescription C(32)
Close Databases All
Public oform1
oform1 = Newobject("form1")
oform1.Show
Return

Finalmente tendré ganas de ver la diferencia exacta entre dos versiones de, en mi caso, una vista. En el camino de ese objetivo, primero hice un formulario sencillo que lista los cambios, dentro de un rango de fechas, y si se quiere, un detalle del cambio. El siguiente código puede ser ejecutado en un directorio con la tabla ChangeLogEvents. Esto debería parecerse a lo que se muestra en la siguiente figura:

Aquí está el código del formulario.

**************************************************
*-- Form:         form1 (changelog_report.scx)
*-- ParentClass:  form
*-- BaseClass:    form
*-- Time Stamp:   05/20/05 06:11:04 PM
*
Define Class form1 As Form
  Height = 480
  Width = 640
  Caption = "Form1"
  startdate = {}
  enddate = {}
  Name = "Form1"
  Add Object line1 As Line With ;
    Height = 0, ;
    Left = 2, ;
    Top = 37, ;
    Width = 636, ;
    Name = "Line1"
  Add Object line2 As Line With ;
    Height = 0, ;
    Left = 2, ;
    Top = 158, ;
    Width = 636, ;
    Name = "Line2"
  Add Object text1 As TextBox With ;
    Century = 0, ;
    ControlSource = "thisform.StartDate", ;
    Format = "D", ;
    Height = 23, ;
    Left = 70, ;
    Top = 2, ;
    Name = "Text1"
  Add Object text2 As TextBox With ;
    ControlSource = "Thisform.EndDate", ;
    Format = "D", ;
    Height = 23, ;
    Left = 187, ;
    Top = 2, ;
    Name = "Text2"
  Add Object label1 As Label With ;
    Caption = "Report from", ;
    Height = 17, ;
    Left = 2, ;
    Top = 5, ;
    Width = 67, ;
    Name = "Label1"
  Add Object label2 As Label With ;
    Caption = "to", ;
    Height = 17, ;
    Left = 174, ;
    Top = 5, ;
    Width = 12, ;
    Name = "Label2"
  Add Object command1 As CommandButton With ;
    Left = 293, ;
    Height = 27, ;
    Width = 97, ;
    Caption = "Refresh", ;
    Name = "Command1"
  Add Object list1 As ListBox With ;
    BoundColumn = 4, ;
    ColumnCount = 5, ;
    ColumnWidths = "230,230,145,0,0", ;
    RowSourceType = 3, ;
    Height = 93, ;
    Left = 2, ;
    MultiSelect = .T., ;
    Top = 46, ;
    Width = 636, ;
    BoundTo = .T., ;
    Name = "List1"
  Add Object edit1 As EditBox With ;
    Height = 309, ;
    Left = 2, ;
    Top = 167, ;
    Width = 636, ;
    Name = "Edit1"
  Add Object label3 As Label With ;
    Caption = "Changes", ;
    Left = 5, ;
    Top = 29, ;
    Width = 53, ;
    Name = "Label3"
  Add Object label4 As Label With ;
    Caption = "Details", ;
    Left = 2, ;
    Top = 150, ;
    Width = 41, ;
    Name = "Label4"
  Procedure Init
    Bindevent(This.command1,'Click',This.list1,'Refresh')
    Bindevent(This.list1,'InteractiveChange',This.edit1,'Refresh')
  Endproc
  Procedure text1.Init
    Select Min(Ttod(tTimeStamp)) As MinDate ;
      From ChangeLogEvents ;
      Into Cursor lvwTemp
    This.Value = lvwTemp.MinDate
    Use In lvwTemp
  Endproc
  Procedure text2.Init
    Select Max(Ttod(tTimeStamp)) As MaxDate ;
      From ChangeLogEvents ;
      Into Cursor lvwTemp
    This.Value = lvwTemp.MaxDate
    Use In lvwTemp
  Endproc
  Procedure list1.Init
    This.RowSource = ;
      "select padr(juststem(cobjectname),254) as Object_Name, " + ;
      "cComment, tTimeStamp, iID, mValue from changelogevents " + ;
      "into cursor lvwChanges where between(ttod(tTimeStamp), " + ;
      " thisform.StartDate, thisform.EndDate) Order by tTimeStamp"
  Endproc
  Procedure list1.Refresh
    This.RowSource = This.RowSource
  Endproc
  Procedure list1.InteractiveChange
    Raiseevent(This,'InteractiveChange')
  Endproc
  Procedure edit1.Refresh
    This.Value = lvwChanges.mValue
  Endproc
Enddefine
*
*-- EndDefine: form1
**************************************************

Mi próxima revisión será seleccionar y luego ver las diferencias entre dos modificaciones. He pensado automatizar la característica de comparar documentos de Microsoft Word, pero he estado descontenta en el modo que Office 2003 arruinó, en mi opinión, lo que había sido una característica muy agradable. Y esto, mejor dicho, es una exageración para mi objetivo. Lo invito a que se contacte conmigo en nfolsomNOSPAM@NOSPAMpixeldustindustries.com con cualquier comentario, pregunta o críticas. Sus comentarios serán bienvenidos.

Obsérvese que los eventos de la base de datos fueron agregados en Visual FoxPro 7.0. Usted puede leer más sobre ellos en http://msdn.microsoft.com/library/en-us/dv_foxhelp/html/neconDatabaseContainerEvents.asp.

Nancy Folsom

21 de julio de 2017

Imprimir un gráfico creado con SimpleChart

SimpleChart es una clase creada por Mike Lewis (http://www.ml-consult.co.uk) quien logra, mediante un grupo de propiedades, facilitar el trabajo con MSChart y posibilitar que se obtengan gráficos con mucha rapidez y sin complejidades.

Para ver todos los detalles relativos a esta clase ver:

SimpleChart revisado (Mike Lewis) Traducción
https://comunidadvfp.blogspot.com/2003/10/simplechart-revisitado.html

Nos había quedado pendiente aclarar cómo se pueden imprimir estos gráficos. Pues bien, la pregunta es ¿Se puede copiar un gráfico creado con SimpleChart en un informe de VFP?

¡¡Sí se puede!! Tal y como se indica en el segundo artículo, hay que invocar el método EditCopy del gráfico.

Aquí dejo un ejemplo concreto

* Copiar al Clipboard
THISFORM.Grafico.EditCopy
* Copiar a un bmp
THISFORM.cRutaGrafico = GETENV("Temp")+SYS(2015)+".bmp"
DO Graficos WITH (THISFORM.cRutaGrafico),""

Pego directamente el código del programa gráficos escrito por el compañero J. Enrique Ramos Menchaca, quien lo publicó en PortalFox y nos autorizó a modificarlo dadas las nuevas necesidades que yo tenía.

Cambios que hicimos:

  1. Incluir 2 parámetros: tcArchivo, tcreporte
    • tcArchivo - nombre del .bmp que se va a cargar en el objeto imagen del informe
    • tcreporte - nombre del reporte a llamar
  2. No emplear campo general y sí campo de caracteres con la ruta de la imagen a mostrar, mira donde dice código nuevo.

Lo único que necesitamos es copiar y pegar el programa gráfico en nuestra aplicación e invocarlo con los parámetros adecuados.

***********************************************
* Programa Graficos
* Autor: J. Enrique Ramos Menchaca
* Modificado por Jorge Mota y Ana María Bisbé York
***********************************************
LPARAMETERS tcArchivo, tcreporte
#DEFINE CF_BITMAP 2
#DEFINE OBJ_BITMAP 7
DO decl
LOCAL hClipBmp, lcTargetFile
*lcTargetFile = "C:\clipboard.bmp"
lcTargetFile = tcArchivo && "grafime.bmp"
= OpenClipboard (0)
hClipBmp = GetClipboardData (CF_BITMAP)
= CloseClipboard()
IF hClipBmp = 0 Or GetObjectType(hClipBmp) <> OBJ_BITMAP
  = MessageBox("No se encontro imagen bitmap en el Portapapeles.",;
    64, "Clipboard to BMP")
  RETURN .F.
ENDIF
= bitmap2file (hClipBmp, lcTargetFile)
= DeleteObject (hClipBmp)
***
* crear las referencias para los arreglos
* external array laAspecto, lavalor, laporci,;
* lavalor1, lavalor2, lavalor3, lavalor4
* Código original
*!* CREATE CURSOR GRAFICO (GRAFICA G)
*!* APPEND BLANK
*!* APPEND GENERAL GRAFICO.GRAFICA FROM "c:\clipboard.bmp"
*!* REPORT FORM GRAFICA preview
*!* USE IN grafico
*!* RETURN
* Código modificado
CREATE CURSOR GRAFICO (cRuta c(250))
APPEND BLANK
REPLACE GRAFICO.cRuta WITH tcArchivo
IF !empty(tcreporte)
  REPORT FORM (tcreporte) to print prompt noconso
ENDIF
USE IN GRAFICO
RETURN
***********************************************
* InitBitsArray()
***********************************************
PROCEDURE InitBitsArray()
  #DEFINE GMEM_FIXED 0
  LOCAL lnPtr
  pnBitsSize = pnHeight * pnBytesPerScan
  lnPtr = GlobalAlloc (GMEM_FIXED, pnBitsSize)
  = ZeroMemory (lnPtr, pnBitsSize)
  RETURN lnPtr
ENDPROC

***********************************************
* String2file
***********************************************
PROCEDURE String2File (hFile, lcBuffer)
  DECLARE INTEGER WriteFile IN kernel32;
    INTEGER hFile, STRING @lpBuffer, INTEGER nBt2Write,;
    INTEGER @lpBtWritten, INTEGER lpOverlapped
  = WriteFile (hFile, @lcBuffer, Len(lcBuffer), 0, 0)
  RETURN
ENDPROC

***********************************************
* Bitmap2file
***********************************************
PROCEDURE Bitmap2file (hBitmap, lcTargetFile)
  #DEFINE DIB_RGB_COLORS 0
  PRIVATE pnWidth, pnHeight, pnBitsSize, pnRgbQuadSize, pnBytesPerScan
  STORE 0 TO pnWidth, pnHeight, pnBytesPerScan, pnBitsSize, pnRgbQuadSize
  = GetBitmapDimensions(hBitmap, @pnWidth, @pnHeight)
  LOCAL lpBitsArray, lcBInfo
  lcBInfo = InitBitmapInfo()
  lpBitsArray = InitBitsArray()
  LOCAL hwnd, hdc, hMemDC
  hwnd = GetActiveWindow()
  hdc = GetWindowDC(hwnd)
  hMemDC = CreateCompatibleDC (hdc)
  = ReleaseDC (hwnd, hdc)
  = GetDIBits (hMemDC, hBitmap, 0, pnHeight, lpBitsArray,;
    @lcBInfo, DIB_RGB_COLORS)
  #DEFINE BFHDR_SIZE 14 && BITMAPFILEHEADER
  #DEFINE BHDR_SIZE 40 && BITMAPINFOHEADER
  LOCAL hFile, lnFileSize, lnOffBits, lcBFileHdr
  lnFileSize = BFHDR_SIZE + BHDR_SIZE + pnRgbQuadSize + pnBitsSize
  lnOffBits = BFHDR_SIZE + BHDR_SIZE + pnRgbQuadSize
  lcBFileHdr = "BM" + num2dword(lnFileSize) +;
    num2dword(0) + num2dword(lnOffBits)
  #DEFINE GENERIC_WRITE 1073741824 && 0x40000000
  #DEFINE FILE_SHARE_WRITE 2
  #DEFINE CREATE_ALWAYS 2
  #DEFINE FILE_ATTRIBUTE_NORMAL 128
  #DEFINE INVALID_HANDLE_VALUE -1
  hFile = CreateFile (lcTargetFile,;
    GENERIC_WRITE,;
    FILE_SHARE_WRITE, 0,;
    CREATE_ALWAYS,;
    FILE_ATTRIBUTE_NORMAL, 0)
  IF hFile <> INVALID_HANDLE_VALUE
    WAIT WINDOW "Storing to file..." NOWAIT
    = String2File (hFile, @lcBFileHdr)
    = String2File (hFile, @lcBInfo)
    = Ptr2File (hFile, lpBitsArray, pnBitsSize)
    = CloseHandle (hFile)
  ELSE
    = MessageBox("Unable to create file: " + lcTargetFile)
  ENDIF
  = GlobalFree(lpBitsArray)
  = DeleteDC (hMemDC)
  RETURN
ENDPROC

***********************************************
* Ptr2File
***********************************************
PROCEDURE Ptr2File (hFile, lnPointer, lnBt2Write)
  DECLARE INTEGER WriteFile IN kernel32;
    INTEGER hFile, INTEGER lpBuffer, INTEGER nBt2Write,;
    INTEGER @lpBtWritten, INTEGER lpOverlapped
  = WriteFile (hFile, lnPointer, lnBt2Write, 0, 0)
  RETURN
ENDPROC

***********************************************
* InitBitmapInfo
***********************************************
PROCEDURE InitBitmapInfo(lcBIHdr)
  #DEFINE BI_RGB 0
  #DEFINE RGBQUAD_SIZE 4
  #DEFINE BHDR_SIZE 40
  LOCAL lnBitsPerPixel, lcBIHdr, lcRgbQuad
  lnBitsPerPixel = 24
  pnBytesPerScan = Int((pnWidth * lnBitsPerPixel)/8)
  IF Mod(pnBytesPerScan, 4) <> 0
    pnBytesPerScan = pnBytesPerScan + 4 - Mod(pnBytesPerScan, 4)
  ENDIF
  lcBIHdr = num2dword(BHDR_SIZE) + num2dword(pnWidth) +;
  num2dword(pnHeight) + num2word(1) + num2word(lnBitsPerPixel) +;
  num2dword(BI_RGB) + Repli(Chr(0), 20)
  IF lnBitsPerPixel <= 8
    pnRgbQuadSize = (2^lnBitsPerPixel) * RGBQUAD_SIZE
    lcRgbQuad = Repli(Chr(0), pnRgbQuadSize)
  ELSE
    lcRgbQuad = ""
  ENDIF
  RETURN lcBIHdr + lcRgbQuad
ENDPROC

***********************************************
* num2dword
***********************************************
FUNCTION num2dword (lnValue)
  #DEFINE m0 256
  #DEFINE m1 65536
  #DEFINE m2 16777216
  LOCAL b0, b1, b2, b3
  b3 = Int(lnValue/m2)
  b2 = Int((lnValue - b3*m2)/m1)
  b1 = Int((lnValue - b3*m2 - b2*m1)/m0)
  b0 = Mod(lnValue, m0)
  RETURN Chr(b0)+Chr(b1)+Chr(b2)+Chr(b3)
ENDFUNC

***********************************************
* GetBitmapDimensions
***********************************************
PROCEDURE GetBitmapDimensions(hBitmap, lnWidth, lnHeight)
  #DEFINE BITMAP_STRU_SIZE 24
  LOCAL lcBuffer
  lcBuffer = Repli(Chr(0), BITMAP_STRU_SIZE)
  IF GetObjectA (hBitmap, BITMAP_STRU_SIZE, @lcBuffer) <> 0
    lnWidth = buf2dword (SUBSTR(lcBuffer, 5,4))
    lnHeight = buf2dword (SUBSTR(lcBuffer, 9,4))
  ENDIF
  RETURN
ENDPROC

***********************************************
* buf2dword
***********************************************
FUNCTION buf2dword (lcBuffer)
  RETURN Asc(SUBSTR(lcBuffer, 1,1)) + ;
    Asc(SUBSTR(lcBuffer, 2,1)) * 256 +;
    Asc(SUBSTR(lcBuffer, 3,1)) * 65536 +;
    Asc(SUBSTR(lcBuffer, 4,1)) * 16777216
ENDFUNC

***********************************************
* num2word
***********************************************
FUNCTION num2word (lnValue)
  RETURN Chr(MOD(m.lnValue,256)) + CHR(INT(m.lnValue/256))
ENDFUNC

***********************************************
* decl
***********************************************
PROCEDURE decl
  DECLARE INTEGER GetActiveWindow IN user32
  DECLARE INTEGER GetClipboardData IN user32 INTEGER uFormat
  DECLARE INTEGER OpenClipboard IN user32 INTEGER hwnd
  DECLARE INTEGER CloseClipboard IN user32
  DECLARE INTEGER DeleteObject IN gdi32 INTEGER hObject
  DECLARE INTEGER GetWindowDC IN user32 INTEGER hwnd
  DECLARE INTEGER ReleaseDC IN user32 INTEGER hwnd, INTEGER hdc
  DECLARE INTEGER CreateCompatibleDC IN gdi32 INTEGER hdc
  DECLARE INTEGER DeleteDC IN gdi32 INTEGER hdc
  DECLARE INTEGER GlobalAlloc IN kernel32 INTEGER wFlags, INTEGER dwBytes
  DECLARE INTEGER GlobalFree IN kernel32 INTEGER hMem
  DECLARE INTEGER GetObject IN gdi32 AS GetObjectA;
    INTEGER hgdiobj, INTEGER cbBuffer, STRING @lpvObject
  DECLARE INTEGER GetObjectType IN gdi32 INTEGER h
  DECLARE RtlZeroMemory IN kernel32 As ZeroMemory;
    INTEGER dest, INTEGER numBytes
  DECLARE INTEGER GetDIBits IN gdi32;
    INTEGER hdc, INTEGER hbmp, INTEGER uStartScan,;
    INTEGER cScanLines, INTEGER lpvBits, STRING @lpbi,;
    INTEGER uUsage
  DECLARE INTEGER CreateFile IN kernel32;
    STRING lpFileName, INTEGER dwDesiredAccess,;
    INTEGER dwShareMode, INTEGER lpSecurityAttr,;
    INTEGER dwCreationDisp, INTEGER dwFlagsAndAttrs,;
    INTEGER hTemplateFile
  DECLARE INTEGER CloseHandle IN kernel32 INTEGER hObject
ENDPROC

***********************************************

Espero que sirva como complemento a la información que ya teníamos para trabajar con esta clase SimpleChart

Saludos,

Ana María Bisbé York
www.amby.net


17 de julio de 2017

Técnicas para una interfaz alternativa de Report Preview

Artículo original: Techniques for an alternative Report Preview UI
http://www.spacefold.com/colin/archive/articles/reportpreview/techniques.htm
Autor: Colin Nicholls
Traducido por: Ana María Bisbé York


Antes de comenzar

Un grupo importante de los debates sobre informes en VFP de estos últimos tiempos en Universal Thread (http://www.universalthread.com) se han referido al tema de la nueva pantalla de presentación preliminar (Report Preview) y cómo controlarla. Un aspecto particularmente debatido es el comportamiento de la barra de herramientas cuando empleamos REPORT FORM ... PREVIEW en una aplicación de nivel superior. Existe un bug en VFP 9.0 (vea el código para reproducirlo en http://www.spacefold.com/colin/archive/articles/reportpreview/repro.prg) que provoca que la barra de herramientas asociada sea visible, aunque inhabilitada a los clics del ratón. La funcionalidad existe a través del menú contextual de la ventana preliminar, pero esto se convierte en un problema de educación de los usuarios o hay que utilizar NOWAIT para forzar que la ventana preliminar se muestre como una forma no modal. ( Esto no es un gran problema, ahora que tenemos la cláusula NOPAGEEJECT en el comando report form. Muchas de las razones por la que la gente piensa que necesitan una ventana modal no se aplican.

No obstante de los bugs del producto, en mis sesiones me esfuerzo por mostrar que la presentación preliminar predeterminada es sólo eso - predeterminada - y que ahora, no sólo son posible formularios con soluciones alternativas, sino que son fáciles de implementar. Entonces, voy a mostrar hoy una interfaz de usuario alternativa para la ventana de presentación preliminar que puede utilizar y personalizar acorde a sus contenidos.

He aquí una presentación preliminar.

Esto es lo que estamos construyendo:

Es un formulario sencillo con algunos botones y un contenedor en el que reside un control forma (shape) en el que se generará una única página del informe. El formulario permite hacer acercamientos y alejamientos (zoom) y arrastrar la página, empleando el ratón, por dentro del contenedor.

Realmente, aquí no hay mucho que hacer.

Crear el marco preliminar

*------------------------------------------------
* Marco preliminar...
*------------------------------------------------
define class myFrame as Container
  Width = 296
  Height = 372
  Left = 12
  Top = 12
  SpecialEffect = 1
  BackColor = rgb(192,192,192)

  add Object canvas as myCanvas && vea debajo:
enddefine

*------------------------------------------------
* ...y su forma hija:
*------------------------------------------------
define class myCanvas as Shape
  Height = 330
  Width = 255
  Left = 20
  Top = 20
  BackColor = rgb(255,255,255)

Vamos a permitir que la forma se mueva dentro del marco añadiendo código al evento .MouseDown del objeto Shape.

  procedure MouseDown
    lparameters nButton, nShift, nXCoord, nYCoord

    offsetX = m.nXCoord - THIS.Left
    offsetY = m.nYCoord - THIS.Top
  
    THISFORM.MousePointer = 5
    do while mdown()
      THIS.Left = mcol(0,3) - m.offsetX
      THIS.Top = mrow(0,3) - m.offsetY
    enddo
    THISFORM.MousePointer = 0 
  endproc
enddefine

El .MousePointer de 5 es el puntero del ratón que muestra ambas flechas NSEO en lugar de un cursor normal. Puede verlo en la figura mostrada antes.

Crear la clase form

Ahora que ya tenemos el marco, podemos crear la clase form myPreview y colocarlo en el marco:

*------------------------------------------------
* La clase form:
*------------------------------------------------
define class myPreview as Form
  add object frame as myFrame && vea arriba

Junto con los botones de comandos:

  add object cmdPrev as myButton ;
    with Top=12, Caption = "Previous"
  add object cmdNext as myButton ;
    with Top=44, Caption = "Next"
  add object cmdZoomIn as myButton ;
    with Top=96, Caption = "Zoom In"
  add object cmdZoomOut as myButton ;
    with Top=128, Caption = "Zoom Out"
  add object cmdReset as myButton ;
    with Top=176, Caption = "Whole Page"
  add object cmdClose as myButton ;
    with Top=220, Caption = "Close"

La clase derivada myButton que he utilizado aquí es precisamente una plantilla para .FontName, .FontStyle y la posición .Left. En breve, vamos a implementar algunos .Click. Sea paciente.

Viendo cómo necesitamos interactuar con el motor de informes, vamos a darle al formulario un par de propiedades de usuarios: Un marcador de posición para una referencia a un objeto ReportListener, y una propiedad numérica para el número de página actual:

Listener = .null.
PageNo = 1

La llave para crear un formulario de presentación preliminar en VFP 9.0 es utilizar el método OutPutPage de ReportListener, pasándole tres parámetros:

  • El número de página a generar
  • El dispositivo u objeto para generar la presentación preliminar
  • Un número que indica el tipo de dispositivo u objeto que se está generando.

Ya que estamos generando un objeto Visual FoxPro - THIS.Frame.Canvas - el parámetro - tipo de dispositivo es 2. Vamos a tener el número de página en THIS.PageNo, y la referencia al ReportListener es THIS.Listener, así que la sintaxis completa será:

THIS.Listener.OutputPage(THIS.PageNo, THIS.Frame.Canvas, 2)

Vamos a colocar todo el código - con las condiciones de verificación de límites - en un método de usuario del formulario, OutPage():

procedure Outputpage()
  with THIS
    if not isnull(.Listener) and .Listener.PageTotal > 0
      .Listener.OutputPage(.PageNo, .Frame.Canvas, 2)
      .Caption = ;
        justfname(.Listener.commandClauses.file) ;
        + " - page " + trans(.PageNo)
    endif
  endwith
endproc

Como puede ver, vamos a utilizar la propiedad Caption del formulario para mostrar el nombre de archivo y el número de página actual, solo por dejar las cosas más sencillas. Para asegurar que la página de informe se generará cuando se dibuje el formulario, añadimos una llamada a nuestro método de usuario en el evento Paint del formulario:

procedure Paint()
  THIS.OutputPage()
endproc

Hacer que estos botones reaccionen al Clic

¿Recuerda aquellos botones de comando que agregamos al formulario? Tenemos un par para la navegación alrededor del informe. Es importante tener en cuenta las condiciones de límites entre datos. El máximo número de páginas que se puede generar está determinado por: ReportListener.PageTotal:

procedure cmdPrev.Click
  with THISFORM
    .PageNo = max(1,.PageNo-1)
    .OutputPage()
  endwith
endproc

procedure cmdNext.Click
  with THISFORM
    .PageNo = min(.Listener.PageTotal,.PageNo+1)
    .OutputPage()
  endwith
endproc

Tenemos además un par de comandos para ajustar el tamaño de la presentación preliminar. Es fácil: solamente cambiar el tamaño del Shape y llamar a OutPutPage para re-pintar:

#define ZOOM_SCALE 1.3

procedure cmdZoomIn.Click
  with THISFORM.Frame.Canvas
    .Width = int(.Width * ZOOM_SCALE)
    .Height = int(.Height * ZOOM_SCALE)
  endwith
  THISFORM.OutputPage()
endproc

procedure cmdZoomOut.Click
  with THISFORM.Frame.Canvas
    .Width = max(17,int(.Width / ZOOM_SCALE))
    .Height = max(22,int(.Height / ZOOM_SCALE))
  endwith
  THISFORM.OutputPage()
endproc

Como puede ver, estamos utilizando algunas condiciones de límite en el tamaño más pequeño de la Forma, explícitamente escrito en el código 8.5 x 11, sobre esto podíamos pensar en algo más.

En caso de que desee perder el acercamiento y el movimiento, es conveniente un botón para re-inicializar el tamaño y la posición de la forma (shape).

procedure cmdReset.Click
  with THISFORM.Frame.Canvas
    .Top = 20
    .Left = 20
    .Width = 255
    .Height = 330
  endwith
endproc

El botón Cerrar no es realmente necesario - el formulario tiene su cuadro Cerrar en el título que funciona perfectamente. Pero, permítanme agregarlo de todas formas:

procedure cmdClose.Click
  THISFORM.Release()
endproc

Probamos hasta ahora

Bien, ¡Lo hemos hecho!, ahora vamos a probarlo. Lo primero que necesitamos es crear un ReportListener

rl = newobject("ReportListener")
rl.ListenerType = 3

Vea que estamos utilizando un ReportListener igual a 3. Un ListenerType igual a 1 provocaría que se invocara el contenedor preliminar predeterminado que no es lo deseado en este caso: Deseamos solamente generar la salida y guardarla en memoria temporal (caché) para nuestro propio empleo.

Ahora, necesitamos el motor de informes para que envíe un informe a nuestro listener:

report form ? object m.rl

Escoja cualquier informe que desee. (Yo escogí _SAMPLES+"\Solution\Reports\wrapping.frx" porque es bonito.) Ahora debemos instanciar nuestra Interfaz de usuario y asignarle una referencia a nuestra instancia ReportListener, y pedirle que lo muestre:

x = newobject("myPreview")
x.Listener = m.rl
x.Show(1)

Esperemos que en este punto tengamos algo como lo que tenemos en la figura mostrada antes.

  • Intente navegar por el informe.
  • Intente hacer Zoom.
  • Trate de arrastrar la página.

Un pequeño problema

Bien, confieso que he omitido ante un aspecto importante. (Los escritores de artículos hacen así todo el tiempo, porque piensan que es un buen recurso didáctico.)

Como probablemente ha notado, el método ReportListener.OutputPage() utiliza la posición y las dimensiones del objeto Shape para generar la página del informe sobre la superficie del formulario. En realidad no dibuja el objeto como tal.

Como resultado, la página sobre-escribe los otros controles en el formulario, produciendo un efecto visual desconcertante. Vea la imagen.

Existe una solución: tenemos que utilizar parámetros adicionales a OutPutPage() para especificar los límites dentro de los que se va a dibujar la imagen.

Especificar un área fija para OutputPage()

La documentación para el método OutPutPage (ver ayuda VFP) indica que los parámetros adicionales no se aplican para un tipo de dispositivo igual a 2 (2 = objeto FoxPro) Esto no es estrictamente correcto. En realidad, los parámetros 4to, 5to, 6to y 7mo se ignoran; pero los parámetros nClipLeft, nClipTop, nClipWidth, y nClipHeight se respetan por el método ReportListener.OutputPage() para objetos FoxPro

Estos cuatro parámetros finales definen una "ventana" - en pixels - en el área del formulario a través de la cual la salida regenerada va a aparecer. Cualquier cosa que quede fuera de esta área no se mostrará en el formulario.

Afortunadamente para nosotros, tenemos la forma conveniente para determinar la ubicación y dimensiones de área fija: el objeto frame como tal nos lo dirá.

Substituya la línea de código resaltada en negrita en el método OutPutPage del formulario para que sean especificados los parámetros adicionales:

* .Listener.OutputPage( .PageNo, .Frame.Canvas, 2 )
.Listener.OutputPage( ;
.PageNo, .Frame.Canvas, 2, ;
  0, 0 , 0 , 0 , ;
  .Frame.Left +2, ;
  .Frame.Top +2, ;
  .Frame.Width -4, ;
  .Frame.Height -4 )

Ahora el formulario preliminar debe trabajar como esperamos (vea la siguiente figura)

Ejercicios para estudiantes:

Considero que he mostrado propiedades excitantes de las posibilidades existentes. Pero no hemos hecho todo: existen algunas cosas adicionales que va a necesitar hacer antes de emplear este código en una aplicación en producción.

Debe:

  • Ajustar el código en el evento MouseDown del objeto Shape para evitar que el ratón se arrastre fuera de los límites del borde del marco.
  • Ajustar la proporción del objeto Shape para que se corresponda con las dimensiones del informe, utilizando los métodos .GetPageWidth() y .GetPageHeight() del ReportListener.
  • Permitir al formulario mostrar una escala apropiada para el nivel DPI de la pantalla, incluyendo una opción "Zoom al 100%"
  • Ajustar el código de alejamiento-acercamiento de tal forma que el centro del área visible del objeto Forma permanezca centrado en lugar de moverse basado en la posición de la esquina superior izquierda como ocurre actualmente
  • Posiblemente establecer el nivel máximo y mínimo para el zoom.

Puede además:

  • Hacer que el formulario sea redimensionable

Y quizás, lo que puede ser aun más útil, podría agregar además código adicional a la clase, para que conecte en el sistema de informes de Visual FoxPro, proporcionando un Contenedor preliminar (Preview container) alternativo cuando SET REPORTBEHAVIOR 90 está activado.

... oh, está bien. He aquí cómo se hace:

Empaquetado como Contenedor preliminar

Necesitará agregar estos métodos en la clase myPreview

*-------------------------------------------
* Métodos requeridos para que opere como 
* un contenedor preliminar :
*-------------------------------------------
procedure Release()
  if not isnull(THIS.Listener)
    THIS.Listener.OnPreviewClose(.F.)
    THIS.Listener = .null.
  endif
  THIS.Hide()
endproc

procedure Destroy()
  THIS.Listener = null
  dodefault()
endproc

procedure QueryUnload()
  nodefault
  THIS.Release()
endproc

procedure SetReport( oRef )
  if not isnull(oRef) and vartype(oRef) = "O"
    THIS.Listener = m.oRef
  else
    THIS.Listener = .null.
    THIS.Hide()
  endif
endproc

Deseará además colocar el código al inicio del archivo, de tal forma que solamente apunte a _REPORTPREVIEW directamente al programa.

*------------------------------------------
* Utilizado como contenedor preliminar:
* _REPORTPREVIEW = "<this program>"
*
* Comprobación fuera del sistema de informes:
* DO <este programa>
*------------------------------------------
lparameters oRef
if pcount()=0
  rl = newobject("ReportListener")
  rl.ListenerType = 3
  report form ? object m.rl
  x = newobject("myPreview")
  x.Listener = m.rl
  x.Show(1)
  return
else
  oRef = newobject("myPreview")
endif
return

¡Que lo disfrute!

He aquí el código fuente para este artículo: http://www.spacefold.com/colin/archive/articles/reportpreview/tech_src.prg

Copyright (c) 2005 Colin Nicholls

11 de julio de 2017

Observaciones sobre etiquetas alineadas a la derecha en informes de VFP 9.0

Artículo original: Observations on Rightaligned labels in VFP9 Reports
http://www.spacefold.com/colin/archive/articles/vfp9reporting/rightalign/monofonts.html
Autor: Colin Nicholls
Traducido por: Ana María Bisbé York


Introducción

Este artículo se basa en un trabajo que realicé tratando de contestar a una pregunta realizada por Alejandro Sosa en Universal Thread. Alex estaba teniendo problemas al alinear correctamente a la derecha títulos con campos/expresiones alineados a la derecha. Su informe era complejo y migraba desde una versión antigua de FoxPro, por lo que he creado una prueba sencilla para mostrar lo que ocurría.

Revisando: REPORTBEHAVIOR

En Visual FoxPro 9.0, existe un nuevo motor de informes que emplea GDI+ para generar la salida. Sin embargo, está soportado el motor viejo, con compatibilidad hacia atrás. Puede alternar entre los dos motores al vuelo empleando el comando SET REPORTBEHAVIOR.

Revisando: Fuentes con un único espacio contra fuentes proporcionales

Las fuentes que emplean igual espaciado tienen un ancho constante para todos los caracteres en dependencia de una altura dada. Las fuentes proporcionales utilizan anchos variables apropiado para hacer la fuente más legible. En este artículo verá la diferencia de forma muy simple: Los textos son proporcionales y los trozos de código están todos en formato de espacio único.

Resumen

En REPORTBEHAVIOR=90, todas las etiquetas de texto se van a generar con longitudes mayores que las que puede esperar al ver el Diseñador de informes. Esto se debe a que la generación de texto con GDI+ emplea más espacio. Las etiquetas sufren por esto, debido a que los diseños almacenan su posición inicial exacta, lo contrario a los campos / expresiones que permiten calcular la alineación a realizar por el motor, utilizando GDI+.

Lea más para detalles.

Observaciones

Datos de prueba

Quise comparar la alineación a la derecha para ambos tipos de valores: cadena y números, así que creé dos columnas en mi cursor de pruebas:

CREATE CURSOR x ( ftitle C(10), fnumb N(8,2) )
INSERT INTO x VALUES ( 'Bagels', 32.45 )
INSERT INTO x VALUES ( 'Cucumber', 5.23)
El informe de prueba

He aquí una imagen del informe de prueba, abierto en el diseñador, con los controles etiqueta seleccionados para mostrar sus posiciones exactas. He empleado líneas rojas para mostrar los ejes de alineación:

El control campo/expresión para los campos FTITLE y FNUMB tienen que ser configurados con Justificación: Derecha, el campo tiene que ser configurado manualmente: el campo numérico está alineado a la izquierda predeterminado. Puede ver que tengo visualmente alineadas las etiquetas con el final de cada control de campo/expresión. He duplicado el diseño de estos controles para cada una de las fuentes diferentes. Tahoma y Candara son fuentes proporcionales, y Courier New, Bitstream Vera Sans Mono y Consolas son mono espaciadas.[1]

Con REPORTBEHAVIOR 80

Así se ve la Presentación preliminar con REPORTBEHAVIOR = 80:

Y el resultado impreso

Asumiendo que las líneas rojas son una referencia exacta, se puede ver que los mejores resultados se ven con Courier New y Vera Sans Mono. Consolas y las fuentes proporcionales al parecer exceden sus posiciones esperadas ligeramente. Por tanto, debe estar muy ajustada la tolerancia para una salida aceptable, al utilizar estos tipos de fuente, o será un gran problema.

Con REPORTBEHAVIOR 90

He aquí cómo se ve la Presentación preliminar con REPORTBEHAVIOR = 90:

y el resultado impreso

Conclusiones

Es fácil ver desde la comparación que con REPORTBEHAVIOR = 90, todas las etiquetas de texto exceden su longitudes esperada, no sólo en las fuentes no espaciadas. Sin embargo, el efecto es definitivamente más pronunciado en fuentes mono espaciadas.

¿Por qué ocurre esto para etiquetas y no para para campos/expresiones?

Con REPORTBEHAVIOR = 90, el nuevo motor de informe utiliza GDI+ para generar la salida, y la generación de las cadenas de textos necesitan más espacio que la forma plana del viejo GDI. Escribí sobre por qué GDI+ necesita espacio adicional antes de las cadenas de texto: http://www.spacefold.com/colin/posts/2005/08-18GDIplusinreports.html

El Diseñador de informe utiliza GDI - no GDI + para generar los componentes del diseño del informe, incluyendo todas cadenas de texto que ve. Entonces, si visualmente ha justificado a la derecha un elemento de informe, el diseñador de informe guarda la coordenada más izquierda del elemento (la posición inicial del texto) en el diseño. La longitud de la cadena generada por GDI+ será mucho más grande que lo que cree, basada en que es lo que ve en el Diseñador.

No hay dudas del hecho de que tiene que tener en cuenta este efecto al diseñar sus controles etiqueta en los informes.

Ahora, verá que este problema no ocurre con los controles campo/expresiones. Ellos están todos alineados correctamente, debido a que el Diseñador de Informe, no especifica una posición exacta para la cadena de texto, pero sí especifica la caja donde el texto va a ser generado. Entonces, el cálculo de la alineación tiene lugar en el motor de informe, mientras GDI+ tiene en cuenta el tamaño del texto.

Notas al pie:

[1] Candara y Consolas son fuentes nuevas de Microsoft, distribuidas con Windows Vista.

Agradecimientos:

Gracias a Alex Sosa por su pregunta tan interesante.

7 de julio de 2017

VFP9 - Mejoras realizadas al Diseñador de Informes

Tanto el Motor de Informes, como su Diseñador en VFP 9.0, son los aspectos sobre los que más cambios se han incorporado. Como respuesta a la retroalimentación hecha por los usuarios, Microsoft ha mejorado significativamente el Generador de informes en VFP 9.0, ha velado por proteger todo el trabajo invertido, por lo que no modificó la estructura actual del archivo FRX.

Nuevo comando SET REPORTBEHAVIOR

Es como un interruptor que enciende o apaga la salida asistida por objetos.

Admite como parámetros, los valores 80 ó 90

Dado que antes se empleaba GDI y ahora GDI+ hay diferencias en el interlineado, alineación y espaciado. Eso puede afectar a informes existentes. Por tanto el valor predeterminado es 80. La asignación desde Herramientas - Opciones - Informes es Global; pero aun así se puede cambiar para cada informe que haga falta de forma específica.

El nuevo generador de informes se llama ReportBuilder.APP y viene con VFP 9.0.

Algunos de los logros han sido:

1. Mejorar el interfaz de usuario:

La interfaz de usuario ha sido mejorada en varios aspectos, que al sumarlos representan un importante ahorro de tiempo, veamos en detalles las diferencias entre VFP 8.0 y VFP 9.0.

- Menú contextual mejorado

El Menú contextual del Generador de informes en VFP 9.0 agrega las opciones: Bandas opcionales, Variables y Propiedades.

- Nueva ventana propiedades de Informes

Por su parte la nueva ventana Propiedades de Informe utiliza un marco de página y páginas para todos los aspectos de propiedades de informe. Esto agiliza el trabajo, ya que no hay que estar abriendo y cerrando cuadros de diálogo. Muchas de estas páginas agrupan a ventanas que ya existían en versiones anteriores como ventanas independientes. Tal es el caso de Cálculos, Condición. Pero hay otras: Protección, Entorno de datos, y Otros que son nuevas en este generador.

- Rediseñadas las ventanas Propiedades de campo y banda

En VFP 8.0 la ventana propiedades de un campo se corresponde con la ventana expresión de informe mostrada más adelante en este mismo escrito. Por su parte, VFP 9.0 ofrece una nueva ventana de Propiedades de campo, cuyo formato es también un marco de páginas con páginas que determinan los valores para los diferentes aspectos relativos al campo. El diseño actual es muy práctico e intuitivo.

Las bandas en VFP 9.0 adquieren una nueva dimensión y en el Diseñador se ha incluido una nueva ventana Propiedades para cada banda. El nuevo diseño comprende no sólo las bandas de detalle, sino todas las bandas del informe. Veamos ambos casos.

- Cambios en el Cuadro de diálogo generador de expresiones.

El primer cambio que salta a la vista es la mayor amplitud para la expresión, tanto en la ficha General como en el generador de expresiones.

- Nuevo Cuadro de diálogo selección múltiple

En VFP 9.0 existe el cuadro de diálogo Selección múltiple que permite establecer las propiedades Protección e Imprimir cuando para más de un objeto de diseño a la vez. Permite además cambiar cualquier otra propiedad de Protección a un objeto individual. Para utilizar esta nueva característica, seleccione más de un objeto, y luego haga doble clic en cualquiera de ellos para llamar al cuadro de diálogo Selección múltiple. Resulta muy productivo sobre todo el haber incluido la posibilidad de dar valor a la condición de impresión en el cuadro de texto Imprimir cuando.

- Nueva opción en el Menú Archivo

Este menú contiene una nueva opción Guardar como clase. El objetivo es guardar el Entorno de datos como clase, lo que constituye, a su vez, una de las novedades aportadas al Motor de informes en VFP 9.0. Sobre el tratamiento del Entorno de datos, ver: Visual FoxPro 9.0 - Novedades - Manipulación de entorno de datos en el diseñador de Informes

- Nueva opción en el Menú Ver

En el menú Ver hay una nueva opción - Barra de Diseñador de informes

- Nuevos botones la barra de Herramientas del Diseñador de informes

Incluye dos opciones nuevas: Ajustar página y Propiedades del tipo de letra, las que vemos ahora en la barra de Herramientas.

- Mejoras en el Menú Informes, y el menú contextual del Generador de informes

En el menú Informes hay opciones nuevas: Vista Preliminar, Carga entorno de datos, Bandas opcionales y Propiedades. El resto de las opciones están mejor agrupadas.

- Cambios en la ficha Informes de Herramientas - Opciones.

Las nuevas opciones son:

  • Generador de Expresiones - regula si el nombre del alias va a preceder al nombre del campo: las posibilidades son: siempre, solo para alias no seleccionadas, nunca.
  • Comportamiento Motor de Informes - Determina el comportamiento en tiempo de ejecución: las posibilidades son 80 que mantiene el comportamiento anterior y 90 que es la generación de informes asistida por objetos (comando SET REPORTBEHAVIOR). La vamos a configurar para que trabaje sobre la 90, asistida por objetos.
  • Escala - Agrega nuevos valores: centímetros y pulgadas ()
  • Usar alfabeto para fuentes - indica el conjunto de caracteres de lenguaje que va a estar habilitado en el cuadro de diálogo Fuente. Si marcamos esta opción, en la Ventana Fuentes se activará el combobox Alfabeto. En caso contrario, permanece desactivado.
  • Se agregaron los elementos del contenedor Grid, Forzar al Grid y Mostrar líneas del Grid

Además, el cursor del ratón cambia de forma para dar una clave visual de los objetos que pueden ser redimensionables.

2. Proporcionar nuevas posibilidades:

- Tooltips

Se pueden agregar Tooltips a los controles del informe. Para ello vamos a la ficha Otros de la ventana propiedades. El comando Modificar Tooltip nos permite acceder a un editbox en el que podemos escribir el texto deseado y este se verá reflejado al pasar el ratón por el control. Solamente se aplica a controles.

- Comentarios

De igual forma, se pueden agregar Comentarios a los controles del informe. Desde la ficha Otros de la ventana propiedades y comando Modificar Comentarios nos permite acceder a un editbox en el que podemos escribir el texto deseado y este se verá reflejado al pasar el ratón por el control. Se aplica a controles, bandas y el Informe.

- Modo de recorte para expresiones de caracteres

Se puede definir desde la ficha Formato de la Ventana propiedades, los valores se definen desde el cuadro combinado Modo para truncar expresiones de caracteres.

Si se escoge el Recorte predeterminado lo que ocurre es que se agregan 3 puntos suspensivos indicando que no cabe la expresión en el espacio actual. El resto de las opciones para aplicar recorte de caracteres, se pueden intuir por la descripción, que aparece en idioma español, si tiene instalado el IDE VFP 9.0 en español.

- Protección

En VFP 9.0, puede crear protección para uno o más objetos al utilizar el Diseñador de Informes o Diseñador de etiquetas. Esto ofrece la posibilidad de que el usuario pueda modificar un informe, sin permitirle aún hacer determinados cambios. Para configurar las banderas de protección vemos los cuadros de diálogo correspondientes a Propiedades tanto para campos, como para bandas y también para informes. En el Diseñador de informes esto se ve reflejado en la ficha Protección en la Ventana Propiedades, tanto de controles, bandas, como del informe entero.

Sobre este tema, ver más elementos en: Visual FoxPro 9.0 - Novedades - Protección de Informes

- Posicionamiento absoluto

Desde la ventana propiedades - Ficha general se puede indicar el posicionamiento absoluto con propiedades tales como Top, Left, Height y Width. Es muy útil para controles que no dependen de una banda.

- Tratamiento de imágenes

Se han ampliado las posibilidades para definición de objetos tipo Imagen. Si tenemos definida una clase con valor en la propiedad PictureVal se puede emplear como origen de una imagen en un informe.

- Múltiples bandas de detalle

Contar con la posibilidad de crear múltiples bandas de detalle es una de las mejoras más importantes y más solicitadas. A partir de VFP 9.0 es posible procesar múltiples tablas hijas para cada registro de la tabla padre. Existen posibilidades ilimitadas de lo que se puede hacer con esta nueva característica. En el Diseñador de informes esto se ve reflejado en nuevas opciones de menú, la ficha Bandas Opcionales en la Ventana Propiedades.

Hemos visto algunos elementos, digamos, los más importantes. Seguramente quedan aspectos por explorar.

Espero que haya resultado de utilidad.

Saludos,

Ana María Bisbé York
www.amby.net