Autogenerar Report Mejorando Presentación (II)

Hace ya tiempo que publiqué un primer articulo con este nombre, que permitía la generación de un informe de forma automática (sin plantilla) tomando como origen un cursor o tabla con los datos a mostrar.

Estaba pensado para aquellas ocasiones en que necesitaríamos realizar un listado sencillo, sin grupos ni totales, pero hasta el punto de diseñar un informe específico.

Sólo era capaz de realizarlo en orientación "Vertical", lo que limitaba la cantidad de información que podía mostrar.

Bien, pues ya lo he conseguido, con el único inconveniente de que su uso queda limitado a VFP9 por las funciones utilizadas.

Espero que os sirva de ayuda.

Este el el código:

[ACTUALIZADO EL 16 DE MARZO DE 2016]

******************************************************************************
* Autogeneracion de un listado (report rapido) partiendo de un cursor o tabla.
* Se autoajusta fuente, tamaño y nº de columnas a mostrar
* Vers: 1.6
******************************************************************************
* Parametros:  cCursor    --> Nombre del cursor/tabla origen
*        cTitulo   --> Titulo para el listado
*        lNoRepite --> (.F./.T.)   No repetir 1er.campo
*        nType     --> Tipo Salida (sólo FoxyPreviewer)
*                              0 -> Vista Previa (default)
*                             10 -> PDF
*                             11 -> PDF como imagen
*                             12 -> RTF
*                             13 -> XLS
*                             14 -> HTML
*                             15 -> HTML Simple
*                             20 -> Automático (por extensión --> cDestino)
*
*        lRetorno  --> (.F./.T.) Devolver nombre del report generado
*                             sin borrarlo, para su uso posterior
*         cDestino  --> Archivo a exportar con extensión (solo TYPE 20):
*                             "PDF","RTF","DOC","XLS","XML","HTM","HTML","MHT",
*                             "BMP","GIF","JPG","JPEG","TIF","TIFF","PNG","EMF"
*        lOrienta  --> (.F./.T.) Forzar orientación horizontal
******************************************************************************
* NOTAS:
*
* Se hacen coincidir los valores de 'nType' con OBJECT TYPE de FoxyPreviewer
*
* Si el nuevo parámetro 'lRetorno'=.T., sólo generará el report, sin mostrarlo,
* y se devuelve el nombre de dicho report. Habrá que borrarlo posteriormente.
******************************************************************************
*
* Ej.  Do autorepo with "micursor", "Titulo del Listado",.F.,15,.F.
*
******************************************************************************
LPARAMETERS cCursor, cTitulo, lNoRepite, nType, lRetorno, cDestino, lOrienta
*
LOCAL cRepo, cFile, nLong, sFont, cFont, cCampos, nMaxCol
LOCAL sExtra, nOrientation, nOriginal, nVersion, CampoUno

cRepo = SYS(2015) + '.frx'

IF VARTYPE(cCursor) # 'C'
  WAIT WINDOW "Faltan Datos"
  RETURN
ENDIF

IF VARTYPE(cTitulo) # 'C'
  cTitulo = cCursor
ENDIF

IF lRetorno = .T.
  nType = 0
  cDestino = ''
ENDIF

IF VARTYPE(nType) # 'N'
  nType = 0
ENDIF

IF VARTYPE(cDestino) # 'C'
  cDestino = ''
  IF nType = 20
    nType = 1
  ENDIF
ELSE
  IF EMPTY(cDestino)
    cDestino = cCursor
  ENDIF
ENDIF

nOrientation = 0
IF lOrienta = .T.
  nOrientation = 1
ENDIF

DO CASE
  CASE INLIST(nType, 10,11)
    cFile = FORCEEXT(cDestino,'pdf')

  CASE nType = 12
    cFile = FORCEEXT(cDestino,'rtf')

  CASE nType = 13
    cFile = FORCEEXT(cDestino,'xls')

  CASE INLIST(nType, 14,15)
    cFile = FORCEEXT(cDestino,'html')

  CASE INLIST(nType, 20)
    IF INLIST(JUSTEXT(cDestino),"PDF","RTF","DOC","XLS","XML","HTM","HTML","MHT","BMP","GIF","JPG","JPEG","TIF","TIFF","PNG","EMF")
      cFile = ALLTRIM(cDestino)
    ELSE
      nType = 1
      cDestino = ''
      cFile = ''
    ENDIF

  OTHERWISE
    nType = 1
    cDestino = ''
    cFile = ''
ENDCASE

cFile =LOWER(cFile)

nVersion = INT(VERSION(5) / 100)

cFont = 'Times New Roman'  && Fuente de letra a usar
*
nMaxCol = 225        && Nº máximo de columnas (depende de fuente)
IF nVersion = 9
  nMaxCol = 315
