Autogenerar Report mejorando presentacion

En muchas ocasiones me surgía la necesidad de realizar un listado sencillo, a partir de una pequeña tabla o cursor, lo que me obligaba a diseñar e incluir en mis proyectos, numerosos 'reports', cuya utilidad no era excesivamente importante.

Siempre había descartado la opcion "CREATE REPORT FROM 'filename' ", porque el resultado tenía una apariencia demasiado rustica.

Todo esto me terminó por decidir a intentar desarrollar una rutina que, tras generar un report automático desde una tabla o cursor, mejorase algo su presentación. No pretendo obtener un resultado espectacular ni incluir un monton de opciones y posibilidades, sino solo conseguir un report con un aspecto presentable.

A la rutina siguiente, solo es necesario pasarle 2 parametros, el nombre de la tabla o cursor, a partir de la cual se generará el report, y un título para el listado.

Los campos se presentarán en el orden en que aparezcan en la tabla o cursor.

Esta es la rutina:

**************************************************************
* Autogeneracion de un listado (report rapido) partiendo de un
* cursor o tabla.
* Se autoajusta fuente, tamaño y nº de columnas a mostrar
*
* Parametros: cCursor --> Nombre del cursor/tabla origen
*                    cTitulo --> Titulo para el listado
*
* Ej: do autorepo with "micursor", "Titulo del Listado"
*
****************************************************************
LPARAMETERS cCursor, cTitulo
*
LOCAL cRepo, nLong, sFont, cFont, cCampos, nMaxCol, sExtra

cRepo = SYS(2015) + '.frx'
*
IF VARTYPE(cCursor) # 'C'
  WAIT WINDOW "Faltan Datos"
ENDIF
IF VARTYPE(cTitulo) # 'C'
  cTitulo = ''
ENDIF

cFont = 'Calibri'  && Fuente de letra a usar
nMaxCol = 225      && Nº máximo de columnas (depende de fuente)
nLong = 0
cCampos = ''

* Establecer anchura, limites y tamaño fuente
nCampos = AFIELDS(aCampos, cCursor)
FOR xx = 1 TO nCampos
  nLong = nLong + aCampos(xx, 3)
  IF nLong > nMaxCol
    cTitulo = cTitulo + '    ***'
    EXIT
  ELSE
    IF EMPTY(cCampos)
      cCampos = cCampos + aCampos(xx,1)
    ELSE
      cCampos = cCampos + ', ' +aCampos(xx,1)
    ENDIF
  ENDIF
ENDFOR

* Ajusto tamaño de fuente depende long. datos
* 'sExtra' para ajustar campos (depende de ver. VFP)
DO CASE
  CASE nLong > 190
    sFont = 7
    sExtra = IIF(VERSION(5) / 100 = 9, 120, -320)

  CASE nLong > 160
    sFont = 8
    sExtra = IIF(VERSION(5) / 100 = 9, 200, -170)

  CASE nLong > 135
    sFont = 9
    sExtra = IIF(VERSION(5) / 100 = 9, 360, -110)

  OTHERWISE
    sFont = 10
    sExtra = IIF(VERSION(5) / 100 = 9, 450, 180)
ENDCASE

* Crear un report y pasar a realizar ajustes
CREATE REPORT (cRepo) FROM DBF(cCursor) FIELDS &cCampos COLUMN WIDTH 256
*
USE (cRepo) IN 0 ALIAS mirepor EXCL
SELECT mirepor
*
* Cambiar texto 'Page' por 'Página' en caso de runtime en ingles
REPLACE EXPR WITH ["Página "] FOR ALLTRIM(EXPR) = ["Page "] IN mirepor
*
* Cambiar la fuente para todos 'labels' y 'campos'
REPLACE ALL fontface WITH cFont FOR INLIST(objtype, 5, 8)

* Cambiar tamaño fuente y estilo para 'labels' encabezado columnas
REPLACE ALL FONTSIZE WITH sFont, fontstyle WITH 3  FOR objtype=5 AND Vpos=0 IN mirepor

* Reducir tamaño fuente para todos 'campos'
REPLACE ALL FONTSIZE WITH sFont - 1  FOR objtype = 8

