13 de enero de 2022

Edad de una persona

Una (de tantas) funciones para calcular la edad de una persona.

* Ejemplo:
? Edad(DATE(1998,06,03))

*-----------------------------------------------------
* FUNCTION Edad(tdNac, tdHoy)
*-----------------------------------------------------
* tdNac = Fecha de nacimiento
* tdHoy = Fecha a la cual se calcula la edad (Por defecto toma la fecha actual)
*-----------------------------------------------------
FUNCTION Edad(tdNac, tdHoy)
  IF EMPTY(tdHoy)
    tdHoy = DATE()
  ENDIF
  RETURN FLOOR((VAL(DTOC(tdHoy,1)) - VAL(DTOC(tdNac,1))) / 10000)
ENDFUNC
*-----------------------------------------------------

Cetin Basoz, Izmir, Turkey
Publicado en www.foxite.com

8 de enero de 2022

Función PUTFILE() como se escribió originariamente (no en mayúsculas)

Artículo original: PUTFILE function as originally typed (not in uppercase)
http://vfpimaging.blogspot.com/2021/01/putfile-function-as-originally-typed.html
Autor: Cesar Ch.
Traducido por: Google Translate


Como ya se ha discutido en Fox.Wikis: "VFP siempre ha sido un poco más gracioso con los casos de nombres de archivo. Más específicamente, no está documentado cómo funciona con el caso de nombres de archivo. Se traducirá los nombres de archivo a minúsculas en algunos casos, a mayúsculas en otros, y dejarlo igual en otros."

PUTFILE() está en esa lista de funciones extrañas, siempre devolviendo los nombres de archivo en MAYÚSCULAS. Así que aquí hay una pequeña función que he estado usando que devuelve el nombre de archivo elegido de la forma en que el usuario lo escribió.

Los parámetros y el uso son exactamente los mismos que los de la función PUTFILE() original de Visual FoxPro:

FUNCTION XPUTFILE(tcCustomText, tcFileName, tcFileExt)

  * Usage:
  * ? PUTFILE("Save file as...", "MyFile.PDF", "PDF;TXT;*")

  #DEFINE COMMDLOG_DEFAULT_FLAG   0x00080000
  #DEFINE COMMDLOG_RO       4
  #DEFINE COMMDLOG_MULTFILES     512

  LOCAL lcSetDefa
  m.lcSetDefa = SET("Default") + CURDIR()

  LOCAL loDlgForm AS "Form"
  m.loDlgForm = CREATEOBJECT("Form")
  m.loDlgForm.ADDOBJECT("oleObject1", "oleComDialObject")

  LOCAL loDlg
  m.loDlg = m.loDlgForm.OleObject1

  LOCAL lcFilter, lcFileExt, lnExtCount, N
  IF NOT EMPTY(tcFileExt)
    lnExtCount = GETWORDCOUNT(m.tcFileExt, ";")
    lcFilter = ""
    FOR N = 1 TO lnExtCount
      lcFileExt = GETWORDNUM(m.tcFileExt, N, ";")
      IF lcFileExt = "*"
        lcFilter = lcFilter + "All files|*.*"
      ELSE
        lcFilter = lcFilter + lcFileExt + " files|*." + lcFileExt && EVL(tcFileExt, "All files|*.*")
      ENDIF
      IF N < lnExtCount
        lcFilter = lcFilter + "|"
      ENDIF
    ENDFOR
  ELSE
    lcFilter = "*.*|*.*" && EVL(tcFileExt, "All files|*.*")
  ENDIF

  m.loDlg.FILTER    = lcFilter
  m.loDlg.FileName  = EVL(m.tcFileName, "")
  m.loDlg.DialogTitle  = EVL(m.tcCustomText, "Save file as...")
  m.loDlg.FLAGS    = COMMDLOG_RO + COMMDLOG_DEFAULT_FLAG
  m.loDlg.MaxFileSize  = 256

  LOCAL lnResult AS INTEGER, lcFileName
  * lnResult = loDlg.ShowOpen()
  m.lnResult = m.loDlg.ShowSave()

  * Restore the original directory
  SET DEFAULT TO (m.lcSetDefa)

  IF EMPTY(m.loDlg.FileTitle) && Clicked 'Cancel'
    m.lcFileName = ""
  ELSE
    m.lcFileName = m.loDlg.FileName
  ENDIF
  m.loDlgForm = NULL
  RETURN m.lcFileName


DEFINE CLASS oleComDialObject AS OLECONTROL
  OLECLASS ="MSComDlg.CommonDialog.1"
ENDDEFINE

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