topic-46687

Board index FiveWin para Harbour/xHarbour REPORT: Vía Inteligencia Artificial.

Posts: 8716

Joined: Tue Dec 20, 2005 07:36 PM

REPORT: Vía Inteligencia Artificial.

Posted: Mon Sep 14, 2026 03:12 PM

¿Respuesta de Bionic o DeepSeek? No recuerdo.

Good morning, Master Antônio. Please, where did the AI ?? Get this report model using TREPORT? I think it looks great, but it doesn't work. Is it possible to do this in the new versions of FiveWin?

Buenos días, Maestro Antônio. Por favor, ¿de dónde sacó la INTELIGENCIA ARTIFICIAL este modelo de informe con TREPORT? Me parece precioso, pero no funciona. ¿Es posible hacer esto en las nuevas versiones de FIVEWIN?

Code: Select all Collapse

// =============================================================================
// RELVET.PRG - Relatorios e Carteira do Veterinario
// TReport (FiveWin) + impressao de carteira/carteirinha completa
// =============================================================================

#include "FiveWin.ch"
#include "Treport.ch"

//-----------------------------------------------------------------------------
// Relatorio de Veterinarios em TReport

FUNCTION RelVeterinarios()

   LOCAL oReport, oSection

   DEFINE REPORT oReport TITLE "Relacao de Veterinarios" ;
      PREVIEW

   DEFINE SECTION oSection OF oReport

   DEFINE HEADER OF oSection TITLE "PetVet 1.0 - Relacao de Veterinarios" ;
      FONT "Arial" SIZE 12 BOLD

   DEFINE FOOTER OF oSection ;
      EXPRESSION "Pagina " + Str( oReport:nPage, 4 ) FONT "Arial" SIZE 8

   // Colunas do relatorio
   DEFINE COLUMN OF oSection TITLE "Codigo"        WIDTH 10 ;
      EXPRESSION { || VET->CODIGO } ALIGN DT_CENTER

   DEFINE COLUMN OF oSection TITLE "Nome"          WIDTH 32 ;
      EXPRESSION { || VET->NOME }

   DEFINE COLUMN OF oSection TITLE "CRMV"          WIDTH 12 ;
      EXPRESSION { || VET->CRMV } ALIGN DT_CENTER

   DEFINE COLUMN OF oSection TITLE "Especialidade" WIDTH 22 ;
      EXPRESSION { || VET->ESPECIALIDADE }

   DEFINE COLUMN OF oSection TITLE "CPF"          WIDTH 14 ;
      EXPRESSION { || VET->CPF } ALIGN DT_CENTER

   DEFINE COLUMN OF oSection TITLE "RG"           WIDTH 12 ;
      EXPRESSION { || VET->RG } ALIGN DT_CENTER

   DEFINE COLUMN OF oSection TITLE "Admissao"     WIDTH 11 ;
      EXPRESSION { || DToC( VET->ADMISSAO ) } ALIGN DT_CENTER

   DEFINE COLUMN OF oSection TITLE "Demissao"     WIDTH 11 ;
      EXPRESSION { || DToC( VET->DEMISSAO ) } ALIGN DT_CENTER

   DEFINE COLUMN OF oSection TITLE "Salario"      WIDTH 12 ;
      EXPRESSION { || Transform( VET->SALARIO, "@E 999,999.99" ) } ALIGN DT_RIGHT

   DEFINE COLUMN OF oSection TITLE "Ativo"        WIDTH 8 ;
      EXPRESSION { || If( VET->ATIVO, "Sim", "Nao" ) } ALIGN DT_CENTER

   DEFINE COLUMN OF oSection TITLE "Cidade/UF"    WIDTH 18 ;
      EXPRESSION { || AllTrim( VET->CIDADE ) + "/" + VET->UF }

   SELECT VET

   VET->( dbGoTop() )

   DO WHILE ! VET->( Eof() )

  oReport:PrintSection( oSection ) // ???????? Show()!!

  VET->( dbSkip() )

   ENDDO

   oReport:End()

RETURN NIL

Gracias, tks.

Regards, saludos

João Santos - São Paulo - Brasil - Phone: +55(11)95150-7341

Antonio Linares

Posts: 44508

Joined: Thu Oct 06, 2005 05:47 PM

Re: REPORT: Vía Inteligencia Artificial.

Posted: Mon Sep 14, 2026 04:14 PM

relvet.prg

Code: Select all Collapse

//=============================================================================
// RELVET.PRG - PetVet 1.0 : Relacao de Veterinarios
//  1) Sintaxis nativa FWH : REPORT/COLUMN/GROUP + ACTIVATE (RelVeterinariosFW)
//  2) Sintaxis estilo DEFINE SECTION : mini-motor SecReport/SecSection sobre
//     TPrinter, definido con #xcommand en ESTE mismo fichero (RelVeterinarios)
//  3) Carteirinha do Veterinario con TPrinter directo, 86 x 54 mm (CardVet)
// (ver samples/report/rep05.prg, rep10.prg, rep22.prg, misc/label.prg)
//=============================================================================
#include "FiveWin.ch"
#include "report.ch"

REQUEST DBFCDX

//-----------------------------------------------------------------------------
// Compatibilidad con sintaxis estilo "DEFINE SECTION" (TReport de otros xBase)
// Mini-motor implementado con TPrinter: columnas alineadas con clip (CmSay +
// nWidth + nPad), paginacion con header/footer, apaisado automatico.
// NOTA: los #xcommand van despues de los #include para prevalecer sobre el
// "DEFINE COLUMN" de tcbrowse.ch. DBF limita los campos a 10 caracteres, por
// eso ESPECIALIDADE se llama ESPEC en VET.DBF.
//-----------------------------------------------------------------------------
#ifndef DT_LEFT
#define DT_LEFT   0
#define DT_CENTER 1
#define DT_RIGHT  2
#endif

#xcommand DEFINE REPORT <oRpt> TITLE <cTitle> [<prv:PREVIEW>] => ;
   <oRpt> := SecReport():New( <cTitle>, <.prv.> )

#xcommand DEFINE SECTION <oSec> OF <oRpt> => ;
   <oSec> := <oRpt>:AddSection()

#xcommand DEFINE HEADER OF <oSec> TITLE <cTitle> ;
      [FONT <cFont>] [SIZE <nSize>] [<bld:BOLD>] => ;
   <oSec>:SetHeader( <cTitle>, <cFont>, <nSize>, <.bld.> )

#xcommand DEFINE FOOTER OF <oSec> EXPRESSION <bExpr> ;
      [FONT <cFont>] [SIZE <nSize>] => ;
   <oSec>:SetFooter( <{bExpr}>, <cFont>, <nSize> )

#xcommand DEFINE COLUMN OF <oSec> TITLE <cTitle> WIDTH <nWidth> ;
      EXPRESSION <bExpr> [ALIGN <nAlign>] => ;
   <oSec>:AddColumn( <cTitle>, <nWidth>, <{bExpr}>, [<nAlign>] )

STATIC oRpt

//----------------------------------------------------------------------------//
FUNCTION Main()

   LOCAL oWnd

   // Modo autotest sin GUI: relvet.exe /testsec -> secselftest.log
   IF hb_argc() >= 1 .AND. ValType( hb_argv( 1 ) ) == "C" .AND. ;
      "/testsec" $ Lower( hb_argv( 1 ) )
      MakeVetDbf()
      SecSelfTest()
      QUIT
   ENDIF

   MakeVetDbf()

   DEFINE WINDOW oWnd TITLE "PetVet 1.0 - Veterinarios" ;
      FROM 4, 8 TO 20, 74

   @ 2, 4 BUTTON "&Listado FW" SIZE 110, 28 OF oWnd ;
      ACTION RelVeterinariosFW()

   @ 2, 20 BUTTON "Listado &DEFINE" SIZE 110, 28 OF oWnd ;
      ACTION RelVeterinarios()

   @ 2, 36 BUTTON "&Carteirinha" SIZE 110, 28 OF oWnd ;
      ACTION CardVet( NIL )

   @ 5, 4 SAY "Listado FW: TReport nativo (preview, total salario, grupo UF)" OF oWnd
   @ 6, 4 SAY "Listado DEFINE: sintaxis DEFINE SECTION via SecReport+TPrinter" OF oWnd
   @ 7, 4 SAY "Carteirinha: TPrinter frente+verso 86x54mm" OF oWnd

   ACTIVATE WINDOW oWnd

RETURN NIL

//----------------------------------------------------------------------------//
// Crea VET.DBF de demostracion si no existe (autocontenido)
STATIC FUNCTION MakeVetDbf()

   LOCAL aStruct := { ;
      { "CODIGO",  "C",  6, 0 }, ;
      { "NOME",    "C", 40, 0 }, ;
      { "CRMV",    "C", 12, 0 }, ;
      { "ESPEC",   "C", 25, 0 }, ;
      { "CPF",     "C", 14, 0 }, ;
      { "RG",      "C", 12, 0 }, ;
      { "ADMISSAO","D",  8, 0 }, ;
      { "DEMISSAO","D",  8, 0 }, ;
      { "SALARIO", "N", 10, 2 }, ;
      { "ATIVO",   "L",  1, 0 }, ;
      { "CIDADE",  "C", 25, 0 }, ;
      { "UF",      "C",  2, 0 } }

   IF ! File( "vet.dbf" )
      DBCREATE( "vet.dbf", aStruct, "DBFCDX" )
   ENDIF

   USE VET NEW VIA "DBFCDX"

   IF VET->( RecCount() ) == 0
      AddVet( "000001", "Ana Souza",      "CRMV-SP 1234", "Clinica geral",  "111.222.333-44", "12.345.678-9", CToD( "10/01/2020" ), CToD( "" ),           8500.00, .T., "Sao Paulo",      "SP" )
      AddVet( "000002", "Bruno Lima",     "CRMV-RJ 5678", "Cirurgia",       "222.333.444-55", "23.456.789-0", CToD( "05/03/2019" ), CToD( "" ),          12300.50, .T., "Rio de Janeiro",   "RJ" )
      AddVet( "000003", "Carla Menezes",  "CRMV-MG 9012", "Dermatologia",   "333.444.555-66", "34.567.890-1", CToD( "12/06/2021" ), CToD( "" ),           9200.00, .T., "Belo Horizonte",   "MG" )
      AddVet( "000004", "Diego Ramos",    "CRMV-SP 3456", "Oftalmologia",   "444.555.666-77", "45.678.901-2", CToD( "01/02/2018" ), CToD( "30/06/2024" ), 11000.00, .F., "Campinas",         "SP" )
      AddVet( "000005", "Elisa Prado",    "CRMV-PR 7890", "Cardiologia",    "555.666.777-88", "56.789.012-3", CToD( "20/09/2022" ), CToD( "" ),           13500.75, .T., "Curitiba",         "PR" )
      AddVet( "000006", "Fabio Teixeira", "CRMV-RJ 2345", "Ortopedia",      "666.777.888-99", "67.890.123-4", CToD( "15/04/2023" ), CToD( "" ),           7800.00, .T., "Niteroi",          "RJ" )
   ENDIF

   CLOSE VET

RETURN NIL