ENDIF
*
nLong = 0
cCampos = ''
nOriginal = PRTINFO(1)
*
* Establecer anchura, limites y tamaño fuente
nCampos = AFIELDS(aCampos, cCursor)
FOR xx = 1 TO nCampos
  *
  IF xx = 1
    CampoUno = LOWER(ALLTRIM(aCampos(xx,1)))
  ENDIF
  *
  IF nLong  + aCampos(xx, 3) > nMaxCol
    *
    cTitulo = cTitulo + '    ***'
    EXIT
    *
  ELSE
    IF EMPTY(cCampos)
      cCampos = cCampos + aCampos(xx,1)
    ELSE
      cCampos = cCampos + ', ' +aCampos(xx,1)
    ENDIF
    *
    nLong = nLong + aCampos(xx, 3) + 8
    *
  ENDIF
ENDFOR

IF nVersion = 9
  * Establecer orientación necesaria
  IF nOrientation = 0
    IF nLong > 225
      nOrientation = 1
    ELSE
      nMaxCol = 225
    ENDIF
  ENDIF
  * Comprobar y cambiar orientacion si procede
  IF nOriginal <> nOrientation
    CambiarOrientacion(nOrientation)
  ENDIF
ENDIF

*   'sFont' fuente según nº caracteres por linea
*   'sExtra' retroceso vertical para titulos columnas
DO CASE
  CASE nLong > nMaxCol - 35
    sFont = 7
    sExtra = 120

  CASE nLong > nMaxCol - 65
    sFont = 8
    sExtra = 200

  CASE nLong > nMaxCol - 95
    sFont = 9
    sExtra = 360

  OTHERWISE
    sFont = 10
    sExtra = 450

ENDCASE

* Crear report
nReport = 80
IF nVersion = 9
  nReport = SET("ReportBehavior")
  SET Reportbehavior 80
ENDIF
CREATE REPORT (cRepo) FROM DBF(cCursor) FIELDS &cCampos COLUMN WIDTH nLong
IF nVersion = 9
  SET Reportbehavior nReport
ENDIF

* Abrir report como fichero
USE (cRepo) IN 0 ALIAS mirepor EXCL
SELECT mirepor

* Evitar Repetición 1er.campo si así se pidió
IF lNoRepite = .T.
  GOTO TOP
  LOCATE FOR LOWER(ALLTRIM(EXPR)) = CampoUno AND ObjType = 8
  IF !EOF()
    REPLACE Supalways WITH .F.
    REPLACE Supovflow WITH .T.
    REPLACE Suprpcol WITH 3
    REPLACE Supgroup WITH 0
    REPLACE Supvalchng WITH .T.
    REPLACE FontStyle WITH 1
  ENDIF
  GOTO TOP
ENDIF
*
* 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, 1, 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 MIN(sFont - 1,8)  FOR ObjType = 8

* Cambiar tamaño fuente y estilo para 'labels' y 'campos' del pie de pagina
REPLACE FONTSIZE WITH MAX(sFont - 2,8), FontStyle WITH 3 FOR ALLTRIM(EXPR) = [DATE()] IN mirepor
REPLACE FONTSIZE WITH MAX(sFont - 2,8), FontStyle WITH 3 FOR ALLTRIM(EXPR) = ["Página "] IN mirepor
REPLACE FONTSIZE WITH MAX(sFont - 2,8), FontStyle WITH 3 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 7
REPLACE mirepor.objcode WITH 4
REPLACE mirepor.Vpos WITH miV
REPLACE mirepor.WIDTH WITH miW
REPLACE mirepor.HEIGHT WITH 300
REPLACE mirepor.penred WITH -1
REPLACE mirepor.pengreen WITH -1
REPLACE mirepor.penblue WITH -1
REPLACE mirepor.fillred WITH 192
REPLACE mirepor.fillgreen WITH 192
REPLACE mirepor.fillblue WITH 192
REPLACE mirepor.pensize WITH 1
REPLACE mirepor.fillpat WITH 1
REPLACE mirepor.TOP WITH .F.
REPLACE mirepor.Supalways WITH .T.
REPLACE mirepor.offset WITH 16
REPLACE mirepor.Suprpcol WITH 3
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 - 100
*
APPEND BLANK IN mirepor
REPLACE mirepor.ObjType WITH 7
REPLACE mirepor.objcode WITH 4
REPLACE mirepor.Vpos WITH miV
REPLACE mirepor.WIDTH WITH miW
REPLACE mirepor.HEIGHT WITH 300
REPLACE mirepor.penred WITH -1
REPLACE mirepor.pengreen WITH -1
REPLACE mirepor.penblue WITH -1
REPLACE mirepor.fillred WITH 192
REPLACE mirepor.fillgreen WITH 192
REPLACE mirepor.fillblue WITH 192
REPLACE mirepor.pensize WITH 1
REPLACE mirepor.fillpat WITH 1
REPLACE mirepor.TOP WITH .F.
REPLACE mirepor.Supalways WITH .T.
REPLACE mirepor.offset WITH 16
REPLACE mirepor.Suprpcol WITH 3
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, 7, 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
  *
  REPLACE mirepor.Suprpcol WITH 3
  REPLACE mirepor.penred WITH -1
  REPLACE mirepor.pengreen WITH -1
  REPLACE mirepor.penblue WITH -1
  REPLACE mirepor.fillred WITH -1
  REPLACE mirepor.fillgreen WITH -1
  REPLACE mirepor.fillblue 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
