18 de diciembre de 2021

Guardar un informe de VFP a una resolución más alta con FoxyPreviewer

Articulo Original: Saving a VFP Report at a higher resolution with FoxyPreviewer
http://vfpimaging.blogspot.com/2021/03/saving-vfp-report-at-higher-resolution.html
Autor: Cesar Ch.
Traducido por: Luis María Guayán


Visual FoxPro 9 trajo la posibilidad de guardar nuestros informes como imágenes, utilizando la clase ReportListener y el método OutputPage:

loListener.OutputPage(lnPage, "\MyReportImage.PNG", 104) && PNG file type

Esto nos trae algunas imágenes útiles, pero pésimas en cuanto a calidad. Por ejemplo, la muestra "COLORS.FRX" me brinda una imagen de 816 x 1056 píxeles, una imagen de muy mala calidad, y mas aun si estamos pensando en imprimirla o manipularla.

Pero el método "OutputPage" también nos permite dibujar la página del informe en cualquier tamaño de imagen deseado, pasando un identificador GDI+ Graphics en lugar del nombre de archivo ampliamente utilizado.

Aquí está la muestra de trabajo: observe que el motor de informes funciona solo con 96 DPI, por lo que para tener una mejor calidad, debe gurdar en dimensiones más grandes.

Use la función GETREPORTPAGEEX para obtener sus informes con mayor resolución, aquí está la lista de parámetros

  • tcFile: el nombre del archivo de la imagen de destino
  • toListener: el ReportListener asociado con el informe actual
  • tnPage: el número de página del informe
  • tnEncoder: 100=EMF, 101=TIFF, 102=JPEG, 103=GIF, 104=PNG, 105=BMP
  • tnScale: el factor de escala que se aplicará a la imagen. 1=Predeterminado (baja calidad), 10=Super alta calidad
  • tnWidth: el ancho de la imagen de salida (opcional, si se usa "tnScale")
  • tnHeight: la altura de la imagen de salida (opcional, si se usa "tnScale")
DO FoxyPreviewer.App

LOCAL loListener AS REPORTLISTENER
LOCAL lcFile, lnPage, lnFileType
m.loListener			  = CREATEOBJECT("FoxyListener")
m.loListener.LISTENERTYPE = 3

REPORT FORM (ADDBS(_Samples) + "Solution\Reports\Colors.FRX") OBJECT m.loListener

m.lnFileType = 104 && PNG
	&& 100 - EMF
	&& 101 - TIFF
	&& 102 - JPEG
	&& 103 - GIF
	&& 104 - PNG
	&& 105 - BMP

FOR m.lnPage = 1 TO m.loListener.PAGETOTAL
	m.lcFile = "c:\temp\Test__" + SYS(2015) + "__" + ALLTRIM(STR(m.lnPage)) + ".png"
	GetReportPageEx(m.lcFile, m.loListener, m.lnPage, m.lnFileType, 5) && 5 times bigger image than default
	* For the default lower quality image, use:
	*   loListener.OutputPage(lnPage, "c:\Test" + ALLTRIM(STR(lnPage)) + ".png", lnFileType)
ENDFOR
m.loListener = NULL
RETURN


PROCEDURE GetReportPageEx(tcFile, toListener AS REPORTLISTENER, tnPage, tnEncoder, tnScale, tnWidth, tnHeight)
	LOCAL lhGfx
	*!*	100 - image type EMF
	*!*	101 - image type TIFF
	*!*	102 - image type JPEG
	*!*	103 - image type GIF
	*!*	104 - image type PNG
	*!*	105 - image type BMP
	m.tnEncoder	= EVL(m.tnEncoder, 104) && Default = 104-PNG
	m.tnScale	= EVL(m.tnScale, 1)
	IF EMPTY(m.tnWidth)
		m.tnWidth  = m.toListener.GETPAGEWIDTH()  / 10 * m.tnScale
		m.tnHeight = m.toListener.GETPAGEHEIGHT() / 10 * m.tnScale
	ENDIF

	#DEFINE Gdiplus_PixelFormat_32BppArgb		0x0026200a
	#DEFINE OUTPUTDEVICETYPE_GDIPLUS 			1

	LOCAL loBMP AS GpBitmap OF ADDBS(HOME()) + "/FFC/_GDIPLUS.VCX"
	m.loBMP = NEWOBJECT("GpBitmap", ADDBS(HOME()) + "/FFC/_GDIPLUS.VCX")
	m.loBMP.CREATE(m.tnWidth, m.tnHeight, Gdiplus_PixelFormat_32BppArgb)

	LOCAL loGfx AS GpGraphics OF ADDBS(HOME()) + "/FFC/_GDIPLUS.VCX"
	m.loGfx = NEWOBJECT('GpGraphics', ADDBS(HOME()) + "/FFC/_GDIPLUS.VCX")
	m.loGfx.CreateFromImage(m.loBMP)
	m.lhGfx = m.loGfx.GetHandle()

	m.toListener.OUTPUTPAGE(m.tnPage, m.lhGfx, OUTPUTDEVICETYPE_GDIPLUS, 0, 0, m.tnWidth, m.tnHeight, 0, 0, m.tnWidth, m.tnHeight)
	m.loBMP.SaveToFile(m.tcFile, "image/png")
ENDPROC

4 de diciembre de 2021

TRY ... CATCH ... FINNALY

A partir de Visual FoxPro 8 existe una nueva estructura de control TRY...CATCH...FINALLY para capturar errores o excepciones que ocurren en tiempo de ejecución.

La estructura TRY...CATCH...FINALLY comienza con una cláusula TRY que marca el inicio de un bloque TRY. En este bloque se puede especificar un grupo de cláusulas que pueden producir un error en tiempo de ejecucion. Si el programa completa el bloque TRY sin generar ninguna excepción, este salta el bloque CATCH y busca el bloque FINALLY y ejecuta las sentencias de ese bloque. Si el bloque FINALLY no existe, el programa ejecuta la primera sentencia despues de la clausula ENDTRY que marca el final de la estructura TRY...CATCH...FINALLY

Capturando el error

Cuándo el error ocurre, el código lanza (THROW) una excepción, el programa ejecuta la primera sentencia del bloque CATCH que maneja dicha excepción.

El programa examina las sentencias CATCH en la orden que estas aparecen para ver si una de ellas pueden manejar la excepción. Si el programa encuentra una sentencia CATCH que maneja la excepción, el programa ejecuta el código correspondiente.

La sentencia CATCH puede contener las clausuals opcionales TO y WHEN. Uno puede especificar una variable de memoria en la cláusula TO para almacenar una referencia a un objeto Exception (nuevo en Visual FoxPro 8), que se crea sólo cuando una excepción ocurre. Si se quiere establecer una condición para ejecutar un bloque CATCH, se puede especificar una expresión en la cláusula WHEN que se debe evaluar Verdadero (.T.) antes de que el bloque CATCH se ejecute.

Las sentencias CATCH trabajan similarmente como una sentencia DO CASE en el que la cláusula WHEN debe evaluar a una expresión lógica. Si las cláusulas TO y WHEN no existen, la sentencia CATCH se evalúa como CATCH WHEN .T. (Verdadero).

Después que el programa ejecuta las sentencias en un bloque CATCH, no vuelve a la sentencia TRY, y no busca otras declaraciones CATCH. El programa busca el bloque FINALLY, si este existe. Si no existe el programa ejecuta la sentencia inmediatemente despues de la clausula ENDTRY. El bloque FINNALY se ejecuta se haya o no generado una excepción.

Sintaxis y ejemplo

Esta es la sintaxis de la estructura de control TRY...CATCH...FINALLY

TRY
   [tryCommands] 
[CATCH [TO VarName] [WHEN lExpression] 
   [catchCommands]]
[THROW eUserExpression]
[EXIT]
[FINALLY 
   [finallyCommands]] 
ENDTRY

Un breve ejemplo del uso de TRY...CATCH...FINALLY

CLEAR
LOCAL ln AS Integer, lc AS Character
LOCAL lo AS Exception 
TRY
  ? "-- TRY --"
  SELECT 0
  USE "TablaNoExistente" ALIAS "MiTabla"
  GO BOTT
  ln = MiTabla.nCampo
  lc = MiTabla.cCampo
  ? ln
  ? lc
CATCH TO lo	&& objeto Exception
  ? "-- CATCH --"
  lo.UserValue = "Aquí hay un error"
  ? ' Comment: ', lo.COMMENT
  ? ' Details: ', lo.Details
  ? ' ErrorNo: ', lo.ErrorNo
  ? ' LineContents: ', lo.LineContents
  ? ' LineNo: ', lo.LINENO
  ? ' Message: ', lo.MESSAGE
  ? ' Procedure: ', lo.PROCEDURE
  ? ' UserValue: ', lo.UserValue
  ? ' StackLevel: ', lo.StackLevel
FINALLY
  ? "-- FINALLY --"
  IF USED("MiTabla")
    USED IN "MiTabla"
  ENDIF
ENDTRY
? "-- ENDTRY --"

Prioridad de los manejos de errores

Si un error ocurre en el método de un objeto que se llama en un bloque TRY, Visual FoxPro sigue el procedimiento del manejo del error para ese objeto particular. Este protocolo proporciona una manera para mantener una encapsulation y control de los componentes.

Por ejemplo, si la línea MiForm.Refresh() en un bloque TRY genera un error, si el método Error existe para manejar el error, entonces el método Error toma la precedencia. Si ningún método Error existe, entonces la sentencia CATCH procura manejar el error.

Veamos algunos ejemplos de estas prioridades:

Ejemplo 1: La clase MiClase posee un método Error, y este toma precedencia al generarse un error.

CLEAR
lo = CREATEOBJECT("MiClase")
lo.MiMetodo1()

DEFINE CLASS MiClase AS CUSTOM

  PROCEDURE MiMetodo1
    TRY
      THIS.MiMetodo2()
    CATCH TO loErr
      ? "-- CATCH --"
      ? "ErrorNo:", loErr.ErrorNo
      ? "LineNo:", loErr.LINENO
      ? "Procedure:", loErr.PROCEDURE
      ? "Message:", loErr.MESSAGE
    ENDTRY
  ENDPROC

  PROCEDURE MiMetodo2
    ? PROGRAM()
    *-- La variable luY no existe. El evento ERROR maneja este error.
    luX = luY
  ENDPROC

  PROCEDURE ERROR(nError, cProcedure, nLine)
    ? "-- ERROR --"
    ? "ErrorNo:", nError
    ? "LineNo:", nLine
    ? "Procedure:", cProcedure
    ? "Message:", MESSAGE()
  ENDPROC

ENDDEFINE

Ejemplo 2: La clase MiClase no posee un método Error, en esta caso el manejo de error lo maneja la claúsula CATCH.

CLEAR
lo = CREATEOBJECT("MiClase")
lo.MiMetodo1()

DEFINE CLASS MiClase AS CUSTOM

  PROCEDURE MiMetodo1
    TRY
      THIS.MiMetodo2()
    CATCH TO loErr
      ? "-- CATCH --"
      ? "ErrorNo:", loErr.ErrorNo
      ? "LineNo:", loErr.LINENO
      ? "Procedure:", loErr.PROCEDURE
      ? "Message:", loErr.MESSAGE
    ENDTRY
  ENDPROC

  PROCEDURE MiMetodo2
    ? PROGRAM()
    *-- La variable luY no existe y 
    *-- el método ERROR no existe. CATCH maneja este error.
    luX = luY
  ENDPROC

ENDDEFINE

Mas información

Pueden ver mas información de la estructura de control TRY...CATCH...FINNALY en:

Fox.Wikis: http://fox.wikis.com/wc.dll?Wiki~TryCatch


20 de noviembre de 2021

Controlar la configuración de un informe en tiempo de ejecución

Articulo original: Controlling report settings at run time
http://www.ml-consult.co.uk/foxst-12.htm
Autor: Mike Lewis
Traducido por: Luis María Guayán


Cómo permitir que los usuarios elijan opciones de impresora para informes VFP.

Este artículo se aplica a Visual Foxpro 8.0 y versiones anteriores. Si está utilizando una versión posterior, consulte la nota al final del artículo.

Probablemente sepa que, al diseñar un informe de Visual FoxPro, puede seleccionar el tamaño de página, la orientación y el origen del papel en el cuadro de diálogo "Configurar impresión". Este es el cuadro de diálogo al que llega cuando elige "Archivo" - "Configuración de página" y luego hace clic en el botón "Configurar impresión" dentro del diseñador de informes.

Pero hay un inconveniente. Si realiza algún cambio en la configuración de impresión de esta manera, sus usuarios no podrán anularlos en tiempo de ejecución.

Por ejemplo, si configura el origen del papel en "Bandeja superior", el informe siempre intentará seleccionar esa bandeja. No puede usar el comando REPORT FORM ... PROMPT para anularlo en tiempo de ejecución, porque el cuadro de diálogo PROMPT no incluye una configuración para el origen del papel. (Pero puede usar el cuadro de diálogo PROMPT para seleccionar una impresora diferente).

SYS(1037) tampoco ayudará. Normalmente, esa función muestra el cuadro de diálogo "Configurar página" y permite al usuario cambiar la configuración dentro de él. Los cambios afectarán a todos los resultados impresos de la sesión actual. Pero si cambió alguna de las configuraciones de página predeterminadas dentro del diseñador de informes, el cuadro de diálogo SYS(1037) no tendrá ningún efecto en ese informe. Ni siquiera puede usarlo para enviar el informe a una impresora diferente.

Hackear el FRX

Afortunadamente, existe una solución. Implica una pequeña triquiñuela tocando el archivo del informe.