STATIC FUNCTION AddVet( cCod, cNome, cCrmv, cEspec, cCpf, cRg, dAdm, dDem, nSal, lAtivo, cCid, cUf )

   APPEND BLANK
   VET->CODIGO   := cCod
   VET->NOME     := cNome
   VET->CRMV     := cCrmv
   VET->ESPEC    := cEspec
   VET->CPF      := cCpf
   VET->RG       := cRg
   VET->ADMISSAO := dAdm
   VET->DEMISSAO := dDem
   VET->SALARIO  := nSal
   VET->ATIVO    := lAtivo
   VET->CIDADE   := cCid
   VET->UF       := cUf

RETURN NIL

//----------------------------------------------------------------------------//
// 1) LISTADO con TReport FWH (sintaxis REPORT/COLUMN/GROUP + ACTIVATE)
FUNCTION RelVeterinariosFW()

   LOCAL oFont1, oFont2

   DEFINE FONT oFont1 NAME "ARIAL" SIZE 0, -9
   DEFINE FONT oFont2 NAME "ARIAL" SIZE 0, -9 BOLD

   USE VET NEW SHARED VIA "DBFCDX"
   VET->( dbGoTop() )

   REPORT oRpt ;
      TITLE  "PetVet 1.0 - Relacao de Veterinarios", ;
             "Data: " + DToC( Date() ) ;
      FONT oFont1, oFont2 ;
      HEADER "CRMV / Cadastro" RIGHT ;
      FOOTER "Pagina: " + Str( oRpt:nPage, 3 ) CENTERED ;
      PREVIEW

   COLUMN TITLE "Codigo" DATA VET->CODIGO SIZE 8 CENTER
   COLUMN TITLE "Nome"   DATA VET->NOME SIZE 26
   COLUMN TITLE "CRMV"   DATA VET->CRMV SIZE 12 CENTER
   COLUMN TITLE "Especialidade" DATA VET->ESPEC SIZE 18
   COLUMN TITLE "Admissao" DATA VET->ADMISSAO PICTURE "99/99/99" SIZE 10 CENTER
   COLUMN TITLE "Salario" DATA VET->SALARIO ;
      PICTURE "999,999.99" SIZE 11 RIGHT TOTAL FONT 2
   COLUMN TITLE "Ativo" DATA If( VET->ATIVO, "Sim", "Nao" ) SIZE 6 CENTER
   COLUMN TITLE "Cidade/UF" DATA AllTrim( VET->CIDADE ) + "/" + VET->UF SIZE 18

   GROUP ON VET->UF ;
      HEADER "UF: " + VET->UF ;
      FOOTER "Total UF " + oRpt:aGroups[ 1 ]:cValue + ;
             " (" + LTrim( Str( oRpt:aGroups[ 1 ]:nCounter ) ) + ")" ;
      FONT 2

   END REPORT

   IF oRpt:lCreated
      oRpt:cGrandTotal := "Total geral..."
      oRpt:cPageTotal  := "Total pag...."
   ENDIF

   ACTIVATE REPORT oRpt ON STARTPAGE RepLogo()

   CLOSE VET

   oFont1:End()
   oFont2:End()

RETURN NIL

STATIC FUNCTION RepLogo()

   IF File( "..\bitmaps\fivewin.bmp" )
      oRpt:SayBitmap( .3, .3, "..\bitmaps\fivewin.bmp", .5, .5 )
   ENDIF

RETURN NIL

//----------------------------------------------------------------------------//
// 2) CARTEIRINHA con TPrinter directo (frente + verso, 86 x 54 mm)
//    cCodigo NIL = primer registro activo
FUNCTION CardVet( cCodigo )

   LOCAL oPrn, oFontN, oFontP, oFontS
   LOCAL nTop := 0.3, nLeft := 0.3
   LOCAL cLogo := "..\bitmaps\fivewin.bmp"
   LOCAL lLogo := File( cLogo )

   USE VET NEW SHARED VIA "DBFCDX"

   IF cCodigo != NIL
      VET->( dbGoTop() )
      DO WHILE ! VET->( Eof() ) .AND. VET->CODIGO != cCodigo
         VET->( dbSkip() )
      ENDDO
      IF VET->( Eof() )
         VET->( dbGoTop() )
      ENDIF
   ELSE
      VET->( dbGoTop() )
   ENDIF

   PRINTER oPrn FROM USER PREVIEW NAME "PetVet - Carteirinha"

   DEFINE FONT oFontN NAME "ARIAL" SIZE 0, -14 BOLD OF oPrn
   DEFINE FONT oFontP NAME "ARIAL" SIZE 0, -10 OF oPrn
   DEFINE FONT oFontS NAME "ARIAL" SIZE 0, -8 OF oPrn

   // --- FRENTE: foto + nombre + CRMV + especialidad ---
   oPrn:StartPage()
   oPrn:Box( nTop, nLeft, nTop + 2.1, nLeft + 3.3 )
   IF lLogo
      oPrn:SayBitmap( nTop + .1, nLeft + .1, cLogo, .4, .4 )
   ENDIF
   oPrn:Say( nTop + .15, nLeft + .65, "PetVet - CRMV", oFontN )
   // recuadro foto (si VET->FOTO existiera, usarlo aqui)
   oPrn:Box( nTop + .6, nLeft + .15, nTop + 1.4, nLeft + .8 )
   oPrn:Say( nTop + .95, nLeft + .2, "FOTO", oFontS )
   oPrn:Say( nTop + .6, nLeft + 1.0, AllTrim( VET->NOME ), oFontP )
   oPrn:Say( nTop + .9, nLeft + 1.0, "CRMV: " + AllTrim( VET->CRMV ), oFontP )
   oPrn:Say( nTop + 1.2, nLeft + 1.0, AllTrim( VET->ESPEC ), oFontS )
   oPrn:Say( nTop + 1.5, nLeft + 1.0, "Cod: " + VET->CODIGO + "  " + ;
      If( VET->ATIVO, "ATIVO", "INATIVO" ), oFontS )
   oPrn:EndPage()

   // --- VERSO: datos + firma ---
   oPrn:StartPage()
   oPrn:Box( nTop, nLeft, nTop + 2.1, nLeft + 3.3 )
   oPrn:Say( nTop + .2, nLeft + .2, "CPF: " + AllTrim( VET->CPF ) + ;
      "  RG: " + AllTrim( VET->RG ), oFontS )
   oPrn:Say( nTop + .5, nLeft + .2, "Admissao: " + DToC( VET->ADMISSAO ), oFontS )
   oPrn:Say( nTop + .8, nLeft + .2, "Cidade: " + AllTrim( VET->CIDADE ) + ;
      "/" + VET->UF, oFontS )
   oPrn:Say( nTop + 1.4, nLeft + .2, "Assinatura: ___________________", oFontS )
   oPrn:EndPage()

   oPrn:Preview()

   oFontN:End()
   oFontP:End()
   oFontS:End()

   CLOSE VET

RETURN NIL

//=============================================================================
// MINI-MOTOR SecReport/SecSection : ejecuta la sintaxis DEFINE SECTION sobre
// TPrinter (unidades en cm, tamano de pagina real, apaisado automatico).
//=============================================================================
CLASS SecSection
   DATA oRpt, cHead, cHeadFont, nHeadSize, lHeadBold
   DATA bFoot, cFootFont, nFootSize, aCols
   METHOD New( oRpt ) CONSTRUCTOR
   METHOD SetHeader( c, f, s, b )
   METHOD SetFooter( b, f, s )
   METHOD AddColumn( c, w, b, a )
ENDCLASS

METHOD New( oRpt ) CLASS SecSection
   ::oRpt      := oRpt
   ::aCols     := {}
   ::cHead     := ""
   ::cHeadFont := "ARIAL"
   ::nHeadSize := 12
   ::lHeadBold := .F.
   ::bFoot     := NIL
   ::cFootFont := "ARIAL"
   ::nFootSize := 8
RETURN Self

METHOD SetHeader( c, f, s, b ) CLASS SecSection
   ::cHead := c
   IF ValType( f ) == "C" .AND. ! Empty( f ) ; ::cHeadFont := f ; ENDIF
   IF ValType( s ) == "N" .AND. s > 0        ; ::nHeadSize := s ; ENDIF
   ::lHeadBold := ( ValType( b ) == "L" .AND. b )
RETURN Self

METHOD SetFooter( b, f, s ) CLASS SecSection
   ::bFoot := b
   IF ValType( f ) == "C" .AND. ! Empty( f ) ; ::cFootFont := f ; ENDIF
   IF ValType( s ) == "N" .AND. s > 0        ; ::nFootSize := s ; ENDIF
RETURN Self

METHOD AddColumn( c, w, b, a ) CLASS SecSection
   DEFAULT a := DT_LEFT
   AAdd( ::aCols, { c, Max( 1, w ), b, a } )
RETURN Self

//----------------------------------------------------------------------------//
CLASS SecReport
   DATA cTitle, lPreview, aSecs, nPage
   DATA oPrn, oFontBody, oFontBold, oFontTitle, oFontHead, oFontFoot
   DATA lOpen, oLastSec, lLand, nPtBody
   DATA nLeft, nTop, nBottom, nFootRow, nPrintW, nRow, nBodyH
   DATA aColX, aColW
   METHOD New( cTitle, lPreview ) CONSTRUCTOR
   METHOD AddSection()
   METHOD PrintSection( oSec )
   METHOD End()
   METHOD StartSheet( oSec )
   METHOD HeadSheet( oSec )
   METHOD FootSheet( oSec )
ENDCLASS

METHOD New( cTitle, lPreview ) CLASS SecReport
   ::cTitle   := cTitle
   ::lPreview := ( ValType( lPreview ) == "L" .AND. lPreview )
   ::aSecs    := {}
   ::nPage    := 0
   ::lOpen    := .F.
   ::oLastSec := NIL
RETURN Self

METHOD AddSection() CLASS SecReport
   AAdd( ::aSecs, SecSection():New( Self ) )
RETURN ATail( ::aSecs )

METHOD PrintSection( oSec ) CLASS SecReport
   LOCAL i, aCol, cTxt, nPad
   IF ! ::lOpen
      ::StartSheet( oSec )
   ENDIF
   IF ::nRow + ::nBodyH > ::nBottom
      ::FootSheet( oSec )
      ::oPrn:EndPage()
      ::oPrn:StartPage()
      ::nPage++
      ::HeadSheet( oSec )
   ENDIF
   FOR i := 1 TO Len( oSec:aCols )
      aCol := oSec:aCols[ i ]
      cTxt := SecCStr( SecEval( aCol[ 3 ] ) )
      nPad := SecPad( aCol[ 4 ] )
      ::oPrn:CmSay( ::nRow, ::aColX[ i ], cTxt, ::oFontBody, ;
                    ::aColW[ i ],,, nPad )
   NEXT
   ::nRow += ::nBodyH
   ::oLastSec := oSec
RETURN Self