* Cambiar tamaño fuente y estilo para 'labels' y 'campos' del pie de pagina
REPLACE FONTSIZE WITH sFont - 1, fontstyle WITH 2 FOR ALLTRIM(EXPR) = [DATE()] IN mirepor
REPLACE FONTSIZE WITH sFont - 1, fontstyle WITH 2 FOR ALLTRIM(EXPR) = ["Página "] IN mirepor
REPLACE FONTSIZE WITH sFont - 1, fontstyle WITH 2 FOR ALLTRIM(EXPR) = [_PAGENO] IN mirepor
*
* Añadir línea separación en pie de pagina
GOTO TOP
LOCATE FOR ALLTRIM(mirepor.EXPR) = [_PAGENO]
miW = mirepor.hpos + mirepor.WIDTH + 100
miV = mirepor.Vpos -100
*
APPEND BLANK IN mirepor
REPLACE mirepor.objtype WITH 6
REPLACE mirepor.Vpos WITH miV
REPLACE mirepor.WIDTH WITH miW
REPLACE mirepor.HEIGHT WITH 105
REPLACE mirepor.penpat WITH 8
REPLACE mirepor.supalways WITH .T.
REPLACE mirepor.platform WITH 'WINDOWS'
*
* Añadir línea separación en encabezado
GOTO TOP
LOCATE FOR mirepor.objtype=5 AND mirepor.Vpos=0
*
miV = mirepor.Vpos + mirepor.HEIGHT
*
APPEND BLANK IN mirepor
REPLACE mirepor.objtype WITH 6
REPLACE mirepor.Vpos WITH miV
REPLACE mirepor.WIDTH WITH miW
REPLACE mirepor.HEIGHT WITH 105
REPLACE mirepor.penpat WITH 8
REPLACE mirepor.supalways WITH .T.
REPLACE mirepor.platform WITH 'WINDOWS'
*
* Mover todo hacia abajo, para colocar titulo
IF !EMPTY(cTitulo)
  *
  extra = 4000 && Altura para el titulo
  GOTO TOP
  REPLACE ALL Vpos WITH Vpos + extra FOR INLIST(objtype, 5, 6, 8) IN mirepor
  REPLACE ALL HEIGHT WITH HEIGHT + extra FOR objcode = 1 IN mirepor
  *
  * Añadir Titulo
  APPEND BLANK IN mirepor
  REPLACE mirepor.platform WITH 'WINDOWS'
  REPLACE mirepor.objtype WITH 5
  REPLACE mirepor.hpos WITH 100
  REPLACE mirepor.fontface WITH cFont
  REPLACE mirepor.fontstyle WITH 4
  REPLACE mirepor.FONTSIZE WITH 16
  REPLACE mirepor.WIDTH WITH 70000
  REPLACE mirepor.HEIGHT WITH 2800
  REPLACE mirepor.supalways WITH .T.
  REPLACE mirepor.EXPR WITH ["&cTitulo"]
  REPLACE mirepor.mode WITH 1
  *
ENDIF
*
* Ajustar 'labels' columnas segun version VFP
REPLACE ALL mirepor.Vpos WITH mirepor.Vpos - sExtra FOR mirepor.objtype=5 AND mirepor.Vpos = extra
*
DELETE ALL FOR objtype = 26 IN mirepor
PACK
*
USE IN mirepor
*
* Mandar impresion
oForm = CREATEOBJECT("Form")
WITH oForm
  .CAPTION = "Vista Previa "
  .WINDOWTYPE = 1
  .WIDTH = _SCREEN.WIDTH - 16
  .HEIGHT = _SCREEN.HEIGHT - 16
  *
  SELECT &cCursor
  GOTO TOP
  REPORT FORM (cRepo) PREVIEW WINDOW (.NAME)
  REPORT FORM (cRepo) TO PRINTER PROMPT NOCONSOLE NOEJECT
  *
  .RELEASE()
ENDWITH
*
* Borrar Report autogenerado
DELETE FILE (JUSTSTEM(cRepo) + '.frx')
DELETE FILE (JUSTSTEM(cRepo) + '.frt')
*
RETURN

Jose Antonio Blasco