Como ya se sabe, el formato interno de un informe de VFP, es decir, el archivo FRX, es el mismo que el de una DBF. De ello se deduce que se puede abrir el archivo como si fuera una tabla de FoxPro. También puede examinarlo y editarlo. Ahora, no es necesario que le digamos que editar un archivo de informe de esta manera es peligroso. Si cambia un campo incorrecto por un valor incorrecto, podría arruinar su diseño cuidadosamente planificado. Así que tenga cuidado con lo que sigue, y asegúrese de tener una copia de seguridad antes de comenzar.

El primer paso es deshacerse de la configuración de la impresora que se guardó en el diseñador de informes. Para hacerlo, abra y explore el informe desde la Ventana de Comandos. Por ejemplo, si el informe se llama Cliente, escriba lo siguiente:

USE Customer.frx
BROWSE

En la Ventana Examinar, busque un registro donde el campo Objtype sea igual a 1 y el campo Objcode igual a 53 (generalmente es el primer registro). En este registro, busque los campos Expr, Tag y Tag2. Estos son campos Memos que contienen la configuración que realizó en el cuadro de diálogo "Configuración de impresión" del diseñador de informes. Tag y Tag2 contienen valores binarios. Expr contiene texto sin formato, que se verá así:

DRIVER=WINSPOOL
DEVICE=HP LaserJet 6P/6MP - Enhanced
OUTPUT=LPT1:
ORIENTATION=0
PAPERSIZE=9
PAPERLENGTH=2794
PAPERWIDTH=2159
COPIES=1
DEFAULTSOURCE=4
PRINTQUALITY=-4
COLOR=2

Ahora siga adelante y elimine el contenido de estos tres campos Memo. Esto devolverá todas las configuraciones guardadas a sus valores predeterminados. Si desea permitir que el usuario elija el tamaño de la página, el origen del papel o la orientación en tiempo de ejecución, ahora puede llamar a SYS(1037) para hacer el trabajo.

Todo o nada

Pero, ¿qué sucede si desea permitir que el usuario cambie algunas de las configuraciones pero no otras? ¿O desea almacenar configuraciones no predeterminadas en el informe, pero desea permitir que el usuario las anule en determinadas circunstancias? Llamar a SYS(1037) no ayudará, porque es todo o nada. No puede usarlo para permitir que el usuario cambie algunas configuraciones, pero evitar que cambie otras. En cualquier caso, dicha función no funcionará si ha realizado algún cambio en la configuración desde el diseñador de informes, incluso si son diferentes de los que desea que el usuario configure.

Esto es lo que se haría. Supongamos que siempre desea que el informe se imprima en orientación horizontal en papel A5, pero desea permitir que el usuario cambie el origen del papel entre "Alimentación manual" y "Bandeja inferior".

Comience seleccionando la orientación y el tamaño de la página en el cuadro de diálogo "Configurar impresión" desde el diseñador de informes. Mientras esté allí, configure el origen del papel en el valor predeterminado que desee. Guarde el informe como de costumbre.

En su aplicación, proporcione al usuario un mecanismo para alternar el origen del papel. Puede ser un botón de comando, una casilla de verificación, un comando del menú o lo que sea. Cuando el usuario elija, ejecute un código similar al siguiente:

USE Customer.frx
LOCATE FOR Objtype = 1 AND Objcode = 53
REPLACE Tag WITH ""
REPLACE Tag2 WITH ""
IF "DEFAULTSOURCE=2" $ Expr
  lcNew = "DEFAULTSOURCE=4"
  lcOld = "DEFAULTSOURCE=2"
ELSE
  lcNew = "DEFAULTSOURCE=2"
  lcOld = "DEFAULTSOURCE=4"
ENDIF
REPLACE expr WITH STRTRAN(Expr,lcOld,lcNew)
USE

La próxima vez que se imprima el informe, seleccionará el origen de papel que elija el usuario.

Esto es lo que hace el código. Primero, abre el archivo del informe como una tabla y localiza el registro que contiene la configuración. Luego borra los valores binarios de la configuración. Eso no es un problema, el informe funcionará bien sin ellos.

A continuación, comprueba la configuración existente del origen de papel. Si es 2, lo cambia a 4 y viceversa. Como puede imaginar, esta configuración se especifica mediante el valor DEFAULTSOURCE: 4 significa "Alimentación manual", 2 es "Bandeja inferior". Finalmente, el campo Expr se actualiza con el valor modificado y se cierra el archivo.

¿Cómo supimos qué valores usar para DEFAULTSOURCE? Desde la pantalla de ayuda de la función PrtInfo(). La función PrtInfo(), devuelve la configuración de la impresora actual, utiliza los mismos valores que el campo Expr. Entonces, si desea comprender el contenido del campo, ahí es donde debe buscar.

Una última palabra: cuando distribuya su aplicación, asegúrese de excluir el archivo FRX y su archivo FRT asociado de la compilación. En otras palabras, no vincule estos dos archivos al archivo EXE. Si lo hiciera, el código anterior no podría actualizar los archivos y su usuario vería un error en tiempo de ejecución. En su lugar, déle al usuario una copia independiente de los dos archivos.

Nota para los usuarios de VFP 9.0:

En VFP 9.0, toda la cuestión de la configuración de la impresora en los archivos de informe se ha vuelto mucho más fácil. De hecho, nunca necesitará manipular el archivo FRX de la forma descrita en este artículo. De forma predeterminada, la configuración de la impresora ya no se guarda en el FRX. Independientemente de las configuraciones que estuvieran vigentes en el momento del diseño del informe, puede usar SET PRINTER TO NAME o SYS(1037) para establecer las configuraciones de tiempo de ejecución.

Si desea anular el comportamiento por defecto, es decir, si no desea guardar la configuración del informe en el archivo FRX, abra el menú Informe en el diseñador de informes, y seleccione la opción entorno de la impresora. Puede hacer esto si desea forzar la impresión de un informe en una impresora en particular, por ejemplo. Si desea que la configuración de la impresora se guarde en todos los informes de forma predeterminada, vaya a Herramientas - Opciones - Informes y habilite la opción "Guardar entorno de impresora".


Mike Lewis Consultants Ltd.

10 de noviembre de 2021

Separar párrafos en líneas de "n" caracteres

La función recursiva CortarParrafo() prepara una cadena para luego separarla con la función ALINES() en varias lineas de "n" o menos caracteres

Ejemplo:

lcCadena = "SON PESOS: TRES MILLONES NOVECIENTOS CINCUENTA Y CUATRO MIL " + ;
  "TRESCIENTOS OCHENTA Y NUEVE CON SETENTA Y CINCO CENTAVOS."

FOR ln = 1 TO ALINES(la,CortarParrafo(lcCadena,40))
  ? la(ln)
ENDFOR

FUNCTION CortarParrafo(tc,tn)
  LOCAL lc, ln
  tc = ALLTRIM(tc) + " "
  lc = SUBSTR(tc,1,tn)
  ln = RAT(" ",lc)
  lc = SUBSTR(lc,1,ln-1)
  RETURN IIF(EMPTY(lc),lc, lc + CHR(13) + CortarParrafo(SUBSTR(tc,ln+1),tn))
ENDFUNC

23 de octubre de 2021

Expresiones regulares en Visual FoxPro - Parte 3

Artículo original: Regular Expressions for Visual FoxPro Part 3
http://www.sweetpotatosoftware.com/SPSBlog/PermaLink,guid,9a28ad22-b41b-434a-a540-40e6197a099e.aspx
Autor: Craig Boyd
Traducido por: Ana María Bisbé York


FLL actualizada con más funcionalidad