METHOD StartSheet( oSec ) CLASS SecReport
   LOCAL aGeo, nPxBody, nPxTitle, nPxHead, nPxFoot, cHF
   PRINTER ::oPrn NAME ::cTitle PREVIEW
   aGeo := SecColWidths( oSec:aCols, 1.2, 0 )  // solo nTot para decidir
   ::lLand := ( aGeo[ 3 ] > 100 )
   IF ::lLand
      ::oPrn:SetLandscape()
   ENDIF
   ::nLeft   := 1.2
   ::nTop    := 1.2
   ::nPrintW := ::oPrn:PageWidth( "CM" ) - 2.4
   ::nBottom := ::oPrn:PageHeight( "CM" ) - 2.2
   ::nFootRow := ::oPrn:PageHeight( "CM" ) - 1.4
   ::nPtBody := Min( 9, Max( 6, Int( ::nPrintW * 10 / aGeo[ 3 ] / 0.20 ) ) )
   ::nBodyH  := ::nPtBody * 0.067
   aGeo := SecColWidths( oSec:aCols, ::nLeft, ::nPrintW )
   ::aColX := aGeo[ 1 ]
   ::aColW := aGeo[ 2 ]
   nPxBody  := -::nPtBody
   nPxTitle := -( ::nPtBody + 6 )
   cHF      := oSec:cHeadFont
   nPxHead  := -Max( 8, oSec:nHeadSize )
   nPxFoot  := -Max( 6, oSec:nFootSize )
   DEFINE FONT ::oFontBody  NAME "ARIAL" SIZE 0, nPxBody  OF ::oPrn
   DEFINE FONT ::oFontBold  NAME "ARIAL" SIZE 0, nPxBody  BOLD OF ::oPrn
   DEFINE FONT ::oFontTitle NAME "ARIAL" SIZE 0, nPxTitle BOLD OF ::oPrn
   IF oSec:lHeadBold
      DEFINE FONT ::oFontHead NAME cHF SIZE 0, nPxHead BOLD OF ::oPrn
   ELSE
      DEFINE FONT ::oFontHead NAME cHF SIZE 0, nPxHead OF ::oPrn
   ENDIF
   DEFINE FONT ::oFontFoot NAME "ARIAL" SIZE 0, nPxFoot OF ::oPrn
   ::oPrn:StartPage()
   ::nPage  := 1
   ::lOpen  := .T.
   ::nRow   := ::nTop
   ::HeadSheet( oSec )
RETURN Self

METHOD HeadSheet( oSec ) CLASS SecReport
   LOCAL i, aCol
   ::oPrn:CmSay( ::nRow, ::nLeft, ::cTitle, ::oFontTitle, ::nPrintW,,, 2 )
   ::nRow += 0.85
   IF ! Empty( oSec:cHead )
      ::oPrn:CmSay( ::nRow, ::nLeft, oSec:cHead, ::oFontHead, ::nPrintW,,, 2 )
      ::nRow += 0.70
   ENDIF
   FOR i := 1 TO Len( oSec:aCols )
      aCol := oSec:aCols[ i ]
      ::oPrn:CmSay( ::nRow, ::aColX[ i ], aCol[ 1 ], ::oFontBold, ;
                    ::aColW[ i ],,, SecPad( aCol[ 4 ] ) )
   NEXT
   ::nRow += 0.60
RETURN Self

METHOD FootSheet( oSec ) CLASS SecReport
   LOCAL cTxt := ""
   IF ValType( oSec:bFoot ) == "B"
      cTxt := SecCStr( SecEval( oSec:bFoot ) )
   ENDIF
   IF ! Empty( cTxt )
      ::oPrn:CmSay( ::nFootRow, ::nLeft, cTxt, ::oFontFoot, ::nPrintW,,, 2 )
   ENDIF
RETURN Self

METHOD End() CLASS SecReport
   IF ::lOpen
      IF ::oLastSec != NIL
         ::FootSheet( ::oLastSec )
      ENDIF
      ::oPrn:EndPage()
      ::oPrn:Preview()
      ::oFontBody:End()
      ::oFontBold:End()
      ::oFontTitle:End()
      ::oFontHead:End()
      ::oFontFoot:End()
      ::lOpen := .F.
   ENDIF
RETURN NIL

//----------------------------------------------------------------------------//
// Funciones puras del mini-motor (testeables sin impresora via /testsec)
STATIC FUNCTION SecEval( b )
   LOCAL u := Eval( b )
   IF ValType( u ) == "B"
      u := Eval( u )
   ENDIF
RETURN u

STATIC FUNCTION SecCStr( u )
   LOCAL c
   DO CASE
   CASE ValType( u ) == "C" ; c := u
   CASE ValType( u ) == "D" ; c := DToC( u )
   CASE ValType( u ) == "N" ; c := LTrim( Str( u ) )
   CASE ValType( u ) == "L" ; c := If( u, "Sim", "Nao" )
   CASE ValType( u ) == "B" ; c := SecCStr( Eval( u ) )
   OTHERWISE                 ; c := ""
   ENDCASE
RETURN c

STATIC FUNCTION SecPad( nAlign )
   LOCAL aP := { 0, 2, 1 }  // DT_LEFT->PAD_LEFT, DT_CENTER->PAD_CENTER, DT_RIGHT->PAD_RIGHT
   DEFAULT nAlign := DT_LEFT
RETURN aP[ Min( Max( nAlign, 0 ), 2 ) + 1 ]

// aX/aW en cm + nTot ; nPrintW=0 -> solo calcula nTot (sin impresora)
STATIC FUNCTION SecColWidths( aCols, nLeft, nPrintW )
   LOCAL aX := {}, aW := {}, nTot := 0, i, nX, nW
   FOR i := 1 TO Len( aCols )
      nTot += aCols[ i ][ 2 ]
   NEXT
   nTot := Max( nTot, 1 )
   nX := nLeft
   FOR i := 1 TO Len( aCols )
      nW := nPrintW * aCols[ i ][ 2 ] / nTot
      AAdd( aX, nX )
      AAdd( aW, nW - 0.06 )
      nX += nW
   NEXT
RETURN { aX, aW, nTot }

// Autotest headless: relvet.exe /testsec -> secselftest.log
STATIC FUNCTION SecSelfTest()
   LOCAL h, nOk := 0, nFail := 0, aGeo, nSum, i
   h := FCreate( "secselftest.log" )
   IF h < 0
      RETURN .F.
   ENDIF
   FWrite( h, "SecSelfTest PetVet" + hb_eol() )
   SecTst( h, @nOk, @nFail, "CStr-C",      SecCStr( "abc" ), "abc" )
   SecTst( h, @nOk, @nFail, "CStr-N",      SecCStr( 1500.5 ), LTrim( Str( 1500.5 ) ) )
   SecTst( h, @nOk, @nFail, "CStr-D",      SecCStr( CToD( "10/01/2020" ) ), "10/01/2020" )
   SecTst( h, @nOk, @nFail, "CStr-L-T",    SecCStr( .T. ), "Sim" )
   SecTst( h, @nOk, @nFail, "CStr-L-F",    SecCStr( .F. ), "Nao" )
   SecTst( h, @nOk, @nFail, "CStr-NIL",    SecCStr( NIL ), "" )
   SecTst( h, @nOk, @nFail, "Eval-1",      SecEval( { || 1 + 1 } ), 2 )
   SecTst( h, @nOk, @nFail, "Eval-2",      SecEval( { || { || "X" } } ), "X" )
   SecTst( h, @nOk, @nFail, "Pad-L",       SecPad( DT_LEFT ), 0 )
   SecTst( h, @nOk, @nFail, "Pad-C",       SecPad( DT_CENTER ), 2 )
   SecTst( h, @nOk, @nFail, "Pad-R",       SecPad( DT_RIGHT ), 1 )
   SecTst( h, @nOk, @nFail, "Pad-def",     SecPad( NIL ), 0 )
   aGeo := SecColWidths( { { "A", 10, NIL, 0 }, { "B", 30, NIL, 0 } }, 1.2, 20.0 )
   SecTst( h, @nOk, @nFail, "Geo-nTot",    aGeo[ 3 ], 40 )
   SecTst( h, @nOk, @nFail, "Geo-x1",      aGeo[ 1 ][ 1 ], 1.2 )
   nSum := 0
   FOR i := 1 TO Len( aGeo[ 2 ] ) ; nSum += aGeo[ 2 ][ i ] + 0.06 ; NEXT
   SecTst( h, @nOk, @nFail, "Geo-suma",    Abs( nSum - 20.0 ) < 0.001, .T. )
   SecTst( h, @nOk, @nFail, "Geo-x2",      aGeo[ 1 ][ 2 ], 1.2 + 20.0 * 10 / 40 )
   FWrite( h, "RESULT=" + If( nFail == 0, "PASS", "FAIL" ) + ;
      " ok=" + LTrim( Str( nOk ) ) + " fail=" + LTrim( Str( nFail ) ) + hb_eol() )
   FClose( h )
RETURN nFail == 0

STATIC FUNCTION SecTst( h, nOk, nFail, cName, uGot, uExp )
   LOCAL lOk := ( ValType( uGot ) == ValType( uExp ) .AND. uGot == uExp )
   IF lOk ; nOk++ ; ELSE ; nFail++ ; ENDIF
   FWrite( h, PadR( cName, 10 ) + "=" + If( lOk, "OK", "FAIL" ) + hb_eol() )
RETURN lOk

//-----------------------------------------------------------------------------
// 2) Relatorio de Veterinarios con sintaxis estilo DEFINE SECTION.
// Campos adaptados a VET.DBF (DBF = max 10 chars: ESPECIALIDADE -> ESPEC).
FUNCTION RelVeterinarios()

   LOCAL oReport, oSection

   USE VET NEW SHARED VIA "DBFCDX"

   DEFINE REPORT oReport TITLE "Relacao de Veterinarios" ;
      PREVIEW

   DEFINE SECTION oSection OF oReport

   DEFINE HEADER OF oSection TITLE "PetVet 1.0 - Relacao de Veterinarios" ;
      FONT "Arial" SIZE 12 BOLD

   DEFINE FOOTER OF oSection ;
      EXPRESSION "Pagina " + Str( oReport:nPage, 4 ) FONT "Arial" SIZE 8

   // Colunas do relatorio
   DEFINE COLUMN OF oSection TITLE "Codigo"        WIDTH 10 ;
      EXPRESSION { || VET->CODIGO } ALIGN DT_CENTER

   DEFINE COLUMN OF oSection TITLE "Nome"          WIDTH 32 ;
      EXPRESSION { || VET->NOME }

   DEFINE COLUMN OF oSection TITLE "CRMV"          WIDTH 12 ;
      EXPRESSION { || VET->CRMV } ALIGN DT_CENTER

   DEFINE COLUMN OF oSection TITLE "Especialidade" WIDTH 22 ;
      EXPRESSION { || VET->ESPEC }

   DEFINE COLUMN OF oSection TITLE "CPF"          WIDTH 14 ;
      EXPRESSION { || VET->CPF } ALIGN DT_CENTER

   DEFINE COLUMN OF oSection TITLE "RG"           WIDTH 12 ;
      EXPRESSION { || VET->RG } ALIGN DT_CENTER

   DEFINE COLUMN OF oSection TITLE "Admissao"     WIDTH 11 ;
      EXPRESSION { || DToC( VET->ADMISSAO ) } ALIGN DT_CENTER

   DEFINE COLUMN OF oSection TITLE "Demissao"     WIDTH 11 ;
      EXPRESSION { || DToC( VET->DEMISSAO ) } ALIGN DT_CENTER

   DEFINE COLUMN OF oSection TITLE "Salario"      WIDTH 12 ;
      EXPRESSION { || Transform( VET->SALARIO, "@E 999,999.99" ) } ALIGN DT_RIGHT

   DEFINE COLUMN OF oSection TITLE "Ativo"        WIDTH 8 ;
      EXPRESSION { || If( VET->ATIVO, "Sim", "Nao" ) } ALIGN DT_CENTER

   DEFINE COLUMN OF oSection TITLE "Cidade/UF"    WIDTH 18 ;
      EXPRESSION { || AllTrim( VET->CIDADE ) + "/" + VET->UF }

   SELECT VET

   VET->( dbGoTop() )

   DO WHILE ! VET->( Eof() )

  oReport:PrintSection( oSection )

  VET->( dbSkip() )

   ENDDO

   oReport:End()

   CLOSE VET