*
IF lRetorno = .F.

  IF VARTYPE(_SCREEN.oFoxyPreviewer) = 'O'
    *
    IF nReport = 80
      SET Reportbehavior 90
    ENDIF
    *
    _SCREEN.oFoxyPreviewer.cTitle = 'Vista Previa'
    _SCREEN.oFoxyPreviewer.lExpandFields = .T.
    _SCREEN.oFoxyPreviewer.lPDFEmbedFonts = .T.
    _SCREEN.oFoxyPreviewer.cPDFSymbolFontsList = 'Wingdings 2'
    _SCREEN.oFoxyPreviewer.cPDFDefaultFont = 'Times New Roman'
    _SCREEN.oFoxyPreviewer.cSaveDefName = cTitulo
    *
    SELECT &cCursor
    GOTO TOP
    *
    IF nType < 10
      REPORT FORM (cRepo) OBJECT TYPE nType
    ELSE
      REPORT FORM (cRepo) OBJECT TYPE nType TO FILE &cFile PREVIEW
    ENDIF
    *
    IF nReport = 80
      SET Reportbehavior nReport
    ENDIF
    *
  ELSE
    *
    nType = 0
    *
    oFormObj = ""
    IF _SCREEN.FORMCOUNT > 0
      *
      FOR vv = 1 TO _SCREEN.FORMCOUNT
        IF _SCREEN.FORMS(vv).SHOWWINDOW = 2
          oFormObj = "Window (_Screen.Forms(vv).Name)"
          EXIT
        ENDIF
      ENDFOR
    ENDIF
    *
    oForm = CREATEOBJECT("Form")
    WITH oForm
      *
      .CAPTION = "Vista Previa"
      .WINDOWTYPE = 1

      MOUSE DBLCLICK AT .CURRENTX + 1, .CURRENTY + 5
      *
      SELECT &cCursor
      GOTO TOP
      *
      REPORT FORM (cRepo) TO PRINTER PROMPT NOCONSOLE NOEJECT PREVIEW WINDOW (.NAME)
      *
      .RELEASE()
      *
    ENDWITH
    *
  ENDIF
  *
  * Borrar Report autogenerado
  *
  DELETE FILE (JUSTSTEM(cRepo) + '.frx')
  DELETE FILE (JUSTSTEM(cRepo) + '.frt')
  cRepo = ''
  *
ENDIF

* Comprobar y establecer orientacion original si procede
IF nVersion = 9
  IF nOriginal <> nOrientation
    CambiarOrientacion(nOriginal)
  ENDIF
ENDIF

RETURN cRepo


*************
* Funciones *
*************
FUNCTION CambiarOrientacion
  LPARAMETERS nValor
  LOCAL cValor1, cValor2
  *
  cValor1=[ORIENTATION=0]
  cValor2=[ORIENTATION=1]
  IF nValor = 0
    cValor1=[ORIENTATION=1]
    cValor2=[ORIENTATION=0]
  ENDIF
  *

  CREATE CURSOR mytemp (nulo c(1))
  *
  cRepo2 = SYS(2015)+'.frx'
  * Crear un report temporal para cambiar orientacion
  CREATE REPORT (cRepo2) FROM DBF('mytemp') FIELDS nulo COLUMN WIDTH 256
  *
  *
  USE (cRepo2) IN 0 ALIAS mytempfrx EXCL
  SELECT mytempfrx
  *
  GOTO TOP
  REPLACE mytempfrx.EXPR WITH STRTRAN(mytempfrx.EXPR,cValor1,cValor2)
  *
  SYS(1037,3)
  *
  * Eliminar cursor y reports temporales
  *
  USE IN SELECT('mytempfrx')
  USE IN SELECT('mytemp')
  *
  DELETE FILE (JUSTSTEM(cRepo2) + '.frx')
  DELETE FILE (JUSTSTEM(cRepo2) + '.frt')
  *
ENDFUNC

Un saludo a todos.

Jose Antonio Blasco