No tengo tiempo (es tarde) para comentar mucho sobre los cambios que he hecho en regexp.fll. He mejorado significativamente las funcionalidades de la función regexp() cuando corta la cadena. Ahora se pueden guardar los pedazos cortados en una matriz o en un cursor. He mejorado además un par de errores en el código que tenían que ver con la fragmentación de la cadena. La documentación de mi entrada de blog anterior es válida para cada evento, vea (https://www.sweetpotatosoftware.com/blog/index.php/2006/01/11/regular-expressions-in-visual-foxpro-part-2/). (Nota del Editor: Traducido en este blog en Expresiones regulares en Visual FoxPro - Parte 2). Ahora se puede asignar 4 al parámetro nFunctionType y se obtendrá un cursor. Además, si está utilizando los valores 3 ó 4 para nFunctionType, puede especificar un comando de Visual FoxPro al motor de expresiones regulares para que lo ejecute cada vez que encuentre una coincidencia (pensado como una especie de función de rellamada -callback function )

Un ejemplo de análisis XML

Esta biblioteca ha tomado forma; pero pienso que existen muchas otras posibilidades que no se han explorado aun (Coméntenme en el blog o envíenme cualquier idea de funcionalidad que pueda tener -me encanta recibirlas). Algo nuevo que he pensado para la biblioteca puede ser análisis de XML. Utilicé alguna expresión regular que encontré disponible libremente en internet, creé un código de ejemplo (vea debajo) para mostrar las maravillosas habilidades de las expresiones regulares así como la nueva funcionalidad en la FLL.

Más por venir

Aun no he hecho justicia a las expresiones regulares ni a esta FLL. Cuando tenga más tiempo, regresaré a actualizar la documentación y mostrar cómo esta FLL ofrece posibilidades en Visual FoxPro que aun no hemos visto. He aquí un archivo de descarga y algunos ejemplos de código (la función ParseXML es lo fundamental que necesita la regexp.fll más reciente para poderla ejecutar). ¡¡ A disfrutar !!

Descarga de regexp.fll (63 KB aprox) haciendo clic aquí

*!* Ejemplo de empleo de la función ParseXML
#DEFINE CREATEANARRAY 2
#DEFINE CREATEACURSOR 3
LOCAL lcArrayToCreate, lcCursorToCreate, lnTotal, lnCounter
*!* He aquí un ejemplo de XML
*!* sólo como demostración
TEXT TO lcSampleXML NOSHOW PRETEXT 7
<?xml version="1.0"?>
<samples>
<sample>Visual FoxPro Rocks!</sample>
<sample>Hace mucho más antes de desayunar</sample>
<sample>que otros lenguajes hacen durante todo el día</sample>
</samples>
ENDTEXT

*!* O puede intentarlo utilizando un archivo XML
*!* Puede obtener algún ejemplo de XML desde
*!* ftp://sunsite.unc.edu/pub/sun-info/standards/xml/eg/shakespeare.1.01.xml.zip
*!* Una vez extraído comente del código encima TEXT/ENDTEXT 
*!* finalmente puede hacer algo como lo siguiente
*!* para cargar el ejemplo de archivos XML
*!* lcSampleXML = FILETOSTR(GETFILE())

*!* Crea una matriz
DIMENSION aryXMLDoc(1)
lcArrayToCreate = "aryXMLDoc"
lnTotal = ParseXML(lcSampleXML, lcArrayToCreate, CREATEANARRAY)
CLEAR
FOR lnCounter = 1 TO lnTotal
 ? aryXMLDoc(lnCounter)
ENDFOR
MESSAGEBOX("El XML analizado se mostrará en pantalla desde la matriz." ;
  + CHR(13) + "Oprima OK para continuar con el siguiente ejemplo.", ;
  64, "Análisis del XML terminado")

*!* Crea un cursor
lcCursorToCreate = "crsXMLDoc"
lnTotal = ParseXML(lcSampleXML, lcCursorToCreate, CREATEACURSOR)
IF lnTotal > 0
  GO TOP IN (lcCursorToCreate)
  BROWSE
ENDIF
MESSAGEBOX("Oprima OK para ejecutar el ejemplo final.", ;
  64, "Inicio del ejemplo final de Análisis del XML")

*!* Crea un cursor; pero además ejecuta código
*!* VFP  que ejecuta el  analizador C++.
*!* Puede ser utilizado para manipular el dato  
*!* como es recuperado, o lo que sea.
*!* El analizador C++ en la FLL
*!* ejecutará cualquier comando que se le indique
lcCursorToCreate = "crsXMLDoc"
lcVFPCommand = "DO AppendVFPRocks"
lnTotal = ParseXML(lcSampleXML, lcCursorToCreate, CREATEACURSOR, lcVFPCommand)
IF lnTotal > 0
  CLEAR
  GO TOP IN (lcCursorToCreate)
  SCAN ALL
    ? Splits
  ENDSCAN
ENDIF

**************************
PROCEDURE AppendVFPRocks
**************************
  Replace splits WITH "VISUAL FOXPRO ROCKS!" + splits
ENDPROC
*******************************
FUNCTION ParseXML (tcXML, tcName, tnType, tcCommand)
*******************************
*!* Esta función existe gracias 
*!* al trabajo de Robert Cameron...
*******************************
*!* REX/Perl 1.0 
*!* Robert D. Cameron "REX: XML Shallow Parsing with Regular Expressions",
*!* Technical Report TR 1998-17, School of Computing Science, Simon Fraser 
*!* University, November, 1998.
*!* Copyright (c) 1998, Robert D. Cameron. 
*!* El código siguiente puede ser utilizado libremente y distribuido indicando este
*!* copyright y citar en una nota que se mantiene intacta y si tiene modificaciones
*!* o agregados han de ser debidamente identificados.
*!* http://www.cs.sfu.ca/~cameron/REX.html
*******************************
*!* 01-14-2006: Traducidas y modificadas sus expresiones
*!* para uso en Visual FoxPro con regexp.fll
*!* por Craig Boyd http://www.sweetpotatosoftware.com/spsblog
*******************************
  LOCAL lcTextSE, lcUntilHyphen, ;
    lcUntil2Hyphens, lcCommentCE, lcUntilRSBs, ;
    lcCDATA_CE, lcS, lcNameStrt, lcNameChar, ;
    lcName, lcQuoteSE, lcDT_IdentSE, ;
    lcMarkupDeclCE, lcS1, lcUntilQMs, ;
    lcPI_Tail, lcDT_ItemSE, lcDocTypeCE, ;
    lcDeclCE, lcPI_CE, lcEndTagCE, lcAttValSE, ;
    lcElemTagCE, lcMarkupSPE, lcXML_SPE, ;
    lcExpression, lvReturn
  IF !("\REGEXP.FLL" $ SET("Library"))
    SET LIBRARY TO LOCFILE("regexp.fll", "FLL")
  ENDIF
  lcTextSE = "([^<]+"
  lcUntilHyphen = "[^-]*-"
  lcUntil2Hyphens = lcUntilHyphen + "(?:[^-]" + lcUntilHyphen + ")*-"
  lcCommentCE = lcUntil2Hyphens + ">?"
  lcUntilRSBs = "[^\]]*](?:[^\]]+])*]+"
  lcCDATA_CE = lcUntilRSBs + "(?:[^\]>]" + lcUntilRSBs + ")*>"
  lcS = "[ \n\t\r]+"
  lcNameStrt = "[A-Za-z_:]|[^\x00-\x7F]"
  lcNameChar = "[A-Za-z0-9_:.-]|[^\x00-\x7F]"
  lcName = "(?:" + lcNameStrt + ")(?:" + lcNameChar + ")*"
  lcQuoteSE = '"[^"]*"|' + "'[^']*'"
  lcDT_IdentSE = lcS + lcName + "(?:" + lcS + "(?:" + lcName + "|" + lcQuoteSE + "))*" 
  lcMarkupDeclCE = '(?:[^\]"' + "'><]+|" + lcQuoteSE + ")*>"
  lcS1 = "[\n\r\t ]"
  lcUntilQMs = "[^?]*\?+"
  lcPI_Tail = "\?>|" + lcS1 + lcUntilQMs + "(?:[^>?]" + lcUntilQMs + ")*>"
  lcDT_ItemSE = "<(?:!(?:--" + lcUntil2Hyphens + ">|[^-]" + lcMarkupDeclCE + ")|\?" ;
    + lcName + "(?:" + lcPI_Tail + "))|%" + lcName + ";|" + lcS
  lcDocTypeCE = lcDT_IdentSE + ;
    "(?:" + lcS + ")?(?:\[(?:" + lcDT_ItemSE + ")*](?:" + lcS + ")?)?>?"
  lcDeclCE = "--(?:" + lcCommentCE + ;
    ")?|\[CDATA\[(?:" + lcCDATA_CE + ")?|DOCTYPE(?:" + lcDocTypeCE + ")?"
  lcPI_CE = lcName + "(?:" + lcPI_Tail + ")?"
  lcEndTagCE = lcName + "(?:" + lcS + ")?>?"
  lcAttValSE = '"[^<"]*"|' + "'[^<']*'"
  lcElemTagCE = lcName + "(?:" + lcS + lcName + ;
    "(?:" + lcS + ")?=(?:" + lcS + ")?(?:" + lcAttValSE + "))*(?:" + lcS + ")?/?>?"
  lcMarkupSPE = "<(?:!(?:" + lcDeclCE + ")?|\?(?:" + lcPI_CE + ;
    ")?|/(?:" + lcEndTagCE + ")?|(?:" + lcElemTagCE + ")?))"
  lcXML_SPE = lcTextSE + "|" + lcMarkupSPE
  lcExpression = lcXML_SPE
  IF VARTYPE(tcCommand) = "C"
    lvReturn = RegExp(tcXML, lcExpression, tnType, tcName, tcCommand)
  ELSE
    lvReturn = RegExp(tcXML, lcExpression, tnType, tcName)
  ENDIF
  RETURN (lvReturn)
ENDFUNC

2 de octubre de 2021

Mejoras en el control Grid de Visual FoxPro

Artículo original: Visual FoxPro Grid Enhancements
https://www.sweetpotatosoftware.com/blog/index.php/2008/11/25/visual-foxpro-grid-enhancements
Autor: Craig Boyd
Traductor: Luis María Guayán

El control grid de Visual FoxPro

A menudo me han escuchado decir que el Grid de Visual FoxPro es uno de los mejores controles jamás ideados. Sigo sintiéndome así, pero ¿no sería bueno si algunas de las funciones que nuestros clientes quieren implementar en el control Grid ya estuvieran disponibles? Ya sabes, características como: ordenado, filtrado, búsqueda incremental, guardar las preferencias del usuario y exportar a Excel. Sería aún mejor si este tipo de funcionalidades pudiera implementarse en cualquier control Grid de Visual FoxPro (independientemente del origen de los registros) simplemente colocando una clase en un formulario, estableciendo una sola propiedad y escribiendo una sola línea de código. Bueno, eso es lo que me he propuesto crear con la clase que presento en esta publicación.

Pueden ver la funcionalidad básica proporcionada por GridExtras en las imágenes que aparecen al final de la publicación.

Cómo usar la clase

Les proporciono la aplicación Sample.exe en la descarga para que puedan probarla y ver cómo se implementa. Sin embargo, los pasos básicos son:

  • Coloque una instancia de GridExtras en su formulario o contenedor (un GridExtras para cada control Grid que desee mejorar).
  • Establezca la propiedad GridExpression de GridExtras en una cadena que se evaluará en tiempo de ejecución al control Grid que está mejorando: "Thisform.Grid1" es el valor predeterminado para esta propiedad.
  • Llame al método Setup() de GridExtras cuando su control Grid esté listo para funcionar. No tengo forma de saber si está configurando el origen de registros en tiempo de ejecución, o si está agregando columnas en el código, por lo que este método se proporciona como una forma de controlar cuándo GridExtras comenzará a interactuar con el control Grid
  • .

Eso es todo lo que hay que hacer para poner GridExtras en funcionamiento para un control Grid en su aplicación. Como digo, he incluido un ejemplo en la descarga, así que si tiene alguna pregunta sobre cómo se hace esto, simplemente revise el ejemplo.

Otras propiedades de la clase

Hay algunas otras propiedades de GridExtras de las que es posible que desee tomar nota y utilizar, como:

  • CompanyName y ProductName: estas propiedades se utilizan para determinar dónde guardar el archivo de preferencias del control Grid del usuario que está separado por perfil (Ej: "C:\Users\Craig\AppData\Roaming\MyCompany\MyProduct\gridprefs.tmp").
  • AllowGridExport, AllowGridFilter, AllowGridPreferences, AllowGridSort: estas propiedades le permiten activar o desactivar ciertas características de la clase según sus necesidades.
  • TemplateTable: esta propiedad determina dónde GridExtras busca gridextras.dbf que se usa para guardar las plantillas de Grid que crea el usuario (el usuario puede guardar sus filtros y ordenaciones para poder recrearlos fácilmente en un momento posterior). Es posible que deba establecer esta propiedad si planea mantener la tabla gridextras en una ruta de red, como con la carpeta de base de datos compartida para su aplicación.

Que sigue

Simplemente juegue con GridExtras y vea si es útil para usted y sus aplicaciones. En un mundo perfecto, encontraría alguna forma de mejorarlo (agregar formatos de exportación adicionales, proporcionar una función de bloqueo de columna, etc.). Si mejora GridExtras, le agradecería que se ponga en contacto conmigo y comparta las mejoras que ha implementado. Gracias de antemano a aquellos de ustedes que decidan hacerlo.

Hasta la próxima!

Descargar GridExtras y ejemplos (aproximadamente 223 KB)


Figura 1: GridExtras proporciona capacidades de ordenamiento, búsqueda incremental y filtrado a cualquier control Grid de Visual FoxPro.


Figura 2: GridExtras tiene características adicionales como la capacidad de volverse semitransparente y la capacidad de guardar las preferencias del usuario (orden de columna y ancho).


Figura 3: Además de las funciones proporcionadas por GridExtras a través de los encabezados de columna de un coltrol Grid, también hay un icono agregado en la parte inferior derecha de la clase que permite al usuario acceder a la pantalla "Plantillas de cuadrícula y exportación" que se ve en la Figura 4.


Figura 4: Las plantillas de Grids ayudan al usuario a guardar las vistas del Grid para poder recrearlas rápidamente en el futuro. La función de exportación de GridExtras puede crear formatos de Excel XLS, XLSX, XLB y XLM. Los títulos de encabezado del control Grid se utilizan para nombrar las columnas de Excel cuando se exportan los datos.

19 de septiembre de 2021

Regenerar todos los índices compuestos de una base de datos

Cuando se dañan los archivos índices de una tabla, ejecutar el comando REINDEX a veces no es suficiente. Hay casos en que hay que generar nuevamente cada uno de los índices con el comando INDEX ON y/o ALTER TABLE.

El siguiente código lo utilizo como una herramienta para regenerar rápidamente todos los índices de todas las tablas de una base de datos, y aparte me genera un archivo PRG con nombre "REG_CDX_????????.PRG" (donde "????????" es el nombre de la base de datos) que lo puedo ejecutar posteriormente

Si la base de datos contiene relaciones persistentes e integridad referencial NO ejecuten el código publicado, ni el archivo .PRG generado ya que éstos eliminan todas las etiquetas de índices de la tabla (DELETE TAG ALL) y esta acción también elimina el archivo .CDX y quita las relaciones persistentes entre las tablas y la integridad referencial existentes en la base de datos. Si éste es su caso, puede utilizar la herramienta GenDBC.PRG que está en la carpeta \Tools\Gendbc\ en la carpeta raíz de instalación de Visual FoxPro, que si respalda y restaura las relaciones y la IR.

Usen este código bajo sus propios riesgos. Hagan una copia de seguridad de la base de datos antes de probarlo.

* -----
* Configurando la variable llRegenera en:
*   .T. = si desea que se regeneren todos los índices al momento de ejecutar el código
*   .F. = solo genera un archivo PRG con el código para generarlos posteriormente 
*-----
LOCAL laDBF[1], laTag[1], llRegenera,  lnI, lnJ, lnTAG
LOCAL lcCmd, lcDBC, lcPRG, lcTabla, lnDBF, loExc

CLOSE TABLES ALL
CLOSE DATABASES ALL
CLEAR ALL
SET MEMOWIDTH TO 128
SET SAFETY OFF

#DEFINE CR_LF CHR(13)+CHR(10)

*-- Selecciono DBC
m.lcDBC = GETFILE([DBC])
*-- Solo genera PRG o genera PRG y regenera índices
m.llRegenera = .F.
*-- Nombre del PRG generado
m.lcPRG = [REG_CDX_] + FORCEEXT(JUSTFNAME(m.lcDBC), [PRG])

IF EMPTY(m.lcDBC) OR NOT FILE(m.lcDBC)
  MESSAGEBOX([Debe seleccionar un archivo DBC], 16)
  RETURN
ENDIF

CLEAR
STRTOFILE([*--- Regenera los índices compuestos de las tablas de la base de datos ] + ;
    JUSTFNAME(m.lcDBC) + CR_LF, m.lcPRG, 0)
STRTOFILE([*--- ] + CHRTRAN(TTOC(DATETIME(), 3), [T], [ ]) + CR_LF + CR_LF, m.lcPRG, 1)

OPEN DATABASE (m.lcDBC) && EXCLUSIVE VALIDATE
SET DATABASE TO (JUSTSTEM(m.lcDBC))

STRTOFILE([OPEN DATABASE ("] + m.lcDBC + [") EXCLUSIVE VALIDATE] + CR_LF, m.lcPRG, 1)
STRTOFILE([SET DATABASE TO ] + JUSTSTEM(m.lcDBC) + CR_LF + CR_LF, m.lcPRG, 1)

m.lnDBF = ADBOBJECTS(laDBF, "TABLE")
ASORT(m.laDBF)

FOR m.lnI = 1 TO m.lnDBF
  *-- Recorro todas las tablas de la DBC
  m.lcTabla = ADDBS(JUSTPATH(DBC())) + m.laDBF(m.lnI)

  TRY
    IF m.llRegenera && Necesito abrir en modo EXCLUSIVE
      USE (m.lcTabla) EXCLUSIVE IN SELECT(m.laDBF(m.lnI))
    ELSE
      USE (m.lcTabla) SHARED IN SELECT(m.laDBF(m.lnI))
    ENDIF

    STRTOFILE([USE ("] + m.lcTabla + [") EXCLUSIVE ] + CR_LF, m.lcPRG, 1)

    m.lnTAG = ATAGINFO(laTag)
    m.lcCmd = ""
    FOR m.lnJ = 1 TO m.lnTAG
      *-- Recorro todas las etiquetas de índices
      IF m.laTag(m.lnJ, 2) = [PRIMARY]
        m.lcCmd = m.lcCmd + ;
          [ALTER TABLE ] + m.laDBF(m.lnI) + [ ADD PRIMARY KEY ] + m.laTag(m.lnJ, 3) + ;
          [ TAG ] + m.laTag(m.lnJ, 1) + ;
          [ COLLATE "] + m.laTag(m.lnJ, 6) + ["]  + CR_LF
      ELSE
        m.lcCmd = m.lcCmd + ;
          [INDEX ON ] + m.laTag(m.lnJ, 3) + [ ] + ;
          [TAG ] + m.laTag(m.lnJ, 1) + [ ] + ;
          IIF(m.laTag(m.lnJ, 2) = "BINARY", m.laTag(m.lnJ, 2) + [ ], m.laTag(m.lnJ, 5) + [ ]) + ;
          IIF(EMPTY(m.laTag(m.lnJ, 4)), [], [FOR ] + m.laTag(m.lnJ, 4) + [ ]) + ;
          IIF(m.laTag(m.lnJ, 2) = "CANDIDATE", m.laTag(m.lnJ, 2) + [ ], []) + ;
          [COLLATE "] + m.laTag(m.lnJ, 6) + ["] + CR_LF
      ENDIF
    ENDFOR

    IF m.llRegenera
      DELETE TAG ALL
      PACK
      EXECSCRIPT(m.lcCmd)
    ENDIF

    STRTOFILE([DELETE TAG ALL] + CR_LF, m.lcPRG, 1)
    STRTOFILE([PACK] + CR_LF + CR_LF, m.lcPRG, 1)
    STRTOFILE(m.lcCmd + CR_LF, m.lcPRG, 1)

  CATCH TO m.loExc
    STRTOFILE([* ERROR:] + CR_LF, m.lcPRG, 1)
    STRTOFILE([* ] + m.loExc.MESSAGE + CR_LF, m.lcPRG, 1)

  FINALLY
    USE IN SELECT(m.laDBF(m.lnI))
    STRTOFILE([USE IN SELECT("] + m.laDBF(m.lnI) + [")] + CR_LF + CR_LF, m.lcPRG, 1)
  ENDTRY

ENDFOR

MODIFY FILE (m.lcPRG)

4 de septiembre de 2021

Configurando una aplicación usando JSON

Título original: Application Configuration using JSON
https://doughennig.blogspot.com/2020/10/application-configuration-using-json.html
Autor: Doug Hennig
Traducido por Luis María Guayán


Después de ver una la presentación de Andrew MacNeill sobre JSON, me inspiré para ver nfJSON, un proyecto VFPx de Marco Plaza. Este gran proyecto agrega soporte JSON a las aplicaciones VFP. Lo que modificó mi interés fue la capacidad de convertir una cadena JSON en un objeto VFP y viceversa con una sola línea de código.

Mi primer pensamiento fue usar esto para los parámetros de configuración. Casi todas las aplicaciones necesitan parámetros de configuración: es mejor leer los parámetros como la información de conexión de la base de datos, ubicaciones de archivos, configuración de correo electrónico, etc. desde una fuente de configuración en lugar de "hardcodearlos" en la aplicación. He usado el Registro de Windows, archivos DBF, INI y XML en varias ocasiones, pero todos requieren codificar manualmente la lectura y escritura entre la fuente y los objetos VFP que contienen la configuración. Con nfJSON, es solo una línea de código.

He creado una clase contenedora llamada SFConfiguration. Solo tiene tres métodos:

  • Load devuelve un objeto con propiedades que coinciden con los pares de nombre/valor en el JSON contenido en el archivo de configuración especificado. Si el archivo no existe o está vacío (como la primera vez que se ejecuta la aplicación), llama a GetDefaultSettings (que se describe a continuación) para obtener la configuración predeterminada.
  • Save guarda las propiedades del objeto de configuración especificado en el archivo especificado en el nombre de archivo pasado o en la propiedad cSettingsFile si no se pasa un nombre de archivo.
  • GetDefaultSettings devuelve JSON para la configuración predeterminada. Puede usar esto de dos maneras: subclase SFConfiguration y anular GetDefaultSettings para devolver el JSON deseado, o establecer la propiedad oSettings en un objeto de configuración que contenga la configuración predeterminada.

A continuación, se muestra un ejemplo del uso de esta clase para obtener la configuración del correo electrónico:

loConfig = createobject('SFConfiguration')
loConfig.cSettingsFile = 'email.json'
loConfig.oSettings     = createobject('EmailSettings')
loSettings = loConfig.Load()
* loSettings contiene la configuración de correo electrónico del usuario;
* si email.json no existe, la configuración de la clase 
* EmailSettings se utiliza como predeterminada.
* Después de que el usuario ingrese la configuración deseada en algún 
* cuadro de diálogo, guárdelos usando:
loConfig.Save(loSettings)

define class EmailSettings as Custom
    Email      = 'dhennig@stonefield.com'
    MailServer = 'mail.stonefield.com'
    Port       = 25
    UseSSL     = .F.
    UserName   = 'dhennig'
    Password   = 'mypw'
enddefine

Así es como se ve el objeto de configuración:

Así es como se ve el JSON guardado:

Aquí hay otro ejemplo, esta vez usando una subclase de SFConfiguration para lo mismo:

loConfig = createobject('SFEmailConfiguration')
loConfig.cSettingsFile = 'email.json'
loSettings = loConfig.Load()
* loSettings contiene la configuración de correo electrónico del usuario; 
* si email.json no existe, la configuración de la clase 
* SFEmailConfiguration a continuación se usa como predeterminada.

define class SFEmailConfiguration as SFConfiguration
    function GetDefaultSettings
        text to lcSettings noshow
            {
                "email":"dhennig@stonefield.com",
                "mailserver":"mailserver.stonefield.com",
                "password":"mypw",
                "port":25,
                "username":"dhennig",
                "usessl":false
            }
            endtext
            return lcSettings
    endfunc
enddefine

Aquí está el código para SFConfiguration. Requiere nfJSONRead.prg y nfJSONCreate.prg, que puede obtener del repositorio nfJSON de GitHub:

define class SFConfiguration as Custom
    cSettingsFile = ''
        && the name and path for the settings file
    cErrorMessage = ''
        && the text of any error that occurs
    oSettings     = ''
        && a settings object

* Cargue la configuración del archivo especificado en el parámetro 
* o en This.cSettingsFile y devuelva un objeto de configuración. 
* Si el archivo no existe (como la primera vez que nos llaman), 
* se retorna un objeto de configuración que contiene 
* la configuración predeterminada.

    function Load(tcSettingsFile)
        local lcSettingsFile, ;
            lcSettings, ;
            loSettings, ;
            loException as Exception
        try
            lcSettingsFile = evl(tcSettingsFile, This.cSettingsFile)
            if not empty(lcSettingsFile) and file(lcSettingsFile)
                lcSettings = filetostr(lcSettingsFile)
            endif not empty(lcSettingsFile) ...
            if empty(lcSettings)
                lcSettings = This.GetDefaultSettings()
            endif empty(lcSettings)
            loSettings = nfJSONRead(lcSettings)
            This.cErrorMessage = ''
        catch to loException
            This.cErrorMessage = loException.Message
            loSettings = NULL
        endtry
        This.oSettings = loSettings
        return loSettings
    endfunc

* Guarde la configuración en el objeto especificado en el 
* archivo especificado en el parámetro o This.cSettingsFile.

    function Save(toSettings, tcSettingsFile)
        local lcSettingsFile, ;
            lcSettings, ;
            loException as Exception
        lcSettingsFile = evl(tcSettingsFile, This.cSettingsFile)
        if not empty(lcSettingsFile)
            try
                lcSettings = nfJSONCreate(toSettings, .T.)
                strtofile(lcSettings, lcSettingsFile)
                This.cErrorMessage = ''
            catch to loException
                This.cErrorMessage = loException.Message
            endtry
        else
            This.cErrorMessage = 'Settings file not specified.'
        endif not empty(lcSettingsFile)
        return empty(This.cErrorMessage)
    endfunc

* Obtiene el conjunto de configuraciones predeterminado como una 
* cadena JSON; anule esto en una subclase si es necesario.

    function GetDefaultSettings
        local lcSettings
        if vartype(This.oSettings) = 'O'
            lcSettings = nfJSONCreate(This.oSettings, .T.)
        else
            lcSettings = '{"text":"some text"}'
        endif vartype(This.oSettings) = 'O'
        return lcSettings
    endfunc
enddefine

28 de agosto de 2021

Olvídese de TXTWIDTH - use GdipMeasureString

Articulo original: Forget TXTWIDTH - use GdipMeasureString
https://doughennig.blogspot.com/2006/04/forget-txtwidth-use-gdipmeasurestring.html
Autor: Doug Hennig
Traducido por: Luis María Guayán


Durante años, hemos utilizado código como el siguiente para determinar el ancho de una cadena:

lnWidth = txtwidth(lcText, lcFontName, lnFontSize, ;
  lcFontStyle)
lnWidth = lnWidth * fontmetric(6, lcFontName, ;
  lnFontSize, lcFontStyle)

Este código funciona bien en muchas situaciones, pero no en una en particular: cuando se define el ancho de un objeto en un informe.

El valor calculado anteriormente está en píxeles, por lo que debe convertir el valor a FRU (las unidades utilizadas en los informes, que son 1/10000 de pulgada); debe multiplicar por 104,166 (10000 FRU por pulgada / 96 píxeles por pulgada). En lugar de hacer todo ese trabajo, puede utilizar el método GetFRUTextWidth del objeto auxiliar FFC _FRXCursor:

loFRXCursor = newobject('FRXCursor', ;
  home() + 'FFC\_FRXCursor.vcx')
lnWidth = loFRXCursor.GetFRUTextWidth(lcText, ;
  lcFontName, lnFontSize, lcFontStyle)

El problema es que esto en realidad no le da el valor correcto. El motivo es que los informes usan GDI + para la representación y GDI + representa los objetos un poco más grandes de lo esperado.

Para ver este problema, haga lo siguiente:

use home() + 'samples\data\customer'
loFRXCursor = newobject('FRXCursor', ;
  home() + 'FFC\_FRXCursor.vcx')
select max(loFRXCursor.GetFRUTextWidth(trim(company), ;
  'Arial', 10)) from customer into array laWidth
wait window laWidth[1]

Obtengo 22500. Ahora cree un informe, agregue un campo, ingrese "empresa" como expresión y hágalo 2.25 pulgadas de ancho (22500 FRU / 10000 FRU por pulgada). Obtenga una vista previa del informe. La elipsis reveladora al final de algunos valores indica que el tamaño del campo no era lo suficientemente amplio.

Esto me volvió loco durante años. Descubrí un factor empírico "fudge" para agregar al ancho calculado; 19 píxeles (1979.154 FRU) parecían funcionar la mayor parte del tiempo, pero ocasionalmente encontraba que no era suficiente para algunos valores.

Afortunadamente, dado que los informes usan GDI +, podemos usar una función GDI + para calcular con precisión el ancho. GdipMeasureString determina varias cosas sobre la cadena especificada, incluido el ancho. Aún mejor, VFP 9 viene con un objeto contenedor de GDI + para que no tenga que comprender la API de GDI + para llamar a GdipMeasureString.

Para mostrar un ejemplo del uso de las clases contenedoras de GDI +, eche un vistazo a esta función:

function GetWidth(tcText, tcFontName, tnFontSize)
local loGDI, ;
  loFont, ;
  lnChars, ;
  lnLines, ;
  loSize
loGDI = newobject('GPGraphics', ;
  home() + 'FFC\_GDIPlus.vcx')
loFont = newobject('GPFont', ;
  home() + 'FFC\_GDIPlus.vcx', '', tcFontName, ;
  tnFontSize, 0, 3)
loGDI.CreateFromHWnd(_screen.HWnd)
lnChars = 0
lnLines = 0
loSize  = loGDI.MeasureStringA(tcText, loFont, , , ;
  @lnChars, @lnLines)
lnWidth = loSize.W
release loGDI, loFont, loSize
return lnWidth

Ahora intente lo siguiente:

select max(GetWidth(trim(company), ;
  'Arial', 10)) from customer into array laWidth
wait window ceiling(laWidth[1] * 104.166)

Esto da 23838. Cambie el ancho del campo en el informe a 2,384 pulgadas y vuelva a obtener una vista previa. Esta vez los valores encajan correctamente.

El único problema ahora es que este código puede tardar mucho en ejecutarse si hay muchos registros porque para cada llamada, se crean un par de objetos contenedores de GDI + y se realiza alguna configuración de GDI +. Creé una clase contenedora para GdipMeasureString llamada SFGDIMeasureString que funciona de manera mucho más eficiente.

Veamos esta clase en secciones. Aquí está el comienzo: define algunas constantes, la clase y sus propiedades:

* Estos #DEFINEs se toman de
* home() + 'ffc\gdiplus.h'

#define GDIPLUS_FontStyle_Regular     0
#define GDIPLUS_FontStyle_Bold        1
#define GDIPLUS_FontStyle_Italic      2
#define GDIPLUS_FontStyle_BoldItalic  3
#define GDIPLUS_FontStyle_Underline   4
#define GDIPLUS_FontStyle_Strikeout   8
#define GDIPLUS_STATUS_OK       0
#define GDIPLUS_Unit_Point            3

define class SFGDIMeasureString as Custom
  oGDI    = .NULL.
    && a reference to a GPGraphics object
  oFormat = .NULL.
    && a reference to a GPStringFormat object
  oFont   = .NULL.
    && a reference to a GPFont object
  oSize   = .NULL.
    && a reference to a GPSize object
  nChars  = 0
   && the number of characters fitted in the
    && bounding box
  nLines  = 0
    && the number of lines in the bounding box
  nWidth  = 0
    && the width of the bounding box
  nHeight = 0
    && the height of the bounding box
  nStatus = 0
    && the status code from GDI+ functions

El método Init crea una instancia de algunos objetos auxiliares y declara la función GdipMeasureString. Destruye los objetos miembros con armas nucleares:

function Init
  This.oGDI    = newobject('GPGraphics', ;
    home() + 'ffc\_gdiplus.vcx')
  This.oFormat = newobject('GPStringFormat', ;
    home() + 'ffc\_gdiplus.vcx')
  This.oFont   = newobject('GPFont', ;
    home() + 'ffc\_gdiplus.vcx')
  This.oSize   = newobject('GPSize', ;
    home() + 'ffc\_gdiplus.vcx')
  declare integer GdipMeasureString ;
    in gdiplus.dll ;
    integer nGraphics, string cUnicode, ;
    integer nLength, integer nFont, ;
    string cLayoutRect, integer nStringFormat, ;
    string @cRectOut, integer @nChars, ;
    integer @nLines
endfunc

function Destroy
  store .NULL. to This.oGDI, This.oFormat, ;
    This.oFont, This.oSize
endfunc

MeasureString determina las dimensiones del cuadro delimitador para la cadena especificada:

function MeasureString(tcString, tcFontName, ;
  tnFontSize, tcStyle)
  local lcStyle, ;
    lnStyle, ;
    lnChars, ;
    lnLines, ;
    lcBoundingBox, ;
    lnGDIHandle, ;
    lnFontHandle, ;
    lnFormatHandle, ;
    lcRectF, ;
    lnStatus, ;
    llReturn
  with This

* Asegúrese de que los parámetros se pasen correctamente.

    do case
      case vartype(tcString) <> 'C' or ;
        empty(tcString)
        error 11
        return .F.
      case pcount() > 1 and ;
        (vartype(tcFontName) <> 'C' or ;
        empty(tcFontName) or ;
        vartype(tnFontSize) <> 'N' or ;
        not between(tnFontSize, 1, 128))
        error 11
        return .F.
      case pcount() = 4 and ;
       (vartype(tcStyle) <> 'C' or ;
        empty(tcStyle))
        error 11
        return .F.
    endcase

* Configure el objeto Font si se especificaron la fuente y el tamaño.

    if pcount() > 1
      lcStyle = iif(vartype(tcStyle) = 'C', ;
        tcStyle, '')
      .SetFont(tcFontName, tnFontSize, lcStyle)
    endif pcount() > 1

* Inicializar las variables de salida utilizadas en GdipMeasureString.

    lnChars       = 0
    lnLines       = 0
    lcBoundingBox = replicate(chr(0), 16)

* Obtenga los identificadores de GDI + que necesitamos.

    lnGDIHandle = .oGDI.GetHandle()
    if lnGDIHandle = 0
      .oGDI.CreateFromHWnd(_screen.HWnd)
      lnGDIHandle = .oGDI.GetHandle()
    endif lnGDIHandle = 0
    lnFontHandle   = .oFont.GetHandle()
    lnFormatHandle = .oFormat.GetHandle()

* Obtenga el tamaño del cuadro de diseño.

    lcRectF = replicate(chr(0), 8) + ;
      .oSize.GdipSizeF

* Llame a la función GdipMeasureString para obtener las dimensiones
* del cuadro delimitador para la cadena especificada.

    .nStatus = GdipMeasureString(lnGDIHandle, ;
      strconv(tcString, 5), len(tcString), ;
      lnFontHandle, lcRectF, lnFormatHandle, ;
      @lcBoundingBox, @lnChars, @lnLines)
    if .nStatus = GDIPLUS_STATUS_OK
      .nChars  = lnChars
      .nLines  = lnLines
      .nWidth  = ctobin(substr(lcBoundingBox, ;
         9, 4), 'N')
      .nHeight = ctobin(substr(lcBoundingBox, ;
        13, 4), 'N')
      llReturn = .T.
    else
      llReturn = .F.
    endif .nStatus = GDIPLUS_STATUS_OK
  endwith
  return llReturn
endfunc

GetWidth es un método de utilidad que devuelve el ancho de la cadena especificada:

function GetWidth(tcString, tcFontName, ;
  tnFontSize, tcStyle)
  local llReturn, ;
    lnReturn
  with This
    do case
      case pcount() < 2
        llReturn = .MeasureString(tcString)
      case pcount() < 4
        llReturn = .MeasureString(tcString, ;
          tcFontName, tnFontSize)
      otherwise
        llReturn = .MeasureString(tcString, ;
          tcFontName, tnFontSize, tcStyle)
    endcase
    if llReturn
      lnReturn = .nWidth
    endif llReturn
  endwith
  return lnReturn
endfunc

SetSize establece las dimensiones del cuadro de diseño para la cadena:

function SetSize(tnWidth, tnHeight)
  if vartype(tnWidth) = 'N' and ;
    tnWidth >= 0 and ;
    vartype(tnHeight) = 'N' and tnHeight >=0
    This.oSize.Create(tnWidth, tnHeight)
  else
    error 11
  endif vartype(tnWidth) = 'N' ...
endfunc

SetFont establece el nombre, el tamaño y el estilo de la fuente que se utilizará:

function SetFont(tcFontName, tnFontSize, tcStyle)
  local lcStyle
  do case
    case pcount() <= 2 and ;
      (vartype(tcFontName) <> 'C' or ;
      empty(tcFontName) or ;
      vartype(tnFontSize) <> 'N' or ;
      not between(tnFontSize, 1, 128))
      error 11
      return .F.
    case pcount() = 3 and ;
      vartype(tcStyle) <> 'C'
      error 11
      return .F.
  endcase
  lcStyle = iif(vartype(tcStyle) = 'C', tcStyle, '')
  lnStyle = iif('B' $ lcStyle, ;
      GDIPLUS_FontStyle_Bold, 0) + ;
    iif('I' $ lcStyle, ;
      GDIPLUS_FontStyle_Italic, 0) + ;
    iif('U' $ lcStyle, ;
      GDIPLUS_FontStyle_Underline, 0) + ;
    iif('-' $ lcStyle, ;
      GDIPLUS_FontStyle_Strikeout, 0)
  This.oFont.Create(tcFontName, tnFontSize, ;
    lnStyle, GDIPLUS_Unit_Point)
endfunc

Probemos el ejemplo anterior usando esta clase:

loGDI = newobject('SFGDIMeasureString', ;
  'SFGDIMeasureString.prg')
select max(loGDI.GetWidth(trim(company), 'Arial', 10)) ;
  from customer into array laWidth
wait window laWidth[1] * 10000/96

Esto es mucho más rápido que la función GetWidth presentada anteriormente. Lo siguiente se ejecutaría aún más rápido porque el objeto de fuente no tiene que inicializarse en cada llamada:

loGDI = newobject('SFGDIMeasureString', ;
  'SFGDIMeasureString.prg')
loGDI.SetFont('Arial', 10)
select max(loGDI.GetWidth(trim(company))) ;
  from customer into array laWidth
wait window laWidth[1] * 10000/96

Lo bueno de esta clase es que puede hacer mucho más que calcular el ancho de una cuerda. Es cy también determina la altura o el número de líneas que tomará una cadena en un cierto ancho (piense en establecer MEMOWIDTH en un cierto ancho y luego usar MEMLINES (), pero más rápido, más preciso y fuentes de apoyo).

Por ejemplo, tengo una clase de diálogo de mensaje genérico que utilizo para mostrar advertencias, errores y otros tipos de mensajes al usuario. No uso MESSAGEBOX () para esto porque mi clase admite varios botones con subtítulos personalizados. El problema es que los botones aparecen debajo de un cuadro de edición utilizado para mostrar el mensaje. Entonces, ¿cuánto espacio tengo que asignar para la altura del cuadro de edición? Si no especifico lo suficiente, el usuario debe desplazarse para ver el mensaje. Si especifico demasiado, los mensajes cortos se ven ridículos porque hay mucho espacio en blanco antes de los botones. Ahora, puedo hacer que el cuadro de edición tenga un tamaño arbitrario y usar SFGDIMeasureString para determinar la altura necesaria para el cuadro de edición para un mensaje dado, ajustando las posiciones de los botones dinámicamente. Para hacerlo, llamo al método SetSize para decirle a SFGDIMeasureString el ancho del cuadro de edición (paso un valor muy grande, como 10000, para la altura, por lo que no es un factor), luego llamo a MeasureString y uso el valor de la propiedad nHeight para la altura del cuadro de edición.

Estoy encontrando muchos más usos para esta clase. Espero que también te resulte útil.

15 de agosto de 2021

Cuadro de controles de la barra de título en el lado izquierdo

Artículo original: CtrlBox on Left Side
http://sandstorm36.blogspot.com/2018/08/ctrlbox-on-left-side.html
Autor: Jun Tangunan
Traducido por: Google Translate


Dado que algunos utilizan árabe/urdu, que se ocupa de la lectura y la entrada de datos de derecha a izquierda, este truco podría resultarles útil. Que es transponer también la posición del cuadro de controles de la barra de título en el lado izquierdo.

Este truco es realmente bastante simple y requiere solo 3 líneas de códigos que involucran GetWindowLong y SetWindowLong. Acabo de agregar algunos códigos para mostrar cómo se ve. Vea si esto puede resultarle útil.

Salud!

loTest = CREATEOBJECT("Form1")
loTest.SHOW(1)
READ EVENTS

DEFINE CLASS form1 AS FORM
  AUTOCENTER = .T.
  CAPTION = "ControlBox en el lado izquierdo"
  SHOWWINDOW = 2

  ADD OBJECT label1 AS LABEL WITH ;
    TOP = 20,;
    LEFT = 10,;
    FONTSIZE = 16,;
    WIDTH = THISFORM.WIDTH -20,;
    HEIGHT = THISFORM.HEIGHT - 20,;
    WORDWRAP = .T.,;
    CAPTION = "Esto muestra cómo invertir las posiciones de los objetos de la barra "+;
    "de título, como el cuadro de control, el icono y las etiquetas, dejando el interior "+;
    "del formulario en las posiciones normales de izquierda a derecha."

  PROCEDURE LOAD
    DECLARE INTEGER SetWindowLong IN user32 INTEGER HWND, INTEGER nIndex, INTEGER dwNewLong
    DECLARE INTEGER GetWindowLong IN user32 INTEGER HWND, INTEGER nIndex
    SetWindowLong(THISFORM.HWND, -20, BITOR(GetWindowLong(THISFORM.HWND, -16), 0x80000))
  ENDPROC

  PROCEDURE DESTROY
    CLEAR EVENTS
  ENDPROC
ENDDEFINE

6 de agosto de 2021

Iconos de Segoe MDL2 Assets en VFP9 con GDI+

Articulo original: Segoe MDL2 Assets Icons in VFP9 with Gdi+
http://vfpimaging.blogspot.com/2021/04/segoe-mdl2-assets-icons-in-vfp9-with-gdi.html
Autor: Cesar Ch.
Traducido por: Luis María Guayán


Como se discutió anteriormente en este blog, VFP no puede mostrar de forma nativa ningún carácter que tenga su CHR() mayor que 0xFF (decimal 255).

Hay varias fuentes muy interesantes que traen íconos muy interesantes y actualizados que podríamos usar en nuestras aplicaciones, como SEGOE MDL2 ASSETS, utilizado por Windows 10 en todas partes.

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

Los ejemplos a continuación usan GDI+ para guardar cualquier carácter deseado como una imagen, lo que nos permitirá usar esas imágenes geniales en nuestras aplicaciones. Usan las clases _GDIPLUS.VCX FFC, pero también es muy fácil de adaptar a GdiPlusX, si es necesario.

¡Adáptalo a tus necesidades!

Básicamente, una función que recupera un solo carácter Unicode y lo guarda como un archivo de imagen.

Uso:
Para obtener el icono "Imprimir":

EXTRAIGA UN ÚNICO ICONO

lcFile = "Imprimir.bmp"
lcUnicode = "e749"
lcFont = "ACTIVOS SEGOE MDL2"
lnSize = 32 && píxeles
lnForeColor = RGB (0, 0, 255) && Negro
lnBackColor = RGB (255, 255, 255) && Blanco
= MakeImageFromUnicode (m.lcFile, lcUnicode, lcFont, lnSize, lnForeColor, lnBackColor)

Guarde el siguiente código como "MakeImageFromUnicode.prg":

FUNCTION MakeImageFromUnicode(tcFileName, tcUnicode, tcFontName, tnImgSize, tnForeColor, tnBackColor)
  *!* tcUnicode allows up to 2 characters, that will be drawn one over the other
  *!* Par1: Main Unicode
  *!* Par2: Socondary Unicode
  *!* Par3: Mode, where 0=Center, 1=TopLeft, 2=TopRight, 3=BottLeft, 4=BottRight
  *!* Par4: Size of the 2nd character

  LOCAL lnChars, lnFactor, lnFontHeight, lnFontSize, lnHeight, lnLines, lnNewFontSize, lnWidth
  LOCAL lqUnicode
  LOCAL lcUnicode1, lcUnicode2, lnMode, lnSize2
  IF EMPTY(m.tcFileName) OR EMPTY(m.tcUnicode) OR EMPTY(m.tcFontName) OR EMPTY(m.tnImgSize)
    RETURN
  ENDIF

  m.lnFontSize = 48
  m.lnWidth   = m.tnImgSize
  m.lnHeight   = m.tnImgSize

  * Create a font object using the text object's settings.
  LOCAL loFont0 AS GpFont OF HOME() + "FFC/_GdiPlus.vcx"
  m.loFont0 = NEWOBJECT('gpFont', HOME() + 'FFC/_GdiPlus.vcx')
  m.loFont0.CREATE(m.tcFontName, m.lnFontSize, 0, 3) && 0 = Font Style

  LOCAL loGfx0 AS GpGraphics OF HOME() + "FFC/_GdiPlus.vcx"
  m.loGfx0 = NEWOBJECT('gpGraphics', HOME() + 'FFC\_GdiPlus.vcx')
  m.loGfx0.CreateFromHWnd(_SCREEN.HWND)
  m.lnChars = 0
  m.lnLines = 0

  LOCAL loSize AS gpSize OF HOME() + "FFC/_GdiPlus.vcx"
  m.loSize  = m.loGfx0.MeasureStringA("A", m.loFont0, , , @m.lnChars, @m.lnLines)
  * lnFontWidth = loSize.W
  m.lnFontHeight  = m.loSize.H
  m.lnFactor    = m.lnFontHeight / m.tnImgSize
  m.lnNewFontSize  = INT(m.lnFontSize / m.lnFactor)

  * Create a font object using the text object's settings.
  LOCAL loFont AS GpFont OF HOME() + "FFC/_GdiPlus.vcx"
  m.loFont = NEWOBJECT('gpFont', HOME() + 'FFC/_GdiPlus.vcx')
  m.loFont.CREATE(m.tcFontName, m.lnNewFontSize, 0, 3) && 0 = Font Style

  LOCAL loBMP AS GpBitmap OF HOME() + "FFC/_GdiPlus.vcx"
  m.loBMP = NEWOBJECT("gpBitmap", HOME() + "FFC/_GdiPlus.vcx")
  #DEFINE GdiPlus_PixelFormat_32BPPARGB        0x0026200a
  m.loBMP.CREATE(m.lnHeight, m.lnHeight, GdiPlus_PixelFormat_32BPPARGB)

  LOCAL loGfx AS GpGraphics OF HOME() + "FFC/_GdiPlus.vcx"
  m.loGfx = NEWOBJECT('gpGraphics', HOME() + 'FFC/_GdiPlus.vcx')
  m.loGfx.CreateFromImage(m.loBMP)

  * Setting the Backcolor
  LOCAL loBackColor AS GpColor OF HOME() + "FFC/_GdiPlus.vcx"
  IF EMPTY(m.tnBackColor)
    m.loBackColor = 0xFFFFFFFF && White background
  ELSE
    m.loBackColor     = NEWOBJECT("gpColor", HOME() + 'FFC/_GdiPlus.vcx')
    m.loBackColor.FoxRGB = m.tnBackColor
  ENDIF
  m.loGfx.CLEAR(m.loBackColor) && Background

  * Create a rectangle
  LOCAL loRect AS GpRectangle OF HOME() + "FFC/_GdiPlus.vcx"
  m.loRect = NEWOBJECT("GPRectangle", HOME() + 'FFC/_GdiPlus.vcx', "", 0, 0, m.lnWidth, m.lnHeight)
  m.loRect.Y = m.loRect.Y + 1

  * Setting the Forecolor
  LOCAL loColor AS GpColor OF HOME() + "FFC/_GdiPlus.vcx"
  IF EMPTY(m.tnForeColor)
    m.tnForeColor = 0 && Black
  ENDIF
  m.loColor     = NEWOBJECT("gpColor", HOME() + 'FFC/_GdiPlus.vcx')
  m.loColor.FoxRGB = m.tnForeColor

  LOCAL loBrush AS GpSolidBrush OF HOME() + "FFC/_GdiPlus.vcx"
  m.loBrush = NEWOBJECT("gpSolidBrush", HOME() + 'FFC/_GdiPlus.vcx', "", m.loColor)

  * The character need to be drawn at the center of the image object
  * Get a basic string format object
  * StringAlignment enumeration
  * Applies to GpStringFormat::Alignment, GpStringFormat::LineAlignment
  #DEFINE GDIPLUS_STRINGALIGNMENT_Near  0  && in Left-To-Right locale, this is Left
  #DEFINE GDIPLUS_STRINGALIGNMENT_Center  1
  #DEFINE GDIPLUS_STRINGALIGNMENT_Far    2  && in Left-To-Right locale, this is Right
  LOCAL loStringFormat AS gpStringFormat OF HOME() + "FFC/_GdiPlus.vcx"
  m.loStringFormat = NEWOBJECT("GpStringFormat", HOME() + "FFC/_GdiPlus.vcx")
  m.loStringFormat.CREATE()
  m.loStringFormat.ALIGNMENT     = GDIPLUS_STRINGALIGNMENT_Center
  m.loStringFormat.LineAlignment = GDIPLUS_STRINGALIGNMENT_Center

  * Prepare the Unicode
  m.lcUnicode1 = GETWORDNUM(m.tcUnicode, 1, ",")
  m.lqUnicode   = LEFT(BINTOC(EVALUATE("0x" + m.lcUnicode1), "4RS"), 2)

  * Draw the string
  m.loGfx.DrawStringW(m.lqUnicode, m.loFont, m.loRect, m.loStringFormat, m.loBrush)
  m.lcUnicode2  = GETWORDNUM(m.tcUnicode, 2, ",")

  IF NOT EMPTY(m.lcUnicode2)
    m.lqUnicode  = LEFT(BINTOC(EVALUATE("0x" + m.lcUnicode2), "4RS"), 2)
    m.lnMode  = VAL(GETWORDNUM(m.tcUnicode, 3, ","))
    m.lnSize2  = VAL(GETWORDNUM(m.tcUnicode, 4, ","))
    m.lnSize2  = EVL(m.lnSize2, 100)

    lnNewFontSize = CEILING(m.lnNewFontSize * (lnSize2/100))
    m.loFont.CREATE(m.tcFontName, m.lnNewFontSize, 0, 3) && 0 = Font Style
    m.loStringFormat.ALIGNMENT     = GDIPLUS_STRINGALIGNMENT_Center
    m.loStringFormat.LineAlignment = GDIPLUS_STRINGALIGNMENT_Center

    m.loRect.w = INT(m.lnWidth  * (m.lnSize2 / 100))
    m.loRect.H = INT(m.lnHeight * (m.lnSize2 / 100))

    DO CASE
      CASE m.lnMode = 0 && No transformation, the 2nd image will be drawn over the original
        m.loRect.x = INT((m.lnWidth  - m.loRect.w) / 2)
        m.loRect.Y = INT((m.lnHeight - m.loRect.H) / 2)

      CASE m.lnMode = 1 && Top-Left
        m.loRect.x = 0
        m.loRect.Y = 0

      CASE m.lnMode = 2 && Top-Right
        m.loRect.x = m.lnWidth - m.loRect.w
        m.loRect.Y = 0

      CASE m.lnMode = 3 && Bottom-Left
        m.loRect.x = 0
        m.loRect.Y = m.lnHeight - m.loRect.H

      CASE m.lnMode = 4 && Bottom-Right
        m.loRect.x = m.lnWidth - m.loRect.w
        m.loRect.Y = m.lnHeight - m.loRect.H

      OTHERWISE
    ENDCASE
    m.loRect.Y = m.loRect.Y + 1
    m.loGfx.DrawStringW(m.lqUnicode, m.loFont, m.loRect, m.loStringFormat, m.loBrush)
  ENDIF

  * Save as image
  m.loBMP.SaveToFile(m.tcFileName, "image/bmp")

  RETURN
ENDFUNC

La función también le permite crear nuevos íconos fusionando dos, en este caso, el ícono de Impresora y Configuración en la parte inferior derecha:

PERSONALIZA TUS ICONOS

* Setup the initial 5 variables
LOCAL lcFontName, lnImgSize, lnForeColor, lnBackColor, lcImageType
m.lcFontName  = "SEGOE MDL2 ASSETS"
m.lnImgSize	  = 64  && The desired bmp size in pixels
m.lnForeColor = RGB(0, 0, 0) && the ForeColor
m.lnBackColor = RGB(255, 255, 255) && the BackColor
m.lcImageType = "bmp" && available: bmp, jpg, gif, tif, png

EXTRACCIÓN DE TODOS LOS ICONOS DE UNA FUENTE

La función anterior se puede adaptar para extraer todos los caracteres de una fuente determinada, utilizando un bucle.

Las fuentes suelen tener algunos códigos que no se utilizan, por lo que en el siguiente código utilicé un truco simple para detectar las dimensiones vacías de la fuente, y cada vez que se cumplan las mismas condiciones en el bucle, se descartará el Unicode.

Simplemente ejecute el siguiente código para extraer todos los íconos de cualquier fuente determinada, con el tamaño y los colores de imagen deseados. ¡Ajuste las variables iniciales para que se adapten a sus necesidades!

* Setup the initial 5 variables
LOCAL lcFontName, lnImgSize, lnForeColor, lnBackColor, lcImageType
m.lcFontName  = "SEGOE MDL2 ASSETS"
m.lnImgSize    = 64  && The desired bmp SIZE IN PIXELS
m.lnForeColor = RGB(0, 0, 0) && the FORECOLOR
m.lnBackColor = RGB(255, 255, 255) && the BACKCOLOR
m.lcImageType = "bmp" && available: bmp, jpg, gif, tif, png

* Let's start
LOCAL lcEmptyUnicode, lcFileName, lcHex, lcUnicode, lnChars, lnEmptyH, lnEmptyW, lnFactor
LOCAL lnFontHeight, lnFontSize, lnFontWidth, lnHeight, lnLines, lnNewFontSize, lnWidth, loSizeReal, N

m.lnFontSize  = 48
m.lnWidth    = m.lnImgSize
m.lnHeight    = m.lnImgSize
m.lcImageType = LOWER(EVL(m.lcImageType, "bmp"))

* Create a rectangle
LOCAL loRect AS GpRectangle OF HOME() + "FFC/_GdiPlus.vcx"
m.loRect   = NEWOBJECT("GPRectangle", HOME() + 'FFC/_GdiPlus.vcx', "", 0, 0, m.lnWidth, m.lnHeight)
m.loRect.Y = m.loRect.Y + 1

* The character need to be drawn at the center of the image object
* Get a basic string format object
* StringAlignment enumeration
* Applies to GpStringFormat::Alignment, GpStringFormat::LineAlignment
#DEFINE GDIPLUS_STRINGALIGNMENT_Near  0  && IN LEFT-TO-RIGHT locale, THIS IS LEFT
#DEFINE GDIPLUS_STRINGALIGNMENT_Center  1
#DEFINE GDIPLUS_STRINGALIGNMENT_Far    2  && IN LEFT-TO-RIGHT locale, THIS IS RIGHT
LOCAL loStringFormat AS gpStringFormat OF HOME() + "FFC/_GdiPlus.vcx"
m.loStringFormat = NEWOBJECT("GpStringFormat", HOME() + "FFC/_GdiPlus.vcx")
m.loStringFormat.CREATE()
m.loStringFormat.ALIGNMENT     = GDIPLUS_STRINGALIGNMENT_Center
m.loStringFormat.LineAlignment = GDIPLUS_STRINGALIGNMENT_Center

* Create a font object using the text object's settings.
LOCAL loFont0 AS GpFont OF HOME() + "FFC/_GdiPlus.vcx"
m.loFont0 = NEWOBJECT('gpFont', HOME() + 'FFC/_GdiPlus.vcx')
m.loFont0.CREATE(m.lcFontName, m.lnFontSize, 0, 3) && 0 = FONT STYLE

LOCAL loGfx0 AS GpGraphics OF HOME() + "FFC/_GdiPlus.vcx"
m.loGfx0 = NEWOBJECT('gpGraphics', HOME() + 'FFC\_GdiPlus.vcx')
m.loGfx0.CreateFromHWnd(_SCREEN.HWND)

LOCAL loSize AS gpSize OF HOME() + "FFC/_GdiPlus.vcx"
m.lnChars     = 0
m.lnLines     = 0
m.loSize     = m.loGfx0.MeasureStringA("A", m.loFont0, , , @m.lnChars, @m.lnLines)
m.lnFontWidth  = m.loSize.W
m.lnFontHeight = m.loSize.H

m.lnFactor    = m.lnFontHeight / m.lnImgSize
m.lnNewFontSize  = INT(m.lnFontSize / m.lnFactor)

* Create a font object using the text object's settings.
LOCAL loFont AS GpFont OF HOME() + "FFC/_GdiPlus.vcx"
m.loFont = NEWOBJECT('gpFont', HOME() + 'FFC/_GdiPlus.vcx')
m.loFont.CREATE(m.lcFontName, m.lnNewFontSize, 0, 3) && 0 = FONT STYLE

* Get the measure of the empty character, that will be used to avoid saving it several times
m.lcEmptyUnicode = CHR(0) + CHR(0)
LOCAL loSizeEmpty AS gpSize OF HOME() + "FFC/_GdiPlus.vcx"
m.loSizeEmpty = m.loGfx0.MeasureStringW(m.lcEmptyUnicode, m.loFont, m.loRect, m.loStringFormat, @m.lnChars, @m.lnLines)
m.lnEmptyW    = m.loSizeEmpty.W
m.lnEmptyH    = m.loSizeEmpty.H

LOCAL loBMP AS GpBitmap OF HOME() + "FFC/_GdiPlus.vcx"
m.loBMP = NEWOBJECT("gpBitmap", HOME() + "FFC/_GdiPlus.vcx")
#DEFINE GdiPlus_PixelFormat_32BPPARGB        0x0026200a
m.loBMP.CREATE(m.lnHeight, m.lnHeight, GdiPlus_PixelFormat_32BPPARGB)

LOCAL loGfx AS GpGraphics OF HOME() + "FFC/_GdiPlus.vcx"
m.loGfx = NEWOBJECT('gpGraphics', HOME() + 'FFC/_GdiPlus.vcx')
m.loGfx.CreateFromImage(m.loBMP)

* Setting the Backcolor
LOCAL loBackColor AS GpColor OF HOME() + "FFC/_GdiPlus.vcx"
IF EMPTY(m.lnBackColor)
  m.loBackColor = 0xFFFFFFFF && White background
ELSE
  m.loBackColor     = NEWOBJECT("gpColor", HOME() + 'FFC/_GdiPlus.vcx')
  m.loBackColor.FoxRGB = m.lnBackColor
ENDIF

* Setting the Forecolor
LOCAL loColor AS GpColor OF HOME() + "FFC/_GdiPlus.vcx"
IF EMPTY(m.lnForeColor)
  m.lnForeColor = 0 && Black
ENDIF
m.loColor     = NEWOBJECT("gpColor", HOME() + 'FFC/_GdiPlus.vcx')
m.loColor.FoxRGB = m.lnForeColor

LOCAL loBrush AS GpSolidBrush OF HOME() + "FFC/_GdiPlus.vcx"
m.loBrush = NEWOBJECT("gpSolidBrush", HOME() + 'FFC/_GdiPlus.vcx', "", m.loColor)

FOR m.n = 0xe001 TO 0xf8b3 && the LAST available FOUND IN charmap
  m.lcHex     = TRANSFORM(m.n, "@0")
  m.lcHex     = STRTRAN(m.lcHex, "0x0000", "")
  m.lcFileName = FORCEEXT(m.lcHex, m.lcImageType)

  * Prepare the Unicode
  m.lcUnicode   = LEFT(BINTOC(EVALUATE("0x" + m.lcHex), "4RS"), 2)

  m.loSizeReal = m.loGfx0.MeasureStringW(m.lcUnicode, m.loFont, m.loRect, m.loStringFormat, @m.lnChars, @m.lnLines)
  IF m.loSizeReal.W == m.pnEmptyW AND m.loSizeReal.H == m.pnEmptyH
    LOOP
  ENDIF

  m.loGfx.CLEAR(m.loBackColor) && Background

  * Draw the string
  m.loGfx.DrawStringW(m.lcUnicode, m.loFont, m.loRect, m.loStringFormat, m.loBrush)

  * Save as image
  m.loBMP.SaveToFile(m.lcFileName, "image/" + m.lcImageType)
ENDFOR

* Clear GDI+ objects
m.loRect         = NULL
m.loStringFormat = NULL
m.loColor        = NULL
m.loBackColor    = NULL
m.loBrush        = NULL
m.loSize         = NULL
m.loSizeEmpty    = NULL
m.loGfx0         = NULL
m.loGfx          = NULL
m.loBMP          = NULL
m.loFont0        = NULL
m.loFont         = NULL

RETURN

IMPORTANTE

No olvide que todas las fuentes tienen licencia. Eso significa que primero debe verificar si está autorizado a distribuir las imágenes generadas. Asegúrese de leer el EULA y ver qué puede o no puede hacer con ellos, ¿de acuerdo?

VEA TAMBIEN

30 de julio de 2021

Capturando pantallas con GdiPlus-X

Artículo original: CAPTURING SCREENS WITH GDIPLUS-X
Autor: Cesar Ch.
Traducido por: Luis María Guayán


Capturar una pantalla con Gdiplus-X es una tarea muy fácil también.

Básicamente todo lo que tenemos que hacer, es llamar al método FromScreen() de la clase de Bitmap. Para facilitar esta tarea, este método brinda diferentes posibilidades.

IMPORTANTE:

Todas los ejemplos siguientes utilizan la nueva librería GDIPlus-X, que está todavía en la versión ALFA, pero es estable y confiable para hacer la mayoría de las tareas de GDI+. Descargue la última versión estable de VFPx:

https://github.com/VFPX/GDIPlusX

1 - Capturar una pantalla de un Formulario enviando el hWnd del formulario o el formulario como un objeto

_SCREEN.AddProperty("System", NEWOBJECT("xfcSystem", LOCFILE("system.vcx","vcx"))) 

LOCAL loCaptureBmp AS xfcBitmap
WITH _Screen.System.Drawing
   loCaptureBmp = .Bitmap.FromScreen(Thisform.HWnd)
   * Could be also:
   * loCaptureBmp = _screen.system.Drawing.Bitmap.FromScreen(Thisform)
   loCaptureBmp.Save("c:\Captured.png", .Imaging.ImageFormat.Png)
ENDWITH

2 - Capturar la pantalla entera

En este caso no es necesario pasar parámetros

_SCREEN.AddProperty("System", NEWOBJECT("xfcSystem", LOCFILE("system.vcx","vcx"))) 

LOCAL loCaptureBmp AS xfcBitmap
WITH _Screen.System.Drawing
   loCaptureBmp = .Bitmap.FromScreen()
   loCaptureBmp.Save("c:\CapturedScreen.png", .Imaging.ImageFormat.Png)
ENDWITH

3 - Capturar la pantalla de un formulario recortando sus bordes y título.

Para esta tarea utilizamos la función SYSMETRIC() para obtener la medida de los elementos de la pantalla, tales como la altura del título, borde superior e izquierdo. Entonces utilizamos otra posibilidad, enviando el hWnd, y las coordenadas del formulario que será capturado.

_SCREEN.AddProperty("System", NEWOBJECT("xfcSystem", LOCFILE("system.vcx","vcx"))) 

LOCAL lnTitleHeight, lnLeftBorder, lnTopBorder
lnTitleHeight = SYSMETRIC(9)
lnLeftBorder = SYSMETRIC(3)
lnTopBorder = SYSMETRIC(4)

LOCAL loCaptureBmp AS xfcBitmap


WITH _Screen.System.Drawing
   loCaptureBmp = .Bitmap.FromScreen(;
      Thisform.HWnd, ;
      lnLeftBorder, ;
      lnTitleHeight + lnTopBorder, ;
      Thisform.Width, ;
      Thisform.Height)

   loCaptureBmp.Save("c:\Captured.png", .Imaging.ImageFormat.Png)
ENDWITH

4 - Capturar todos los formularios de la pantalla

Esto también es muy fácil. Sólo cree un ciclo por todas los formularios de _Screen, y capture cada uno de ellos enviando el Form.hWnd como parámetro.

_SCREEN.AddProperty("System", NEWOBJECT("xfcSystem", LOCFILE("system.vcx","vcx"))) 

LOCAL loCaptureBmp AS xfcBitmap
LOCAL n
LOCAL loForm AS Form
n = 1

WITH _Screen.System.Drawing

FOR EACH loForm IN _Screen.Forms
   loCaptureBmp = .Bitmap.FromScreen(loForm.HWnd)
   loCaptureBmp.Save("c:\CapturedForm" + TRANSFORM(n) + ".png", .Imaging.ImageFormat.Png)
   n = n + 1
ENDFOR

ENDWITH

16 de julio de 2021

Información de imágenes con GDI+

Artículo original: Image Info with GdiPlus X
http://vfpimaging.blogspot.com/2007/04/image-info-with-gdiplus-x.html
Autor: Cesar Ch
Traducido por: Ana María Bisbé York


Otra sencilla tarea para GDI+

Para obtener alguna información básica de imágenes, tal como, Ancho, Alto, Resolución y Formato de pixeles, todo lo que necesitamos es Iniciar un objeto Image de GDI+ y tomar algunos valores de las propiedades, como se muestra debajo.

IMPORTANTE:

Todos los ejemplos que se muestran a continuación utilizan la nueva biblioteca GDIPlus-X, que está aún en versión ALPHA, pero es realmente estable y fiable para hacer la gran mayoría de las tareas de GDI+. Descargue la versión más estable de VFPx:

https://github.com/VFPX/GDIPlusX

Image Properties

LOCAL lcImage
lcImage = GETPICT()
IF EMPTY(lcImage)
  RETURN
ENDIF
_SCREEN.AddProperty("System", NEWOBJECT("xfcSystem", LOCFILE("system.vcx")))
LOCAL loImg AS xfcImage
WITH _SCREEN.System.Drawing
  loImg = .Image.FromFile(lcImage)
    IF ISNULL(loImg)
      MESSAGEBOX("No se pudo cargar el archivo imagen")
      RETURN 
    ENDIF
  * Obtener el nombre de formato de pixeles (PixelFormat )
  LOCAL lnPix, lcPixFormat
  lnPix = loImg.PixelFormat 
  DO CASE 
    CASE lnPix = .Imaging.PixelFormat.Format1bppIndexed 
      lcPixFormat = "1bppIndexed"
    CASE lnPix = .Imaging.PixelFormat.Format4bppIndexed 
      lcPixFormat = "4bppIndexed"
    CASE lnPix = .Imaging.PixelFormat.Format8bppIndexed 
      lcPixFormat = "8bppIndexed"
    CASE lnPix = .Imaging.PixelFormat.Format16bppGrayScale
      lcPixFormat = "16bppGrayScale"
    CASE lnPix = .Imaging.PixelFormat.Format16bppRGB555
      lcPixFormat = "16bppRGB555"
    CASE lnPix = .Imaging.PixelFormat.Format16bppRGB565
      lcPixFormat = "16bppRGB565"
    CASE lnPix = .Imaging.PixelFormat.Format16bppARGB1555
      lcPixFormat = "16bppARGB1555"
    CASE lnPix = .Imaging.PixelFormat.Format24bppRGB
      lcPixFormat = "24bppRGB"
    CASE lnPix = .Imaging.PixelFormat.Format32bppRGB
      lcPixFormat = "32bppRGB"
    CASE lnPix = .Imaging.PixelFormat.Format32bppARGB
      lcPixFormat = "32bppARGB"
    CASE lnPix = .Imaging.PixelFormat.Format32bppPARGB
      lcPixFormat = "32bppPARGB"
    CASE lnPix = .Imaging.PixelFormat.Format48bppRGB
      lcPixFormat = "48bppRGB"
    CASE lnPix = .Imaging.PixelFormat.Format64bppPARGB
      lcPixFormat = "64bppPARGB"
    OTHERWISE 
      lcPixFormat = "No identificado"
  ENDCASE
ENDWITH

LOCAL lcInfo
lcInfo = ;
  "Ancho : " + TRANSFORM(loImg.Width) + SPACE(25) +;
  "Alto : " + TRANSFORM(loImg.Height) + CHR(13) +;
  "Resolución - Vertical : " + TRANSFORM(loImg.VerticalResolution) + SPACE(6) +;
  "Horizontal : " + TRANSFORM(loImg.HorizontalResolution) + CHR(13) +;
  "Formato de pixeles : " + lcPixFormat
MESSAGEBOX(lcInfo, 64, "Propiedades de imagen para " + JUSTFNAME(lcImage))

2 de julio de 2021

Utilice MDots por la velocidad, no solo por la exactitud

Artículo original: Use MDots for speed, not just for correctness
(Use MDots for speed.pdf)
Autor: Tamar E. Granor
Traducido por: Luis María Guayán


El prefijo de referencias a variables "m." (mdot) no solo hace que su código sea inequívoco, sino que lo hace más rápido.

Puede que no haya ningún tema en el que los desarrolladores de VFP como grupo se sientan mas convencidos que si prefijar o no, todas las referencias a las variables con "m." para evitar ambigüedades. Sin embargo, puede que sea hora de que se termine ese argumento, porque resulta que el uso de mdots también hace que el código se ejecute más rápido.

Desde sus primeros días, FoxPro ha dado preferencia a los nombres de campo en las expresiones. Cuando una expresión incluye un nombre que es tanto un nombre de campo de la tabla abierta en el área de trabajo actual, como una variable, a menos que se indique lo contrario, FoxPro usa el campo. Es decir, cuando tiene un código como el Listado 1, VFP primero busca campos llamados nHeight y nWidth. Solo si no lo encuentra, decide que debe haber querido decir variable.

Listado 1. Cuando se usan nombres en una expresión, VFP da preferencia a los nombres de campos.

 nArea = nHeight * nWidth 

Si desea utilizar la variable en lugar de un campo del mismo nombre, puede precederla con la letra "m" y un punto. Los desarrolladores de VFP suelen llamar a ésta combinación "mdot".

El Listado 2 muestra el ejemplo anterior con las variables claramente indicadas.

Listado 2. Mdots deja en claro que se refiere a una variable.

 nArea = m.nHeight * m.nWidth 

En este ejemplo, mdot no es necesario para nArea porque solo se puede asignar un nuevo valor a las variables mediante el signo igual.

Convenciones de nomenclatura como solución

Debido a este comportamiento, muchos desarrolladores de VFP han adoptado convenciones de nomenclatura destinadas a garantizar que nunca tengan variables y campos con el mismo nombre. La notación más común (recomendada en el archivo de ayuda de VFP y generalmente denominada "húngara") utiliza una letra de alcance ("l" para local, "p" para privado, "g" para global/pública) seguida de una letra tipo ("c" para carácter, "n" para numérico, etc.) al principio de cada nombre de variable. En esa notación, los campos obtienen un tipo de letra, pero no un indicador de alcance. Usando esta notación, un campo que representa height sería nHeight, pero una variable de altura sería lnHeight.

El problema de confiar en una convención de nomenclatura es que VFP no la conoce y no evita todos los conflictos. Por ejemplo, no seria imposible imaginar tener un campo llamado lOrange y una variable llamada loRange. Si bien estos se ven legiblemente diferentes, para el motor VFP, son exactamente iguales y el campo se utilizará siempre que haya ambigüedad.

A estas alturas, probablemente pueda decir que está del lado de "siempre usar mdots", y si está firmemente del lado de "no mdots", probablemente ningún argumento sobre cómo funciona VFP o posibles errores lo convencerá.

MDots es más rápido

Sin embargo, también resulta que el uso de mdots hace que su código se ejecute más rápido. Cuánto más rápido depende del número de referencias a variables y del número de campos de la tabla abiertos en el área de trabajo actual.

Recientemente probé en dos computadoras diferentes, usando dos programas diferentes, uno con solo unas pocas referencias a variables y otro con muchísimas más.

En cada caso, también probé diferentes números de campos en el área de trabajo actual, comenzando sin una tabla abierta, luego con una tabla (en realidad, un cursor) con cinco campos, luego uno con 10 campos, y así sucesivamente hasta 200 campos en la tabla en el área de trabajo actual.

Dada la preferencia de VFP por los campos, no me sorprendió ver que mdot era más rápido y que cuantos más campos en la tabla en el área de trabajo actual, mayor era la ventaja de mdot.

El Listado 3 muestra el primer programa de prueba, el que tiene menos referencias a variables. El código usa variables de altura y ancho para calcular el perímetro y área. Los cálculos se realizan en un ciclo que se ejecuta durante cinco segundos; hay un total de seis referencias a variables en el ciclo y los cálculos.

Listado 3. Este programa compara el uso de variables con mdots con el uso de variables sin mdots. El bloque que se está probando contiene seis referencias a variables.

* Compare speed with and without mdot
#DEFINE SECONDSTORUN 5
LOCAL nCase1Start, nCase1LoopEnd,
nCase2LoopStart, nCase2LoopEnd
LOCAL nCase1Passes, nCase2Passes
LOCAL nLength, nWidth, nPerimeter, nArea
* Test multiple cases from no table open
* to table with many fields open.
* Store results in a cursor in a different
* workarea.
CREATE CURSOR csrMDotSpeeds
(nFields N(3), nNoMDots I, nMDots I)
SELECT 0
LOCAL nFields, nField, cFieldList
* Initialize variables for calculations
nLength = 27.3
nWidth = 13.7
FOR nFields = 0 TO 200 STEP 5
  IF m.nFields <> 0
    cFieldList = ''
    FOR nField = 1 TO m.nFields
      cFieldList = m.cFieldList + "cField" + ;
        TRANSFORM(m.nField) + " C(5), "
    ENDFOR
    cFieldList = TRIM(m.cFieldList, ", ")
    CREATE CURSOR csrDummy (&cFieldList)
  ELSE
    SELECT 0
  ENDIF
  * Now do the test
  nCase1LoopStart = SECONDS()
  nCase1LoopEnd = m.nCase1LoopStart + ;
    SECONDSTORUN
  nCase1Passes = 0
  DO WHILE nCase1LoopEnd > SECONDS()
    nCase1Passes = nCase1Passes + 1
    nPerimeter = 2*nLength + 2*nWidth
    nArea = nLength * nWidth
  ENDDO
  nCase2LoopStart = SECONDS()
  nCase2LoopEnd = m.nCase2LoopStart + ;
    SECONDSTORUN
  nCase2Passes = 0
  DO WHILE m.nCase2LoopEnd > SECONDS()
    nCase2Passes = m.nCase2Passes + 1
    nPerimeter = 2*m.nLength + 2*m.nWidth
    nArea = m.nLength * m.nWidth
  ENDDO
  INSERT INTO csrMDotSpeeds
  VALUES (m.nFields, m.nCase1Passes, ;
    m.nCase2Passes)
  IF m.nFields <> 0
    USE IN csrDummy
  ENDIF
ENDFOR
RETURN

Los resultados de esta prueba en dos máquinas diferentes, fueron bastante similares. Sin tabla abierta en el área de trabajo actual (el caso 0), la versión sin mdots fue un poco más rápida. Después de eso, sin embargo, la versión mdots siempre fue más rápida. Con 30 campos en la tabla, la versión mdots completó más de un 25% más de iteraciones; con 50 campos, la versión mdots completó un 50% más de iteraciones. En el extremo máximo de la prueba, 200 campos, la versión mdots hizo 2,7 veces más pases.

El número de iteraciones completadas por el código usando mdots fue notablemente estable. Para una máquina determinada, la diferencia entre el máximo y el mínimo fue inferior al 0,02% del valor máximo.

Por otro lado, el número de iteraciones completadas por el código sin mdots descendió de manera bastante constante. Con 200 campos, solo se completaron alrededor de un tercio de las iteraciones que sin una tabla abierta.

Es importante tener en cuenta que estamos hablando de millones de iteraciones en cinco segundos, por lo que el efecto es pequeño para cualquier referencia a variable dada. Sin embargo, en una aplicación, es probable que tenga miles o decenas de miles de referencias a variables; en una aplicación típica, es probable que la mayoría de ellos ocurran con una tabla abierta en el área actual.

Una prueba más extensa

Quería ver la diferencia que hace mdot en un programa con muchas más referencias a variables que el ejemplo de perímetro y área. Para hacerlo, adapté un fragmento de código de una aplicación cliente. El núcleo del código es una función que determina si un punto específico está "cerca" de una línea específica. Acepta cuatro parámetros, una línea, un punto (en forma de coordenadas de fila y columna) y una tolerancia. La tolerancia indica qué tan lejos de la línea puede estar algo y aún ser considerado "cerca". El código real no es importante, pero la función contiene casi 60 referencias a variables potencialmente ambiguas.

La prueba, estructurada de la misma manera que la prueba anterior, se muestra en el Listado 4.

Listado 4. Este código prueba la velocidad de un programa con más de 50 referencias a variables con y sin mdots.

* Compare speed with and without mdot
#DEFINE SECONDSTORUN 5
LOCAL nCase1Start, nCase1LoopEnd, nCase2LoopStart, nCase2LoopEnd
LOCAL nCase1Passes, nCase2Passes
* Test multiple cases from no table open
* to table with many fields open.
* Store results in a cursor in a different
* workarea.
CREATE CURSOR csrMDotSpeedsLarge ;
  (nFields N(3), nNoMDots I, nMDots I)
SELECT 0
LOCAL nFields, nField, cFieldList
LOCAL oLine AS LINE
oLine = CREATEOBJECT("Line")
oLine.LEFT = 27
oLine.TOP = 13
oLine.HEIGHT = 152
oLine.WIDTH = 53
FOR nFields = 0 TO 200 STEP 5
  IF m.nFields <> 0
    cFieldList = ''
    FOR nField = 1 TO m.nFields
      cFieldList = m.cFieldList + "cField" + ;
        TRANSFORM(m.nField) + " C(5), "
    ENDFOR
    cFieldList = TRIM(m.cFieldList, ", ")
    CREATE CURSOR csrDummy (&cFieldList)
  ELSE
    SELECT 0
  ENDIF
  * Now do the test
  nCase1LoopStart = SECONDS()
  nCase1LoopEnd = m.nCase1LoopStart + ;
    SECONDSTORUN
  nCase1Passes = 0
  DO WHILE nCase1LoopEnd > SECONDS()
    nCase1Passes = nCase1Passes + 1
    IsPointNearLineNoMDot(oLine, 55, 45, 1)
    IsPointNearLineNoMDot(oLine, 100, 27, 2)
    IsPointNearLineNoMDot(oLine, 0, 0, 1)
    IsPointNearLineNoMDot(oLine, 500, 7, 3)
  ENDDO
  nCase2LoopStart = SECONDS()
  nCase2LoopEnd = m.nCase2LoopStart + ;
    SECONDSTORUN
  nCase2Passes = 0
  DO WHILE m.nCase2LoopEnd > SECONDS()
    nCase2Passes = m.nCase2Passes + 1
    IsPointNearLineMDot(m.oLine, 55, 45, 1)
    IsPointNearLineMDot(m.oLine, 100, 27, 2)
    IsPointNearLineMDot(oLine, 0, 0, 1)
    IsPointNearLineMDot(oLine, 500, 7, 3)
  ENDDO
  INSERT INTO csrMDotSpeedsLarge ;
    VALUES (m.nFields, m.nCase1Passes, ;
    m.nCase2Passes)
  IF m.nFields <> 0
    USE IN csrDummy
  ENDIF
ENDFOR

A esta altura, no debería sorprendernos que cuantos más campos de la tabla abierta en el área de trabajo actual, mayor será la ventaja de la versión con mdots.

En mis pruebas, la versión mdot se ejecutó aproximadamente un 25% más de veces en con 70 campos en el área de trabajo y aproximadamente un 50% más de veces con 150 campos.

Sospecho que la razón por la que la diferencia no es tan extrema como en el ejemplo anterior, es que hay mucho más código que no son referencias de variables en este ejemplo. Es decir, el código general es más complejo. (De hecho, mientras que el ejemplo anterior logró millones de pases en cinco segundos, el ejemplo más extenso completó solo decenas de miles).

Para tener una mejor idea de la diferencia entre las dos pruebas, calculé un "tiempo por referencia a variable" aproximado para cada una. Específicamente, hice el cálculo del Listado 5, dividiendo los cinco segundos de la prueba por el producto del número de referencias a variables y el número de pasadas completadas. Por supuesto, este es solo un tiempo aproximado por referencia a variable porque hay otro código en cada prueba. Sin embargo, me permitió hacer una comparación entre las dos pruebas.

Listado 5. Esta ecuación calcula un "tiempo por referencia a variable" aproximado.

Time = TestTime/((# of variables) * passes)

Lo que encontré fue que la segunda prueba, más compleja, tomó aproximadamente un orden de magnitud más para cada referencia que la prueba más simple. Nuevamente, es probable que sea un reflejo del código adicional en el caso más complejo.

¿Qué pasa con las matrices?

El código que determina si un punto está cerca de una línea usa un par de matrices en sus cálculos. Dado que una referencia a un elemento de matriz no se puede confundir con una referencia a un campo, me pregunté si hace una diferencia usar mdots en esas referencias.

Probé agregando un tercer caso a la prueba más extensa. Está estructurado de la misma manera que las dos pruebas del Listado 4, pero llama a una tercera versión de IsPointNearLine que tiene mdots en referencias a variables escalares, pero no en referencias a elementos de matriz.

Encontré solo una pequeña diferencia entre ésta versión y la que tiene mdots en todas las referencias a variables, incluidas las matrices. La mayoría de las veces (66 de 82 casos), el que no tenía mdots en las referencias a matriz era más rápido, pero a veces el que usaba mdots en las referencias a matriz era más rápido. Eso sugiere que VFP es lo suficientemente inteligente como para no buscar (o no mirar mucho) un campo cuando se le da una referencia a matriz.

Algunas palabras sobre las pruebas de tiempo

Las pruebas en el entorno de Windows son inherentemente defectuosas. Entre el propio Windows y varios servicios que siempre se están ejecutando, cualquier resultado de prueba puede ser inexacto.

Hay dos cosas que puede hacer para obtener mejores resultados. Primero, antes de probar, apague todo lo que pueda que pueda interferir, como un cliente de correo electrónico, escaneo de virus bajo demanda, etc. Si no necesita una red para la prueba, considere desconectarse.

En segundo lugar, realice más de una prueba para cada caso. Ese consejo también es importante porque VFP almacena datos en caché, por lo que la primera vez que ejecuta un proceso que utiliza DBF, es probable que tarde más que las ejecuciones posteriores.

Como mencioné anteriormente, hice mis pruebas en dos máquinas diferentes. En ambos casos, me aseguré de que Outlook y mi cliente de Twitter estuvieran cerrados. Cuando se estaba ejecutando una prueba, no hice nada más con esa computadora, ni siquiera tocar el teclado o mover el mouse. Además, en el transcurso de la redacción, realicé cada una de mis pruebas varias veces.

Incluso con estas medidas, los resultados de las pruebas deben verse más como un indicador que como una respuesta definitiva. En este caso, debido a que la diferencia entre los resultados mdots y no mdots es tan grande, es seguro afirmar que mdots marca la diferencia. Por otro lado, la diferencia entre mdots en todas las referencias a variables y mdots solo en referencias a variables de elementos que no son de matriz es lo suficientemente pequeña como para insinuar la respuesta. Se necesitan más pruebas en un entorno más controlado para confirmar ese resultado.

Sólo tiene que utilizar mdots

Como dije al principio, ya estoy subida al carro de los mdots. Me ha pasado demasiadas veces que el código un campo, cuando me refiero a una variable y no quiero preocuparme por eso nunca más. Además, trabajo a menudo con códigos escritos originalmente por otros, por lo que incluso si adoptara una convención de nomenclatura estricta, es probable que gran parte del código que toco no lo esté usando.

Pero incluso si realmente cree que su convención de nomenclatura lo protegerá de ese problema, el hecho de que omitir mdots hace que su aplicación sea más lenta y debería reconsiderar su elección.


Copyright (C) Tamar E. Granor, Tomorrow’s Solutions, LLC.

25 de junio de 2021

Arrastrar, soltar y restringir

Artículo original: Drag, Drop and Restrict
http://sandstorm36.blogspot.com/2020/06/drag-drop-and-restrict.html
Autor: Jun Tangunan
Traducido por: Luis María Guayán


Acabo de leer un problema dentro de Foxite.com en el que cuando un usuario mueve accidentalmente el mouse más allá de los límites del formulario, la función de arrastrar y soltar falla porque los objetos desaparecen en las áreas más allá del formulario.

La solución a eso es restringir los movimientos de arrastrar y soltar dentro de su formulario, o la dimensión dentro de los objetos en su formulario. Aquí hay dos ejemplos que muestran cómo lograrlo:

Ejemplo 1:

* Restricting drag and drop within the form

Local oForm As Form
oForm = Createobject('TestForm')
oForm.Show(1)
Return

Define Class TestForm As Form
      AutoCenter = .T.
      Width = 900
      Height = 440
      Caption = 'Drag, Drop & Restrict Inside Form'
      Add Object container1 As Mycontainer With Top = 30, Left = 50
Enddefine

Define Class Mycontainer As Container
      Height = 100
      Width = 100
      Procedure MouseMove
      Lparameters nButton, nShift, nXCoord, nYCoord
      If m.nButton = 1 And Between(m.nYCoord,0,Thisform.Height-This.Height) And ;
                  BETWEEN(m.nXCoord,0,Thisform.Width-This.Width)
            This.Move(m.nXCoord, m.nYCoord)
      Endif
      Endproc
Enddefine

Ejemplo 2:

* Restricing within objects on form, in this case above or below the lines
Local oForm As Form
oForm = Createobject('TestForm')
oForm.Show(1)
Return

Define Class TestForm As Form
      AutoCenter = .T.
      Width = 900
      Height = 440
      Caption = 'Drag, Drop & Restrict'
      Add Object Shape1 As shape With Top = 30, Left = 0, Width = 900, height = 1
      Add Object Shape2 As shape With Top = 200, Left = 0, Width = 900, height = 1
      Add Object Command1 As MyButton With Caption='Move Me outside of the lines', Top = 35, Left = 5, width = 200, height = 30
Enddefine

Define Class MyButton As CommandButton
      Procedure MouseMove
            Lparameters nButton, nShift, nXCoord, nYCoord
            If m.nButton = 1 AND BETWEEN(m.nYCoord,30,171)
                  This.Move(m.nXCoord, m.nYCoord)
                  WAIT WINDOW m.nYCoord nowait
            Endif
      Endproc
Enddefine

Por si lo necesitas. Saludos!