RETURN NIL

regards, saludos

Antonio Linares
www.fivetechsoft.com

karinha

Posts: 8716

Joined: Tue Dec 20, 2005 07:36 PM

Re: REPORT: Vía Inteligencia Artificial.

Posted: Mon Sep 14, 2026 04:17 PM

Master, Very good!! Voy probar! Super many thanks.

Regards, saludos.

João Santos - São Paulo - Brasil - Phone: +55(11)95150-7341

karinha

Posts: 8716

Joined: Tue Dec 20, 2005 07:36 PM

Re: REPORT: Vía Inteligencia Artificial.

Posted: Mon Sep 14, 2026 06:19 PM

ANTIGRAVITY escribe el código tal como yo lo hago y me gusta. ¿La ventaja? Busca donde tengo los ejemplos e imita mi forma de escribir. ¡Es genial! ¿El inconveniente? ¡Tarda mucho! Voy a probar OPENCODE, una recomendación de mi gran maestro: Antônio Liñares.

Code: Select all Collapse

// =============================================================================
// PROGRAMA: RELVETPRN.PRG
// SISTEMA : CADASTRO DE VETERINARIOS (FIVEWIN 26.03 / HARBOUR)
// FINALIDADE: RELATORIOS DE IMPRESSAO USANDO A CLASSE TPRINTER (TPRINTER.PRG)
// BANCO DE DADOS: C:\FWH2603\SAMPLES\VETERINA.DBF
// =============================================================================

#include "FiveWin.ch"
#include "Print.ch"

#define CLR_TITULO   RGB( 0, 51, 102 )    // Azul Escuro Institucional
#define CLR_SUBTIT   RGB( 70, 70, 70 )    // Cinza Escuro
#define CLR_FUNDO    RGB( 240, 243, 246 ) // Fundo cabecalho colunas
#define CLR_LINHA    RGB( 180, 190, 200 ) // Linhas divisorias

// -----------------------------------------------------------------------------
// Ponto de entrada para execucao direta / independente
// -----------------------------------------------------------------------------
FUNCTION Main()

   SET DATE BRITISH
   SET CENTURY ON
   SET EPOCH TO 1950
   SET DELETED ON

   // Abre o dialogo de opcoes do relatorio
   DlgOpcoesRelatorio()

RETURN NIL

// -----------------------------------------------------------------------------
// Dialogo de Parametros e Opcoes de Impressao
// -----------------------------------------------------------------------------
FUNCTION DlgOpcoesRelatorio()

   LOCAL oDlg, oFont, oFntBld, oFntTit
   LOCAL nTipoRel   := 1   // 1 = Sintetico (Paisagem), 2 = Ficha Analitica (Retrato)
   LOCAL nFiltro    := 1   // 1 = Todos, 2 = Somente Ativos, 3 = Somente Inativos
   LOCAL nOrdem     := 1   // 1 = Codigo, 2 = Nome, 3 = CRMV, 4 = Cidade
   LOCAL lPreview   := .T. // .T. = Preview, .F. = Impressao Direta
   LOCAL lExecutou  := .F.

   DEFINE FONT oFont   NAME "Segoe UI" SIZE 0, -12
   DEFINE FONT oFntBld NAME "Segoe UI" SIZE 0, -12 BOLD
   DEFINE FONT oFntTit NAME "Segoe UI" SIZE 0, -15 BOLD

   DEFINE DIALOG oDlg TITLE "Relatorios de Veterinarios - TPrinter" ;
      SIZE 440, 390 PIXEL TRUEPIXEL FONT oFont COLOR CLR_BLACK, RGB( 248, 250, 252 )

   // Titulo
   @ 15, 20 SAY "EMISSAO DE RELATORIOS - VETERINARIOS" ;
      SIZE 400, 24 PIXEL OF oDlg FONT oFntTit COLOR CLR_TITULO, RGB( 248, 250, 252 )

   @ 38, 20 SAY "Selecione o modelo, filtro e formato desejados:" ;
      SIZE 380, 18 PIXEL OF oDlg COLOR CLR_SUBTIT, RGB( 248, 250, 252 )

   // Grupo 1: Tipo de Relatorio
   @ 65, 20 GROUP TO 135, 420 PIXEL OF oDlg PROMPT " Modelo do Relatorio " ;
      FONT oFntBld COLOR CLR_TITULO, RGB( 248, 250, 252 )

   @ 85, 35 RADIO nTipoRel ;
      ITEMS "1. Relacao Geral Sintetica (Modo Paisagem / Formato Tabela)", ;
            "2. Ficha Cadastral Analitica (Modo Retrato / Ficha Detalhada)" ;
      SIZE 370, 20 PIXEL OF oDlg

   // Grupo 2: Filtro por Situacao
   @ 145, 20 GROUP TO 215, 420 PIXEL OF oDlg PROMPT " Situacao / Filtro " ;
      FONT oFntBld COLOR CLR_TITULO, RGB( 248, 250, 252 )

   @ 165, 35 RADIO nFiltro ;
      ITEMS "Todos os Cadastrados", ;
            "Apenas Veterinarios Ativos", ;
            "Apenas Veterinarios Inativos" ;
      SIZE 125, 20 PIXEL OF oDlg

   // Grupo 3: Ordenacao
   @ 225, 20 GROUP TO 285, 420 PIXEL OF oDlg PROMPT " Ordenacao dos Registros " ;
      FONT oFntBld COLOR CLR_TITULO, RGB( 248, 250, 252 )

   @ 245, 35 RADIO nOrdem ;
      ITEMS "Codigo", "Nome", "CRMV", "Cidade" ;
      SIZE 90, 20 PIXEL OF oDlg

   // Opcao de Visualizar na Tela (Preview)
   @ 295, 35 CHECKBOX lPreview PROMPT "Visualizar antes de imprimir (Preview)" ;
      SIZE 280, 20 PIXEL OF oDlg FONT oFntBld

   // Botoes
   @ 330, 110 BUTTON "&Imprimir" OF oDlg SIZE 100, 34 PIXEL ;
      FONT oFntBld ACTION ( lExecutou := .T., oDlg:End() )

   @ 330, 230 BUTTON "&Cancelar" OF oDlg SIZE 100, 34 PIXEL ;
      ACTION ( oDlg:End() )

   ACTIVATE DIALOG oDlg CENTERED

   oFont:End()
   oFntBld:End()
   oFntTit:End()

   IF lExecutou
      RelVeterinariosPrn( nTipoRel, nFiltro, nOrdem, lPreview )
   ENDIF

RETURN NIL

// -----------------------------------------------------------------------------
// Funcao Principal de Impressao com TPrinter
// -----------------------------------------------------------------------------
FUNCTION RelVeterinariosPrn( nTipoRel, nFiltro, nOrdem, lPreview )

   LOCAL cArqDbf := "C:\FWH2603\SAMPLES\VETERINA.DBF"
   LOCAL lCloseDbf := .F.

   DEFAULT nTipoRel := 1
   DEFAULT nFiltro  := 1
   DEFAULT nOrdem   := 1
   DEFAULT lPreview := .T.

   // Verifica e abre o DBF
   IF ! File( cArqDbf )
      cArqDbf := "VETERINA.DBF"
      IF ! File( cArqDbf )
         MsgStop( "Arquivo VETERINA.DBF nao localizado em C:\FWH2603\SAMPLES!", "Atencao" )
         RETURN NIL
      ENDIF
   ENDIF

   IF Select( "VET" ) == 0
      USE ( cArqDbf ) NEW SHARED ALIAS VET
      lCloseDbf := .T.
   ELSE
      SELECT VET
   ENDIF

   IF VET->( LastRec() ) == 0
      MsgAlert( "O cadastro de Veterinarios esta vazio!", "Aviso" )
      IF lCloseDbf
         VET->( dbCloseArea() )
      ENDIF
      RETURN NIL
   ENDIF

   // Dispara o modelo escolhido
   IF nTipoRel == 1
      ImprimeSintetico( nFiltro, nOrdem, lPreview )
   ELSE
      ImprimeAnalitico( nFiltro, nOrdem, lPreview )
   ENDIF

   IF lCloseDbf
      VET->( dbCloseArea() )
   ENDIF

RETURN NIL

// -----------------------------------------------------------------------------
// MODELO 1: RELACAO SINTETICA DE VETERINARIOS (PAISAGEM - A4 LANDSCAPE)
// -----------------------------------------------------------------------------
STATIC FUNCTION ImprimeSintetico( nFiltro, nOrdem, lPreview )

   LOCAL oPrn, oFontEmp, oFontTit, oFontCab, oFontSub, oFontDet, oFontBld, oFontRod
   LOCAL oPenLinha, oPenGrossa
   LOCAL nPagina := 0, nRow := 0, nLinhas := 0
   LOCAL nTotReg := 0, nTotAtivo := 0, nTotInativo := 0
   LOCAL cFiltroTxt := "", cOrdemTxt := ""
   LOCAL aDados := {}, i := 0
   LOCAL lZebrado := .F.
   LOCAL cStatus := ""

   // Carrega e filtra os dados para uma matriz para permitir ordenacao customizada
   VET->( dbGoTop() )

   DO WHILE ! VET->( Eof() )

  cStatus := Upper( AllTrim( cValToChar( VET->ATIVO ) ) )

  IF Empty( cStatus )
     cStatus := "S" // Padrao ativo se nao definido
  ENDIF

  IF nFiltro == 2 .AND. cStatus != "S"
     VET->( dbSkip() )
     LOOP
  ENDIF
  IF nFiltro == 3 .AND. cStatus == "S"
     VET->( dbSkip() )
     LOOP
  ENDIF

  AAdd( aDados, { VET->CODIGO, ;                                       // 1
                  AllTrim( VET->NOME ), ;                              // 2
                  AllTrim( VET->CRMV ), ;                              // 3
                  AllTrim( VET->ESPECIALID ), ;                        // 4
                  AllTrim( VET->CPF ), ;                               // 5
                  If( !Empty( VET->WHATSAPP ), AllTrim( VET->WHATSAPP ), ;
                     If( !Empty( VET->CELULAR ), AllTrim( VET->CELULAR ), AllTrim( VET->FONE ) ) ), ; // 6
                  AllTrim( VET->CIDADE ) + If( !Empty( VET->UF ), "/" + AllTrim( VET->UF ), "" ), ; // 7
                  If( cStatus == "S", "Ativo", "Inativo" ) } )         // 8

  VET->( dbSkip() )
   ENDDO

   IF Len( aDados ) == 0
      MsgAlert( "Nenhum veterinario encontrado para o filtro selecionado!", "Aviso" )
      RETURN NIL
   ENDIF

   // Ordenacao da matriz
   DO CASE
      CASE nOrdem == 1 // Codigo
         ASort( aDados,,, { |x,y| x[ 1 ] < y[ 1 ] } )
         cOrdemTxt := "Codigo"
      CASE nOrdem == 2 // Nome
         ASort( aDados,,, { |x,y| Upper( x[ 2 ] ) < Upper( y[ 2 ] ) } )
         cOrdemTxt := "Nome Alfab‚tico"
      CASE nOrdem == 3 // CRMV
         ASort( aDados,,, { |x,y| Upper( x[ 3 ] ) < Upper( y[ 3 ] ) } )
         cOrdemTxt := "CRMV"
      CASE nOrdem == 4 // Cidade
         ASort( aDados,,, { |x,y| Upper( x[ 7 ] ) < Upper( y[ 7 ] ) } )
         cOrdemTxt := "Cidade"
   ENDCASE

   DO CASE
      CASE nFiltro == 1 ; cFiltroTxt := "Todos os Cadastrados"
      CASE nFiltro == 2 ; cFiltroTxt := "Somente Ativos"
      CASE nFiltro == 3 ; cFiltroTxt := "Somente Inativos"
   ENDCASE

   // Inicializa TPrinter
   IF lPreview
      PRINT oPrn NAME "Relacao de Veterinarios" PREVIEW
   ELSE
      PRINT oPrn NAME "Relacao de Veterinarios"
   ENDIF

   IF oPrn:hDC == 0
      MsgStop( "Nao foi possivel inicializar o subsistema de impressao!", "Erro" )
      RETURN NIL
   ENDIF

   oPrn:SetLandscape()
   oPrn:SetPage( 9 ) // A4

   // Definicao de Fontes e Canetas
   DEFINE FONT oFontEmp    NAME "Arial" SIZE 0, -13 BOLD OF oPrn
   DEFINE FONT oFontTit    NAME "Arial" SIZE 0, -11 BOLD OF oPrn
   DEFINE FONT oFontSub    NAME "Arial" SIZE 0, -8.5     OF oPrn
   DEFINE FONT oFontCab    NAME "Arial" SIZE 0, -8.5 BOLD OF oPrn
   DEFINE FONT oFontDet    NAME "Arial" SIZE 0, -8.0     OF oPrn
   DEFINE FONT oFontBld    NAME "Arial" SIZE 0, -8.0 BOLD OF oPrn
   DEFINE FONT oFontRod    NAME "Arial" SIZE 0, -7.5     OF oPrn

   DEFINE PEN oPenLinha  WIDTH 1   COLOR CLR_LINHA OF oPrn
   DEFINE PEN oPenGrossa WIDTH 1.8 COLOR CLR_TITULO OF oPrn

   PAGE
      nPagina++
      CabecalhoSintetico( oPrn, oFontEmp, oFontTit, oFontSub, oFontCab, ;
                          oPenLinha, oPenGrossa, @nRow, nPagina, cFiltroTxt, cOrdemTxt )

  FOR i := 1 TO Len( aDados )
     // Verifica quebra de pagina (limite util em A4 Paisagem ~ 18.5 cm)
     IF nRow > 18.2
        RodapeSintetico( oPrn, oFontRod, oPenLinha, nPagina )
        ENDPAGE
        PAGE
        nPagina++
        CabecalhoSintetico( oPrn, oFontEmp, oFontTit, oFontSub, oFontCab, ;
                            oPenLinha, oPenGrossa, @nRow, nPagina, cFiltroTxt, cOrdemTxt )
     ENDIF

     // Impressao das colunas da linha
     oPrn:CmSay( nRow, 1.0, StrZero( aDados[ i, 1 ], 6 ), oFontDet )
     oPrn:CmSay( nRow, 2.6, SubStr( aDados[ i, 2 ], 1, 40 ), oFontBld )
     oPrn:CmSay( nRow, 10.0, SubStr( aDados[ i, 3 ], 1, 15 ), oFontDet )
     oPrn:CmSay( nRow, 13.0, SubStr( aDados[ i, 4 ], 1, 26 ), oFontDet )
     oPrn:CmSay( nRow, 18.2, aDados[ i, 5 ], oFontDet )
     oPrn:CmSay( nRow, 21.2, aDados[ i, 6 ], oFontDet )
     oPrn:CmSay( nRow, 24.6, SubStr( aDados[ i, 7 ], 1, 18 ), oFontDet )
     oPrn:CmSay( nRow, 27.5, aDados[ i, 8 ], If( aDados[ i, 8 ] == "Ativo", oFontBld, oFontDet ) )

     nRow += 0.48
     oPrn:CmLine( nRow, 1.0, nRow, 28.7, oPenLinha )
     nRow += 0.12

     nTotReg++
     IF aDados[ i, 8 ] == "Ativo"
        nTotAtivo++
     ELSE
        nTotInativo++
     ENDIF
  NEXT

  // Bloco de Totais ao final
  IF nRow > 17.0
     RodapeSintetico( oPrn, oFontRod, oPenLinha, nPagina )
     ENDPAGE
     PAGE
     nPagina++
     CabecalhoSintetico( oPrn, oFontEmp, oFontTit, oFontSub, oFontCab, ;
                         oPenLinha, oPenGrossa, @nRow, nPagina, cFiltroTxt, cOrdemTxt )
  ENDIF

  nRow += 0.3
  oPrn:CmLine( nRow, 1.0, nRow, 28.7, oPenGrossa )
  nRow += 0.2
  oPrn:CmSay( nRow, 1.0, "TOTAIS DO RELATORIO:", oFontBld )
  oPrn:CmSay( nRow, 6.0, "Total Listados: " + AllTrim( Str( nTotReg ) ), oFontBld )
  oPrn:CmSay( nRow, 11.0, "Ativos: " + AllTrim( Str( nTotAtivo ) ), oFontBld )
  oPrn:CmSay( nRow, 15.0, "Inativos: " + AllTrim( Str( nTotInativo ) ), oFontBld )
  nRow += 0.5
  oPrn:CmLine( nRow, 1.0, nRow, 28.7, oPenLinha )

  RodapeSintetico( oPrn, oFontRod, oPenLinha, nPagina )
   ENDPAGE

   ENDPRINT

   // Liberacao de Recursos
   oFontEmp:End()
   oFontTit:End()
   oFontSub:End()
   oFontCab:End()
   oFontDet:End()
   oFontBld:End()
   oFontRod:End()
   oPenLinha:End()
   oPenGrossa:End()

RETURN NIL

// -----------------------------------------------------------------------------
// Cabecalho do Relatorio Sintetico
// -----------------------------------------------------------------------------
STATIC PROCEDURE CabecalhoSintetico( oPrn, oFontEmp, oFontTit, oFontSub, oFontCab, ;
                                     oPenLinha, oPenGrossa, nRow, nPagina, cFiltroTxt, cOrdemTxt )

   nRow := 1.0

   // Topo: Nome da Empresa e Dados de Emissao
   oPrn:CmSay( nRow, 1.0, "CLINICA VETERINARIA & PET SHOP - PETVET 1.0", oFontEmp, , CLR_TITULO )
   oPrn:CmSay( nRow, 22.0, "Emissao: " + DToC( Date() ) + " as " + Time(), oFontSub )

   nRow += 0.55
   oPrn:CmSay( nRow, 1.0, "RELACAO CADASTRAL DE MEDICOS VETERINARIOS", oFontTit, , CLR_TITULO )
   oPrn:CmSay( nRow, 22.0, "Filtro: " + cFiltroTxt + " | Ordem: " + cOrdemTxt, oFontSub )

   nRow += 0.5
   oPrn:CmLine( nRow, 1.0, nRow, 28.7, oPenGrossa )

   // Cabecalho das Colunas
   nRow += 0.15
   oPrn:CmSay( nRow, 1.0,  "CODIGO",       oFontCab, , CLR_TITULO )
   oPrn:CmSay( nRow, 2.6,  "NOME COMPLETO DO VETERINARIO", oFontCab, , CLR_TITULO )
   oPrn:CmSay( nRow, 10.0, "CRMV / UF",    oFontCab, , CLR_TITULO )
   oPrn:CmSay( nRow, 13.0, "ESPECIALIDADE",oFontCab, , CLR_TITULO )
   oPrn:CmSay( nRow, 18.2, "CPF",          oFontCab, , CLR_TITULO )
   oPrn:CmSay( nRow, 21.2, "CONTATO/CEL",  oFontCab, , CLR_TITULO )
   oPrn:CmSay( nRow, 24.6, "CIDADE / UF",  oFontCab, , CLR_TITULO )
   oPrn:CmSay( nRow, 27.5, "SITUACAO",     oFontCab, , CLR_TITULO )

   nRow += 0.45
   oPrn:CmLine( nRow, 1.0, nRow, 28.7, oPenGrossa )
   nRow += 0.25

RETURN

// -----------------------------------------------------------------------------
// Rodape do Relatorio Sintetico
// -----------------------------------------------------------------------------
STATIC PROCEDURE RodapeSintetico( oPrn, oFontRod, oPenLinha, nPagina )

   LOCAL nRodRow := 19.3

   oPrn:CmLine( nRodRow, 1.0, nRodRow, 28.7, oPenLinha )
   nRodRow += 0.15
   oPrn:CmSay( nRodRow, 1.0, "Sistema PetVet - Modulo de Cadastro de Veterinarios (TPrinter)", oFontRod )
   oPrn:CmSay( nRodRow, 26.5, "Pagina: " + AllTrim( Str( nPagina ) ), oFontRod )

RETURN

// -----------------------------------------------------------------------------
// MODELO 2: FICHA CADASTRAL ANALITICA (RETRATO - A4 PORTRAIT)
// -----------------------------------------------------------------------------
STATIC FUNCTION ImprimeAnalitico( nFiltro, nOrdem, lPreview )

   LOCAL oPrn, oFontEmp, oFontTit, oFontSec, oFontLbl, oFontTxt, oFontRod
   LOCAL oPenLinha, oPenSec, oPenBorda
   LOCAL nPagina := 0, nRow := 0
   LOCAL cStatus := ""
   LOCAL cObs := ""

   // Inicializa TPrinter
   IF lPreview
      PRINT oPrn NAME "Ficha Cadastral do Veterinario" PREVIEW
   ELSE
      PRINT oPrn NAME "Ficha Cadastral do Veterinario"
   ENDIF

   IF oPrn:hDC == 0
      MsgStop( "Nao foi possivel inicializar o subsistema de impressao!", "Erro" )
      RETURN NIL
   ENDIF

   oPrn:SetPortrait()
   oPrn:SetPage( 9 ) // A4

   DEFINE FONT oFontEmp NAME "Arial" SIZE 0, -13  BOLD OF oPrn
   DEFINE FONT oFontTit NAME "Arial" SIZE 0, -11  BOLD OF oPrn
   DEFINE FONT oFontSec NAME "Arial" SIZE 0, -9   BOLD OF oPrn
   DEFINE FONT oFontLbl NAME "Arial" SIZE 0, -8.5 BOLD OF oPrn
   DEFINE FONT oFontTxt NAME "Arial" SIZE 0, -8.5      OF oPrn
   DEFINE FONT oFontRod NAME "Arial" SIZE 0, -7.5      OF oPrn

   DEFINE PEN oPenLinha WIDTH 1   COLOR CLR_LINHA OF oPrn
   DEFINE PEN oPenSec   WIDTH 1.5 COLOR CLR_TITULO OF oPrn
   DEFINE PEN oPenBorda WIDTH 2   COLOR CLR_TITULO OF oPrn

   VET->( dbGoTop() )

   DO WHILE ! VET->( Eof() )
      cStatus := Upper( AllTrim( cValToChar( VET->ATIVO ) ) )
      IF Empty( cStatus ) ; cStatus := "S" ; ENDIF

  IF nFiltro == 2 .AND. cStatus != "S"
     VET->( dbSkip() )
     LOOP
  ENDIF
  IF nFiltro == 3 .AND. cStatus == "S"
     VET->( dbSkip() )
     LOOP
  ENDIF

  PAGE
     nPagina++
     nRow := 1.0

     // Cabecalho Principal da Pagina
     oPrn:CmSay( nRow, 1.0, "CLINICA VETERINARIA & PET SHOP - PETVET 1.0", oFontEmp, , CLR_TITULO )
     oPrn:CmSay( nRow, 14.5, "Emissao: " + DToC( Date() ) + " " + Time(), oFontTxt )
     nRow += 0.55
     oPrn:CmSay( nRow, 1.0, "FICHA CADASTRAL INDIVIDUAL DO MEDICO VETERINARIO", oFontTit, , CLR_TITULO )
     oPrn:CmSay( nRow, 17.5, "Pagina: " + AllTrim( Str( nPagina ) ), oFontTxt )
     nRow += 0.5
     oPrn:CmLine( nRow, 1.0, nRow, 20.0, oPenBorda )

     // Bloco 1: Identificacao
     nRow += 0.3
     oPrn:CmSay( nRow, 1.0, "1. IDENTIFICACAO PROFISSIONAL", oFontSec, , CLR_TITULO )
     nRow += 0.45
     oPrn:CmLine( nRow, 1.0, nRow, 20.0, oPenSec )
     nRow += 0.2

     oPrn:CmSay( nRow, 1.0, "Codigo:", oFontLbl )
     oPrn:CmSay( nRow, 3.2, StrZero( VET->CODIGO, 6 ), oFontTxt )
     oPrn:CmSay( nRow, 7.0, "Situacao:", oFontLbl )
     oPrn:CmSay( nRow, 9.2, If( cStatus == "S", "ATIVO NO SISTEMA", "INATIVO" ), oFontLbl, , ;
                 If( cStatus == "S", RGB( 0, 128, 0 ), RGB( 200, 0, 0 ) ) )
     oPrn:CmSay( nRow, 14.0, "Tipo / Tabela:", oFontLbl )
     oPrn:CmSay( nRow, 17.0, AllTrim( VET->TIPO ) + " / " + AllTrim( VET->TABELA ), oFontTxt )

     nRow += 0.5
     oPrn:CmSay( nRow, 1.0, "Nome Completo:", oFontLbl )
     oPrn:CmSay( nRow, 4.0, AllTrim( VET->NOME ), oFontTxt )

     nRow += 0.5
     oPrn:CmSay( nRow, 1.0, "Nome Social/Apelido:", oFontLbl )
     oPrn:CmSay( nRow, 5.0, AllTrim( VET->APELIDO ), oFontTxt )

     nRow += 0.5
     oPrn:CmSay( nRow, 1.0, "CRMV / UF:", oFontLbl )
     oPrn:CmSay( nRow, 3.5, AllTrim( VET->CRMV ), oFontTxt )
     oPrn:CmSay( nRow, 8.5, "Especialidade:", oFontLbl )
     oPrn:CmSay( nRow, 11.5, AllTrim( VET->ESPECIALID ), oFontTxt )

     // Bloco 2: Documentos
     nRow += 0.7
     oPrn:CmSay( nRow, 1.0, "2. DOCUMENTACAO E REGISTROS", oFontSec, , CLR_TITULO )
     nRow += 0.45
     oPrn:CmLine( nRow, 1.0, nRow, 20.0, oPenSec )
     nRow += 0.2

     oPrn:CmSay( nRow, 1.0, "CPF:", oFontLbl )
     oPrn:CmSay( nRow, 2.5, AllTrim( VET->CPF ), oFontTxt )
     oPrn:CmSay( nRow, 7.5, "RG:", oFontLbl )
     oPrn:CmSay( nRow, 8.5, AllTrim( VET->RG ), oFontTxt )
     oPrn:CmSay( nRow, 13.5, "Orgao Emissor:", oFontLbl )
     oPrn:CmSay( nRow, 16.5, AllTrim( VET->ORGAO ), oFontTxt )

     nRow += 0.5
     oPrn:CmSay( nRow, 1.0, "CNPJ:", oFontLbl )
     oPrn:CmSay( nRow, 2.5, AllTrim( VET->CNPJ ), oFontTxt )
     oPrn:CmSay( nRow, 7.5, "Insc. Estadual:", oFontLbl )
     oPrn:CmSay( nRow, 10.5, AllTrim( VET->IE ), oFontTxt )
     oPrn:CmSay( nRow, 14.0, "Insc. Municipal:", oFontLbl )
     oPrn:CmSay( nRow, 17.0, AllTrim( VET->IM ), oFontTxt )

     // Bloco 3: Contato & Comunicacao
     nRow += 0.7
     oPrn:CmSay( nRow, 1.0, "3. CANAIS DE CONTATO E COMUNICACAO", oFontSec, , CLR_TITULO )
     nRow += 0.45
     oPrn:CmLine( nRow, 1.0, nRow, 20.0, oPenSec )
     nRow += 0.2

     oPrn:CmSay( nRow, 1.0, "Telefone Fixo:", oFontLbl )
     oPrn:CmSay( nRow, 4.0, AllTrim( VET->FONE ), oFontTxt )
     oPrn:CmSay( nRow, 8.5, "Telefone 2:", oFontLbl )
     oPrn:CmSay( nRow, 11.0, AllTrim( VET->FONE2 ), oFontTxt )
     oPrn:CmSay( nRow, 15.0, "Celular:", oFontLbl )
     oPrn:CmSay( nRow, 17.0, AllTrim( VET->CELULAR ), oFontTxt )

     nRow += 0.5
     oPrn:CmSay( nRow, 1.0, "WhatsApp:", oFontLbl )
     oPrn:CmSay( nRow, 3.5, AllTrim( VET->WHATSAPP ), oFontTxt )
     oPrn:CmSay( nRow, 8.5, "MS Teams:", oFontLbl )
     oPrn:CmSay( nRow, 11.0, AllTrim( VET->TEAMS ), oFontTxt )

     nRow += 0.5
     oPrn:CmSay( nRow, 1.0, "E-mail:", oFontLbl )
     oPrn:CmSay( nRow, 3.0, AllTrim( VET->EMAIL ), oFontTxt )
     oPrn:CmSay( nRow, 11.5, "Rede Social:", oFontLbl )
     oPrn:CmSay( nRow, 14.2, AllTrim( VET->REDESOCIAL ), oFontTxt )

     // Bloco 4: Endereco
     nRow += 0.7
     oPrn:CmSay( nRow, 1.0, "4. ENDERECO RESIDENCIAL / PROFISSIONAL", oFontSec, , CLR_TITULO )
     nRow += 0.45
     oPrn:CmLine( nRow, 1.0, nRow, 20.0, oPenSec )
     nRow += 0.2

     oPrn:CmSay( nRow, 1.0, "Logradouro:", oFontLbl )
     oPrn:CmSay( nRow, 3.8, AllTrim( VET->ENDERECO ), oFontTxt )
     oPrn:CmSay( nRow, 15.0, "Numero:", oFontLbl )
     oPrn:CmSay( nRow, 17.0, AllTrim( VET->NUMERO ), oFontTxt )

     nRow += 0.5
     oPrn:CmSay( nRow, 1.0, "Complemento:", oFontLbl )
     oPrn:CmSay( nRow, 4.0, AllTrim( VET->COMPLEMENT ), oFontTxt )
     oPrn:CmSay( nRow, 10.5, "Bairro:", oFontLbl )
     oPrn:CmSay( nRow, 12.5, AllTrim( VET->BAIRRO ), oFontTxt )

     nRow += 0.5
     oPrn:CmSay( nRow, 1.0, "Cidade:", oFontLbl )
     oPrn:CmSay( nRow, 3.0, AllTrim( VET->CIDADE ), oFontTxt )
     oPrn:CmSay( nRow, 10.5, "UF:", oFontLbl )
     oPrn:CmSay( nRow, 11.5, AllTrim( VET->UF ), oFontTxt )
     oPrn:CmSay( nRow, 14.5, "CEP:", oFontLbl )
     oPrn:CmSay( nRow, 16.0, AllTrim( VET->CEP ), oFontTxt )

     // Bloco 5: Dados Contratuais e Financeiros
     nRow += 0.7
     oPrn:CmSay( nRow, 1.0, "5. DADOS CONTRATUAIS E FINANCEIROS", oFontSec, , CLR_TITULO )
     nRow += 0.45
     oPrn:CmLine( nRow, 1.0, nRow, 20.0, oPenSec )
     nRow += 0.2

     oPrn:CmSay( nRow, 1.0, "Data Admissao:", oFontLbl )
     oPrn:CmSay( nRow, 4.2, DToC( VET->ADMISSAO ), oFontTxt )
     oPrn:CmSay( nRow, 8.5, "Data Demissao:", oFontLbl )
     oPrn:CmSay( nRow, 11.8, DToC( VET->DEMISSAO ), oFontTxt )
     oPrn:CmSay( nRow, 15.0, "Salario Base:", oFontLbl )
     oPrn:CmSay( nRow, 17.6, Transform( VET->SALARIO, "@E 999,999.99" ), oFontTxt )

     nRow += 0.5
     oPrn:CmSay( nRow, 1.0, "% Comissao:", oFontLbl )
     oPrn:CmSay( nRow, 3.8, Transform( VET->COMISSAO, "@E 999.99" ) + " %", oFontTxt )
     oPrn:CmSay( nRow, 7.5, "Comissao Prod:", oFontLbl )
     oPrn:CmSay( nRow, 10.8, AllTrim( VET->COMI_PROD ), oFontTxt )
     oPrn:CmSay( nRow, 14.0, "Comissao Serv:", oFontLbl )
     oPrn:CmSay( nRow, 17.3, AllTrim( VET->COMI_SERV ), oFontTxt )

     nRow += 0.5
     oPrn:CmSay( nRow, 1.0, "Representante:", oFontLbl )
     oPrn:CmSay( nRow, 4.0, AllTrim( VET->CODREP ) + " - " + AllTrim( VET->REPRES ), oFontTxt )
     oPrn:CmSay( nRow, 13.0, "Regiao:", oFontLbl )
     oPrn:CmSay( nRow, 15.0, AllTrim( VET->CODREG ) + " - " + AllTrim( VET->REGIAO ), oFontTxt )

     // Bloco 6: Observacoes
     nRow += 0.7
     oPrn:CmSay( nRow, 1.0, "6. OBSERVACOES GERAIS DO CADASTRO", oFontSec, , CLR_TITULO )
     nRow += 0.45
     oPrn:CmLine( nRow, 1.0, nRow, 20.0, oPenSec )
     nRow += 0.2

     cObs := AllTrim( VET->OBS1 )
     IF !Empty( VET->OBS2 ) ; cObs += If( !Empty( cObs ), " ", "" ) + AllTrim( VET->OBS2 ) ; ENDIF
     IF !Empty( VET->OBS3 ) ; cObs += If( !Empty( cObs ), " ", "" ) + AllTrim( VET->OBS3 ) ; ENDIF
     IF !Empty( VET->OBS4 ) ; cObs += If( !Empty( cObs ), " ", "" ) + AllTrim( VET->OBS4 ) ; ENDIF
     IF !Empty( VET->OBS5 ) ; cObs += If( !Empty( cObs ), " ", "" ) + AllTrim( VET->OBS5 ) ; ENDIF
     IF !Empty( VET->OBS6 ) ; cObs += If( !Empty( cObs ), " ", "" ) + AllTrim( VET->OBS6 ) ; ENDIF

     IF Empty( cObs )
        cObs := "Nenhuma observacao cadastrada para este profissional."
     ENDIF

     oPrn:CmSay( nRow, 1.0, SubStr( cObs, 1, 95 ), oFontTxt )
     IF Len( cObs ) > 95
        nRow += 0.45
        oPrn:CmSay( nRow, 1.0, SubStr( cObs, 96, 95 ), oFontTxt )
     ENDIF
     IF Len( cObs ) > 190
        nRow += 0.45
        oPrn:CmSay( nRow, 1.0, SubStr( cObs, 191, 95 ), oFontTxt )
     ENDIF

     // Rodape da Pagina
     oPrn:CmLine( 28.0, 1.0, 28.0, 20.0, oPenLinha )
     oPrn:CmSay( 28.2, 1.0, "Sistema PetVet 1.0 - Cadastro Geral de Veterinarios (TPrinter)", oFontRod )
     oPrn:CmSay( 28.2, 16.5, "Documento Confidencial", oFontRod )

  ENDPAGE

  VET->( dbSkip() )
   ENDDO

   ENDPRINT

   oFontEmp:End()
   oFontTit:End()
   oFontSec:End()
   oFontLbl:End()
   oFontTxt:End()
   oFontRod:End()
   oPenLinha:End()
   oPenSec:End()
   oPenBorda:End()

RETURN NIL

// FIM DE RELVETPRN.PRG

Regards, saludos.

João Santos - São Paulo - Brasil - Phone: +55(11)95150-7341

karinha

Posts: 8716

Joined: Tue Dec 20, 2005 07:36 PM

Re: REPORT: Vía Inteligencia Artificial.

Posted: Mon Sep 14, 2026 07:54 PM

¡Maestro, simplemente fantástico! Pequeños cambios y funciona de maravilla.

Faltan algunos detalles que tiene el REPORT normal; ¿se pueden añadir o no es necesario? Mira a continuación:

Code: Select all Collapse

   DEFINE REPORT oReport TITLE "Relação de Veterinários" PREVIEW // MODAL? NO FUNCIONA.

   // oReport:oDevice:lPrvModal := .T.           // NO FUNCIIONA
   // oReport:oDevice:SetPage(9) //-> Formato A4 // NO FUNCIONA
   // oReport:SetPage(9) //-> Formato A4         // NO FUNCIONA

   // ES POSIBLE PONER UN LOGO.BMP; JPG, PNG? como?

Code: Select all Collapse

//-----------------------------------------------------------------------------
// 2) Relatorio de Veterinarios con sintaxis estilo DEFINE SECTION.
// Campos adaptados a VETERINA.DBF (DBF = max 10 chars: ESPECIALIDADE -> ESPEC).
FUNCTION RelVeterinarios( oDlg )

   LOCAL oReport, oSection

   // USE VET NEW SHARED VIA "DBFCDX"
   SELECT( VET )
   DBGOTOP()

   DEFINE REPORT oReport TITLE "Relação de Veterinários" PREVIEW // MODAL? NO FUNCIONA.

   // oReport:oDevice:lPrvModal := .T.           // NO FUNCIIONA
   // oReport:oDevice:SetPage(9) //-> Formato A4 // NO FUNCIONA
   // oReport:SetPage(9) //-> Formato A4         // NO FUNCIONA

   // ES POSIBLE PONER UN LOGO.BMP; JPG, PNG?

   DEFINE SECTION oSection OF oReport

   DEFINE HEADER OF oSection TITLE "PETSHOP: Relação de Veterinários" ;
      FONT "Arial" SIZE 12 BOLD

   DEFINE FOOTER OF oSection ;
      EXPRESSION "Página: " + Str( oReport:nPage, 4 ) FONT "Arial" SIZE 8

   // Colunas do relatorio
   DEFINE COLUMN OF oSection TITLE "Código:"        WIDTH 10 ;
      EXPRESSION { || ( VET )->CODIGO } ALIGN DT_CENTER

   DEFINE COLUMN OF oSection TITLE "Nome:"          WIDTH 32 ;
      EXPRESSION { || SUBST( ( VET )->NOME, 1, 32 ) }

   DEFINE COLUMN OF oSection TITLE "CRMV:"          WIDTH 12 ;
      EXPRESSION { || ( VET )->CRMV } ALIGN DT_CENTER

   DEFINE COLUMN OF oSection TITLE "Especialidade:" WIDTH 22 ;
      EXPRESSION { || ( VET )->ESPECIALID }

   DEFINE COLUMN OF oSection TITLE "CPF:"          WIDTH 14 ;
      EXPRESSION { || ( VET )->CPF } ALIGN DT_CENTER

   DEFINE COLUMN OF oSection TITLE "RG:"           WIDTH 12 ;
      EXPRESSION { || ( VET )->RG } ALIGN DT_CENTER

   DEFINE COLUMN OF oSection TITLE "Admissão:"     WIDTH 11 ;
      EXPRESSION { || DToC( ( VET )->ADMISSAO ) } ALIGN DT_CENTER

   DEFINE COLUMN OF oSection TITLE "Demissão:"     WIDTH 11 ;
      EXPRESSION { || DToC( ( VET )->DEMISSAO ) } ALIGN DT_CENTER

   DEFINE COLUMN OF oSection TITLE "Salário:"      WIDTH 12 ;
      EXPRESSION { || Transform( ( VET )->SALARIO, "@E 999,999.99" ) } ALIGN DT_RIGHT

   /* // ERROR. Nos es una Conditional
   DEFINE COLUMN OF oSection TITLE "Ativo"        WIDTH 8 ;
      EXPRESSION { || If( ( VET )->ATIVO, "Sim", "Nao" ) } ALIGN DT_CENTER
   */

   DEFINE COLUMN OF oSection TITLE "Ativo:"        WIDTH 8 ;
      EXPRESSION { || ( VET )->ATIVO } ALIGN DT_CENTER

   DEFINE COLUMN OF oSection TITLE "Cidade/UF:"    WIDTH 18 ;
      EXPRESSION { || AllTrim( ( VET )->CIDADE ) + "/" + ( VET )->UF }

   // SELECT( VET ) //-> ARRIBA/ACIMA
   // ( VET )->( dbGoTop() )

   WHILE .NOT. ( VET )->( Eof() )

  SYSREFRESH()

  oReport:PrintSection( oSection )

  ( VET )->( dbSkip() )

   ENDDO

   oReport:End()

   oDlg:End()

   // CLOSE( VET )

RETURN NIL
//=============================================================================
// MINI-MOTOR SecReport/SecSection : ejecuta la sintaxis DEFINE SECTION sobre
// TPrinter (unidades en cm, tamano de pagina real, apaisado automatico).
//=============================================================================
CLASS SecSection
   DATA oRpt, cHead, cHeadFont, nHeadSize, lHeadBold
   DATA bFoot, cFootFont, nFootSize, aCols
   METHOD New( oRpt ) CONSTRUCTOR
   METHOD SetHeader( c, f, s, b )
   METHOD SetFooter( b, f, s )
   METHOD AddColumn( c, w, b, a )
ENDCLASS

METHOD New( oRpt ) CLASS SecSection
   ::oRpt      := oRpt
   ::aCols     := {}
   ::cHead     := ""
   ::cHeadFont := "ARIAL"
   ::nHeadSize := 12
   ::lHeadBold := .F.
   ::bFoot     := NIL
   ::cFootFont := "ARIAL"
   ::nFootSize := 8
RETURN Self

METHOD SetHeader( c, f, s, b ) CLASS SecSection
   ::cHead := c
   IF ValType( f ) == "C" .AND. ! Empty( f ) ; ::cHeadFont := f ; ENDIF
   IF ValType( s ) == "N" .AND. s > 0        ; ::nHeadSize := s ; ENDIF
   ::lHeadBold := ( ValType( b ) == "L" .AND. b )
RETURN Self

METHOD SetFooter( b, f, s ) CLASS SecSection
   ::bFoot := b
   IF ValType( f ) == "C" .AND. ! Empty( f ) ; ::cFootFont := f ; ENDIF
   IF ValType( s ) == "N" .AND. s > 0        ; ::nFootSize := s ; ENDIF
RETURN Self

METHOD AddColumn( c, w, b, a ) CLASS SecSection
   DEFAULT a := DT_LEFT
   AAdd( ::aCols, { c, Max( 1, w ), b, a } )
RETURN Self

//----------------------------------------------------------------------------//
CLASS SecReport
   DATA cTitle, lPreview, aSecs, nPage
   DATA oPrn, oFontBody, oFontBold, oFontTitle, oFontHead, oFontFoot
   DATA lOpen, oLastSec, lLand, nPtBody
   DATA nLeft, nTop, nBottom, nFootRow, nPrintW, nRow, nBodyH
   DATA aColX, aColW
   METHOD New( cTitle, lPreview ) CONSTRUCTOR
   METHOD AddSection()
   METHOD PrintSection( oSec )
   METHOD End()
   METHOD StartSheet( oSec )
   METHOD HeadSheet( oSec )
   METHOD FootSheet( oSec )
ENDCLASS

METHOD New( cTitle, lPreview ) CLASS SecReport
   ::cTitle   := cTitle
   ::lPreview := ( ValType( lPreview ) == "L" .AND. lPreview )
   ::aSecs    := {}
   ::nPage    := 0
   ::lOpen    := .F.
   ::oLastSec := NIL
RETURN Self

METHOD AddSection() CLASS SecReport
   AAdd( ::aSecs, SecSection():New( Self ) )
RETURN ATail( ::aSecs )

METHOD PrintSection( oSec ) CLASS SecReport
   LOCAL i, aCol, cTxt, nPad
   IF ! ::lOpen
      ::StartSheet( oSec )
   ENDIF
   IF ::nRow + ::nBodyH > ::nBottom
      ::FootSheet( oSec )
      ::oPrn:EndPage()
      ::oPrn:StartPage()
      ::nPage++
      ::HeadSheet( oSec )
   ENDIF
   FOR i := 1 TO Len( oSec:aCols )
      aCol := oSec:aCols[ i ]
      cTxt := SecCStr( SecEval( aCol[ 3 ] ) )
      nPad := SecPad( aCol[ 4 ] )
      ::oPrn:CmSay( ::nRow, ::aColX[ i ], cTxt, ::oFontBody, ;
                    ::aColW[ i ],,, nPad )
   NEXT
   ::nRow += ::nBodyH
   ::oLastSec := oSec
RETURN Self

METHOD StartSheet( oSec ) CLASS SecReport
   LOCAL aGeo, nPxBody, nPxTitle, nPxHead, nPxFoot, cHF
   PRINTER ::oPrn NAME ::cTitle PREVIEW
   aGeo := SecColWidths( oSec:aCols, 1.2, 0 )  // solo nTot para decidir
   ::lLand := ( aGeo[ 3 ] > 100 )
   IF ::lLand
      ::oPrn:SetLandscape()
   ENDIF
   ::nLeft   := 1.2
   ::nTop    := 1.2
   ::nPrintW := ::oPrn:PageWidth( "CM" ) - 2.4
   ::nBottom := ::oPrn:PageHeight( "CM" ) - 2.2
   ::nFootRow := ::oPrn:PageHeight( "CM" ) - 1.4
   ::nPtBody := Min( 9, Max( 6, Int( ::nPrintW * 10 / aGeo[ 3 ] / 0.20 ) ) )
   ::nBodyH  := ::nPtBody * 0.067
   aGeo := SecColWidths( oSec:aCols, ::nLeft, ::nPrintW )
   ::aColX := aGeo[ 1 ]
   ::aColW := aGeo[ 2 ]
   nPxBody  := -::nPtBody
   nPxTitle := -( ::nPtBody + 6 )
   cHF      := oSec:cHeadFont
   nPxHead  := -Max( 8, oSec:nHeadSize )
   nPxFoot  := -Max( 6, oSec:nFootSize )
   DEFINE FONT ::oFontBody  NAME "ARIAL" SIZE 0, nPxBody  OF ::oPrn
   DEFINE FONT ::oFontBold  NAME "ARIAL" SIZE 0, nPxBody  BOLD OF ::oPrn
   DEFINE FONT ::oFontTitle NAME "ARIAL" SIZE 0, nPxTitle BOLD OF ::oPrn
   IF oSec:lHeadBold
      DEFINE FONT ::oFontHead NAME cHF SIZE 0, nPxHead BOLD OF ::oPrn
   ELSE
      DEFINE FONT ::oFontHead NAME cHF SIZE 0, nPxHead OF ::oPrn
   ENDIF
   DEFINE FONT ::oFontFoot NAME "ARIAL" SIZE 0, nPxFoot OF ::oPrn
   ::oPrn:StartPage()
   ::nPage  := 1
   ::lOpen  := .T.
   ::nRow   := ::nTop
   ::HeadSheet( oSec )
RETURN Self

METHOD HeadSheet( oSec ) CLASS SecReport
   LOCAL i, aCol
   ::oPrn:CmSay( ::nRow, ::nLeft, ::cTitle, ::oFontTitle, ::nPrintW,,, 2 )
   ::nRow += 0.85
   IF ! Empty( oSec:cHead )
      ::oPrn:CmSay( ::nRow, ::nLeft, oSec:cHead, ::oFontHead, ::nPrintW,,, 2 )
      ::nRow += 0.70
   ENDIF
   FOR i := 1 TO Len( oSec:aCols )
      aCol := oSec:aCols[ i ]
      ::oPrn:CmSay( ::nRow, ::aColX[ i ], aCol[ 1 ], ::oFontBold, ;
                    ::aColW[ i ],,, SecPad( aCol[ 4 ] ) )
   NEXT
   ::nRow += 0.60
RETURN Self

METHOD FootSheet( oSec ) CLASS SecReport
   LOCAL cTxt := ""
   IF ValType( oSec:bFoot ) == "B"
      cTxt := SecCStr( SecEval( oSec:bFoot ) )
   ENDIF
   IF ! Empty( cTxt )
      ::oPrn:CmSay( ::nFootRow, ::nLeft, cTxt, ::oFontFoot, ::nPrintW,,, 2 )
   ENDIF
RETURN Self

METHOD End() CLASS SecReport
   IF ::lOpen
      IF ::oLastSec != NIL
         ::FootSheet( ::oLastSec )
      ENDIF
      ::oPrn:EndPage()
      ::oPrn:Preview()
      ::oFontBody:End()
      ::oFontBold:End()
      ::oFontTitle:End()
      ::oFontHead:End()
      ::oFontFoot:End()
      ::lOpen := .F.
   ENDIF
RETURN NIL

//----------------------------------------------------------------------------//
// Funciones puras del mini-motor (testeables sin impresora via /testsec)
STATIC FUNCTION SecEval( b )
   LOCAL u := Eval( b )
   IF ValType( u ) == "B"
      u := Eval( u )
   ENDIF
RETURN u

STATIC FUNCTION SecCStr( u )
   LOCAL c
   DO CASE
   CASE ValType( u ) == "C" ; c := u
   CASE ValType( u ) == "D" ; c := DToC( u )
   CASE ValType( u ) == "N" ; c := LTrim( Str( u ) )
   CASE ValType( u ) == "L" ; c := If( u, "Sim", "Nao" )
   CASE ValType( u ) == "B" ; c := SecCStr( Eval( u ) )
   OTHERWISE                 ; c := ""
   ENDCASE
RETURN c

STATIC FUNCTION SecPad( nAlign )
   LOCAL aP := { 0, 2, 1 }  // DT_LEFT->PAD_LEFT, DT_CENTER->PAD_CENTER, DT_RIGHT->PAD_RIGHT
   DEFAULT nAlign := DT_LEFT
RETURN aP[ Min( Max( nAlign, 0 ), 2 ) + 1 ]

// aX/aW en cm + nTot ; nPrintW=0 -> solo calcula nTot (sin impresora)
STATIC FUNCTION SecColWidths( aCols, nLeft, nPrintW )
   LOCAL aX := {}, aW := {}, nTot := 0, i, nX, nW
   FOR i := 1 TO Len( aCols )
      nTot += aCols[ i ][ 2 ]
   NEXT
   nTot := Max( nTot, 1 )
   nX := nLeft
   FOR i := 1 TO Len( aCols )
      nW := nPrintW * aCols[ i ][ 2 ] / nTot
      AAdd( aX, nX )
      AAdd( aW, nW - 0.06 )
      nX += nW
   NEXT
RETURN { aX, aW, nTot }

// Autotest headless: relvet.exe /testsec -> secselftest.log
STATIC FUNCTION SecSelfTest()
   LOCAL h, nOk := 0, nFail := 0, aGeo, nSum, i
   h := FCreate( "secselftest.log" )
   IF h < 0
      RETURN .F.
   ENDIF
   FWrite( h, "SecSelfTest PetVet" + hb_eol() )
   SecTst( h, @nOk, @nFail, "CStr-C",      SecCStr( "abc" ), "abc" )
   SecTst( h, @nOk, @nFail, "CStr-N",      SecCStr( 1500.5 ), LTrim( Str( 1500.5 ) ) )
   SecTst( h, @nOk, @nFail, "CStr-D",      SecCStr( CToD( "10/01/2020" ) ), "10/01/2020" )
   SecTst( h, @nOk, @nFail, "CStr-L-T",    SecCStr( .T. ), "Sim" )
   SecTst( h, @nOk, @nFail, "CStr-L-F",    SecCStr( .F. ), "Nao" )
   SecTst( h, @nOk, @nFail, "CStr-NIL",    SecCStr( NIL ), "" )
   SecTst( h, @nOk, @nFail, "Eval-1",      SecEval( { || 1 + 1 } ), 2 )
   SecTst( h, @nOk, @nFail, "Eval-2",      SecEval( { || { || "X" } } ), "X" )
   SecTst( h, @nOk, @nFail, "Pad-L",       SecPad( DT_LEFT ), 0 )
   SecTst( h, @nOk, @nFail, "Pad-C",       SecPad( DT_CENTER ), 2 )
   SecTst( h, @nOk, @nFail, "Pad-R",       SecPad( DT_RIGHT ), 1 )
   SecTst( h, @nOk, @nFail, "Pad-def",     SecPad( NIL ), 0 )
   aGeo := SecColWidths( { { "A", 10, NIL, 0 }, { "B", 30, NIL, 0 } }, 1.2, 20.0 )
   SecTst( h, @nOk, @nFail, "Geo-nTot",    aGeo[ 3 ], 40 )
   SecTst( h, @nOk, @nFail, "Geo-x1",      aGeo[ 1 ][ 1 ], 1.2 )
   nSum := 0
   FOR i := 1 TO Len( aGeo[ 2 ] ) ; nSum += aGeo[ 2 ][ i ] + 0.06 ; NEXT
   SecTst( h, @nOk, @nFail, "Geo-suma",    Abs( nSum - 20.0 ) < 0.001, .T. )
   SecTst( h, @nOk, @nFail, "Geo-x2",      aGeo[ 1 ][ 2 ], 1.2 + 20.0 * 10 / 40 )
   FWrite( h, "RESULT=" + If( nFail == 0, "PASS", "FAIL" ) + ;
      " ok=" + LTrim( Str( nOk ) ) + " fail=" + LTrim( Str( nFail ) ) + hb_eol() )
   FClose( h )
RETURN nFail == 0

STATIC FUNCTION SecTst( h, nOk, nFail, cName, uGot, uExp )
   LOCAL lOk := ( ValType( uGot ) == ValType( uExp ) .AND. uGot == uExp )
   IF lOk ; nOk++ ; ELSE ; nFail++ ; ENDIF
   FWrite( h, PadR( cName, 10 ) + "=" + If( lOk, "OK", "FAIL" ) + hb_eol() )
RETURN lOk

// FIM DO PROGRAMA

Gracias, tks.

Regards, saludos.

João Santos - São Paulo - Brasil - Phone: +55(11)95150-7341

Antonio Linares

Posts: 44508

Joined: Thu Oct 06, 2005 05:47 PM

Re: REPORT: Vía Inteligencia Artificial.

Posted: Tue Sep 15, 2026 04:25 AM

Code: Select all Collapse

#xcommand DEFINE LOGO OF <oRpt> FILE <cFile> ;
      WIDTH <nW> HEIGHT <nH> => ;
   <oRpt>:SayLogo( 0, 0, <cFile>, <nW>, <nH> )

regards, saludos

Antonio Linares
www.fivetechsoft.com

karinha

Posts: 8716

Joined: Tue Dec 20, 2005 07:36 PM

Re: REPORT: Vía Inteligencia Artificial.

Posted: Tue Sep 15, 2026 11:41 AM

Antonio Linares wrote:

Code: Select all Collapse

#xcommand DEFINE LOGO OF <oRpt> FILE <cFile> ;
      WIDTH <nW> HEIGHT <nH> => ;
   <oRpt>:SayLogo( 0, 0, <cFile>, <nW>, <nH> )

Descrição do erro: Erro BASE/1004 Class: 'NIL' has no exported method: SAYLOGO

Code: Select all Collapse

   // SayLogo
   oReport:SayLogo( 1.00, 600, "LOGO.JPG", 650, 650 )

Gracias, tks.

Regards, saludos.

João Santos - São Paulo - Brasil - Phone: +55(11)95150-7341

FiveTech Support Forums

REPORT: Vía Inteligencia Artificial.

Re: REPORT: Vía Inteligencia Artificial.

Re: REPORT: Vía Inteligencia Artificial.

Re: REPORT: Vía Inteligencia Artificial.

Re: REPORT: Vía Inteligencia Artificial.

Re: REPORT: Vía Inteligencia Artificial.

Re: REPORT: Vía Inteligencia Artificial.

Continue the discussion