Página 1 de 1

Problemas Cabeçalho e Rodapé - II

Enviado: 03 Fev 2010 08:33
por EANDRIOLI
Amigos...

estou com problemas na impressão via WIN32PRN e passo a segui os fontes do .prg gerador do relatorio e .prg onde há instruções pela function que faz o envio para o Win:

Código: Selecionar todos

*********************
PROCEDURE EXT_IMPR
*********************
WIN(12,13,17,64,"AGUARDE!!! IMPRIMINDO...","GR+/N","N+/W")
FRAME(14,14,16,63)

arq_x ="C:\TEMP\"+LEFT(TIME(),2)+RIGHT(LEFT(TIME(),5),2)+RIGHT(TIME(),2)+"SI"
SET DEVICE TO PRINTER
SET PRINTER TO &arq_x

SELE VEI

IF V_FABRICA <> " "
   SET FILTER TO VENDIDO ="N" .AND. FABRICANTE=V_FABRICA // Filtra p/ Mostrar Somente os NAO VENDIDOS...
ELSE
   SET FILTER TO VENDIDO ="N"                            // Filtra p/ Mostrar Somente os NAO VENDIDOS...
ENDIF
DBGOTOP()

*--------------------------------------------
* Inicio da Impressao do Extrato...
*--------------------------------------------

P      = 1
PAGINA = 1
AUTOS  = 0
ACUMVLR= 0
INIFAB = 0       // Para controlar o titulo dos Fabricantes... Vale 0 ou 1
control= 0
tpcond1= 0  // N o v o
tpcond2= 0  // U s a d o 
tpcond3= 0  // C o n s i g n a d o 
tpcond4= 0  // O u t r o s
numtp1 = 0
numtp2 = 0
numtp3 = 0
numtp4 = 0

DO WHILE .NOT. EOF()

   SET DEVICE TO SCREEN
   v_ult:=len(directory("*.DBF","H"))
   v_por:=control * 100 / v_ult
   control++
   @15,15+(v_por/2) SAY "±" COLOR("BG+/W")
   SET DEVICE TO PRINTER

   IF PROW() = 0
      @PROW()+1,00 SAY REPLICATE("=",130)
      @PROW()+1,00 SAY "SIGARA"

      vtab = (130-LEN(RTRIM(empresa)))/2
      * Centraliza o texto do aviso na tela
      @prow(),vtab SAY empresa

      @PROW(),120  SAY DATE()
      @PROW()+1,00 SAY "Versao 1.0"
      @PROW(),45   SAY sistema
      @PROW(),122  SAY TIME()
      @PROW()+1,00 SAY REPL("=",130)
      @PROW()+1,50 SAY "EXTRATO DE VEICULOS EM ESTOQUE"
      @PROW()+1,00 SAY REPL("-",130)

      @PROW()+1,0 SAY "CODIGO"
      @PROW(),08  say "AQUISICAO"
      @PROW(),20  say "MODELO"
      @PROW(),50  say "ANO"
      @PROW(),61  say "COR"
      @PROW(),75  say "PLACA"
      @PROW(),85  say "COMB"
      @PROW(),90  say "ORIGEM"
      @PROW(),110 say "VLR VENDA-R$"
      @PROW(),127 SAY "ST"
      @PROW()+1,00 SAY REPL("-",130)
   ENDIF

   IF DATA < DTINIC
      DBSKIP()
      LOOP
   ENDIF

   IF DATA > DTFINI
      DBSKIP()
      LOOP
   ENDIF

   * Memorizando o Combustivel...
   IF     t_combust='1'
      combust='ALCOOL   '
   ELSEIF t_combust='2'
      combust='GASOLINA '
   ELSEIF t_combust='3'
      combust='DIESEL   '
   ELSEIF t_combust='4'
      combust='A/G FLEX '
   ELSEIF t_combust='5'
      combust='OUTROS   '
   ENDIF

   * Memorizando o Fabricante...
   V_FABRICA=FABRICANTE
   IF     V_FABRICA='1'
      fabrica='VOLKSWAGEM'
   ELSEIF V_FABRICA='2'
      fabrica='CHEVROLET '
   ELSEIF V_FABRICA='3'
      fabrica='FIAT      '
   ELSEIF V_FABRICA='4'
      fabrica='FORD      '
   ELSEIF V_FABRICA='5'
      fabrica='MOTOS     '
   ELSEIF V_FABRICA='6'
      fabrica='OUTROS    '
   ELSEIF V_FABRICA='7'
      fabrica='RENAULT   '
   ELSEIF V_FABRICA='8'
      fabrica='HONDA     '
   ELSEIF V_FABRICA='9'
      fabrica='TOYOTA    '
   ENDIF

   IF INIFAB = 0
      @PROW()+1,0 SAY ''
      @PROW()+1,0 SAY "FABRICANTE -> "+FABRICANTE+" - "+FABRICA
   ENDIF

   @PROW()+1,00 say STRZERO(codigo,6,0)
   @PROW(),08 say data
   @PROW(),20 say modelo
   @PROW(),50 say ano
   @PROW(),61 say LEFT(cor,10)
   @PROW(),75 say placa
   @PROW(),85 say left(combust,3)

   origem2 = compra_de
   SELE CLI
   DBGOTO(origem2)
   @PROW(),90 say LEFT(nome,20)

   SELE VEI
   @PROW(),114 say vlr_venda pict "999,999.99"
   @PROW(),127 SAY SUBS(condicao,1,3)

   AUTOS=AUTOS+1
   ACUMVLR=ACUMVLR+VLR_VENDA

   // Controle da Condi‡ao do Veiculo (Situacao = LOJA - CONSIGNADO...)
   if  condicao    = "LOJA"
       tpcond1 = tpcond1 + vlr_venda
       numtp1++
   elseif condicao = "CONSIGNADO"
       tpcond2 = tpcond2 + vlr_venda
       numtp2++
   elseif condicao = "TERCEIROS"
       tpcond3 = tpcond3 + vlr_venda
       numtp3++
   elseif condicao = "OUTROS"
       tpcond4 = tpcond4 + vlr_venda
       numtp4++
   endif

   DBSKIP()

   IF V_FABRICA <> FABRICANTE
      INIFAB=0
   ELSE
      INIFAB=1
   ENDIF

   IF PROW() = 57  .OR. PROW() > 57
      @PROW()+1,0 SAY REPL("=",130)
      @PROW()+1,0 SAY eu+mfone+SPACE(10)+" Emitido por: "+usuario_m
      @prow(),121 SAY "Pag.: "+ STRZERO(PAGINA,3,0)
      @prow()+1,0 SAY repl("=",130)
      PAGINA++
      * EJECT
      SETPRC(0,0)
   ENDIF

ENDDO

@PROW()+2,0 SAY "QUANTIDE DE VEICULOS: "+STR(AUTOS)
@PROW(),90  SAY "TOTAL DO ESTOQUE:"
@PROW(),111 SAY ACUMVLR PICT "99,999,999.99"

@PROW()+2,08 SAY "SITUAۂO DO ESTOQUE DE VEICULOS:"
@PROW()+1,20 SAY "LOJA.......: "+TRANS(numtp1,"999")+" -> "+TRANS(tpcond1,"99,999,999.99")
@PROW()+1,20 SAY "CONSIGNADOS: "+TRANS(numtp2,"999")+" -> "+TRANS(tpcond2,"99,999,999.99")
@PROW()+1,20 SAY "TERCEIROS..: "+TRANS(numtp3,"999")+" -> "+TRANS(tpcond3,"99,999,999.99")
@PROW()+1,20 SAY "OUTROS.....: "+TRANS(numtp4,"999")+" -> "+TRANS(tpcond4,"99,999,999.99")

DO WHILE PROW() < 57
   @PROW()+1,0 SAY ""
ENDDO

@PROW()+1,0 SAY REPL("=",130)
@PROW()+1,0 SAY eu+mfone+SPACE(10)+" Emitido por: "+usuario_m
@prow()+1,0 SAY repl("=",130)

* EJECT
SET DEVICE TO SCREEN
SET PRINTER TO
* Salvar o caminho...
csDir:=CURDRIVE()+":\"+CURDIR()
CHAMAIMP()   // somente para Xharbour
DIRCHANGE(csDir)
*DELETEFILE(arq_x+".PRN")
RSTENV(TEL)
RETURN

Vejam voces que eu retirei o EJECT no prg gerador... mesmo assim, quando o arquivo é impresso (fiz teste em arquivo .PDF), a primeira folha e a segunda saem ok, e a partir da terceira o cabeçalho começa a sair errado, começa a adiantar, saindo no fim da folha anterior. Façam o teste pra voces verem.

Acredito que o problema seja no .prg da rotina de impressão que passo a seguir. Ainda nao consegui compreender se faço as rotinas de cabeçalho/rodapé no .prg gerador ou na rotina de impressão win32prn. Opinem por favor.

Eu gostaria de manter o .prg gerador do relatorio como está, apenas aperfeiçoando o cabeçalho e rodape. Estou usando o SETPRC(0,0) para testar se imprimo ou nao o cabeçalho.

Segue rotina do win32prn:

Código: Selecionar todos

************* 
FUNC CHAMAIMP
************* 
LOCAL aINCCLI
Private nPrn    := 1 
Private aPrn    := GetPrinters() // Detecta impressoras instaladas
PARA COP    // S = IMPRESSAO EM 136 COL.   N = IMPRESSAO EM 79COL. 
TAM = "S"
If Empty(aPrn)
   wvt_messagebox("Nao foi encontrada nenhuma impressora instalada, Favor verificar !!!","ATENCAO !!!",48) 
   Return 
else 
   aINCCLI:= nbox(10,39,24,68,"n+/b",.F.) 
   @ 11,43 say "Selecione a impressora" colo "w+/b"
   @ 23,50 say "ESC - VOLTA" colo "n+/b"
   SETCOLOR( "w/b,n/gr*,,,n*/w" ) 
   nPrn:= ACHOICE(13,40,22,67,aPrn,.T.,,nPrn)  // LISTA DE IMPRESSORAS 
EndIf 
if lastkey() = K_ESC
   RstEnv(aINCCLI) 
   RETURN NIL 
endif   
IF TAM="S" 
   IF !EMPTY(nPrn) 
      Imprime(ARQ_X+".PRN",136,aPrn[nPrn]) 
   ENDIF 
ELSE 
   IF !EMPTY(nPrn) 
      Imprime(ARQ_X+".PRN",80,aPrn[nPrn]) 
   ENDIF 
ENDIF 
RstEnv(aINCCLI) 
RETURN NIL 

**************************** 
STATIC FUNC Imprime( cArq, tamrel ,cPrinter ) 
**************************** 
local cTexto, nLinhas, nA, cLinha

LOCAL oPrinter := Win32prn():New(cPrinter)
cText := memoread ( cArq )
oPrinter:Landscape := .F.
oPrinter:FormType  := 9   // Usar 9 para A4
oPrinter:SetPrintQuality(-1)    // qualidade da impressao
oPrinter:Copies    := 1

IF !oPrinter:Create() 
   wvt_messagebox("Nao foi encontrada nenhuma impressora instalada, Favor verificar !!!","ATENCAO !!!",48) 
   return NIL
ELSEIF !oPrinter:StartDoc("ErasmoAndrioli Sistemas") // MENSAGEM NO SPOOL 
   wvt_messagebox("Problema ao Imprimir....Favor Verificar a Impressora "+ aPrn[nPrn] ,"ATENCAO !!!",48) 
   return NIL
endif 

FOR TT=1 TO 2
    oPrinter:newline()
NEXT

IF tamrel > 80 
   oPrinter:setfont('Courier New',13,{3,-50},0,.F.,.F.) 
   nLines2 := 150
else
   oPrinter:setfont('Courier New',,12,,,,255)
   nLines2 := 85
endif
oPrinter:Bold(0)  //  normal

nLines := mlcount( cText, nLines2 )
nConta  := 0 

for nA := 1 to nLines
    cLine := memoline ( cText, nLines2, nA, 1, .F. )

    IF nConta = tlinpag  // QUANDO CHEGAR NO FINAL DA PAGINA 
       oPrinter:NewPage()
       FOR TT = 1 TO 3
          oPrinter:newline()
       NEXT
    endif

    nConta=nConta+1

    oPrinter:TextOut ( cLine, .T. )
    oPrinter:Bold(0)  //  Normal

    if ( oPrinter:MaxRow()-2 ) <= oPrinter:Prow()
       oPrinter:NewPage()
       FOR TT = 1 TO 3
           oPrinter:newline()
       NEXT
    endif

next
oPrinter:EndDoc()
oPrinter:Destroy() 

RETURN NIL
Obrigado pelo apoio que sei que terei como sempre!!!

Erasmo

Re: Problemas Cabeçalho e Rodapé - II

Enviado: 04 Fev 2010 11:43
por Itamar M. Lins Jr.
Não tem como sair errado.
Porque ao receber o comando "oPrinter:NewPage()" as impressoras ejetam a folha.
Veja se esse código ajuda em algo.

Código: Selecionar todos

#include "common.ch"
#include "hbwin.ch"

PROCEDURE Main( cPar1 )
   LOCAL nPrn := 1
   LOCAL cBMPFile := Space( 40 )
   LOCAL aPrn := WIN_PRINTERLIST()
   LOCAL GetList := {}

   CLS

   IF Empty( aPrn )
      Alert("No printers installed - Cannot continue")
      QUIT
   ENDIF

   DO WHILE nPrn != 0
      CLS
      @ 0, 0 SAY "Win_Prn() Class test program. Choose a printer to test"
      @ 1, 0 SAY "Bitmap file name" GET cBMPFile PICT "@K"
      READ
      @ 2, 0 TO MaxRow(), MaxCol()
      nPrn := AChoice( 3, 1, MaxRow() - 1, MaxCol() - 1, aPrn, .T.,, nPrn )
      IF nPrn != 0
         PrnTest( aPrn[ nPrn ], cBMPFile, iif( ISCHARACTER( cPar1 ) .AND. Lower( cPar1 ) == "ask", .T., NIL ) )
      ENDIF
   ENDDO

   RETURN

STATIC PROCEDURE PrnTest( cPrinter, cBMPFile, lAsk )
   LOCAL oPrinter := Win_Prn():New( cPrinter )
   LOCAL aFonts
   LOCAL x
   LOCAL nColFixed
   LOCAL nColTTF
   LOCAL nColCharSet

   oPrinter:Landscape := .F.
   oPrinter:FormType  := WIN_DMPAPER_A4
   oPrinter:Copies    := 1
   IF ISLOGICAL( lAsk )
      oPrinter:AskProperties := lAsk
   ENDIF

   IF ! oPrinter:Create()
      Alert( "Cannot Create Printer" )
   ELSE
      IF ! oPrinter:startDoc( "Win_Prn(Doc name in Printer Properties)" )
         Alert( "StartDoc() failed" )
      ELSE
         oPrinter:SetPen( WIN_PS_SOLID, 1, HB_WIN_RGB_RED )
         oPrinter:Bold( WIN_FW_EXTRABOLD )
         oPrinter:TextOut( oPrinter:PrinterName + ": MaxRow() = " + Str( oPrinter:MaxRow(), 4 ) + "   MaxCol() = " + Str( oPrinter:MaxCol(), 4 ) )
         oPrinter:Bold( WIN_FW_DONTCARE )
         oPrinter:NewLine()
         oPrinter:TextOut("   Partial list of available fonts that are available for OEM_")
         oPrinter:NewLine()
         oPrinter:UnderLine( .T. )
         oPrinter:Italic( .T. )
//       oPrinter:SetFont( "Courier New", 7, { 3, -50 } )  // Compressed print
         nColFixed   := 40 * oPrinter:CharWidth
         nColTTF     := 48 * oPrinter:CharWidth
         nColCharSet := 60 * oPrinter:CharWidth
         oPrinter:TextOut( "FontName" )
         oPrinter:SetPos( nColFixed )
         oPrinter:TextOut( "Fixed?" )
         oPrinter:SetPos( nColTTF )
         oPrinter:TextOut( "TrueType?" )
         oPrinter:SetPos( nColCharset )
         oPrinter:TextOut( "CharSet#", .T. )
         oPrinter:NewLine()
         oPrinter:Italic( .F. )
         oPrinter:UnderLine( .F. )
         aFonts := oPrinter:GetFonts()
         oPrinter:NewLine()
         FOR x:= 1 TO Len( aFonts ) STEP 2
            oPrinter:CharSet( aFonts[ x, 4 ] )
            IF oPrinter:SetFont( aFonts[ x, 1 ] )       // Could use "IF oPrinter:SetFontOk" after call to oPrinter:SetFont()
               IF oPrinter:FontName == aFonts[ x, 1 ]  // Make sure Windows didn't pick a different font
                  oPrinter:TextOut( aFonts[ x, 1 ] )
                  oPrinter:SetPos( nColFixed )
                  oPrinter:TextOut( iif( aFonts[ x, 2 ], "Yes", "No" ) )
                  oPrinter:SetPos( nColTTF )
                  oPrinter:TextOut( iif( aFonts[ x, 3 ], "Yes", "No" ) )
                  oPrinter:SetPos( nColCharSet )
                  oPrinter:TextOut( Str( aFonts[ x, 4 ], 5 ) )
                  oPrinter:SetPos( oPrinter:LeftMargin, oPrinter:PosY + ( oPrinter:CharHeight * 2 ) )
                  IF oPrinter:PRow() > oPrinter:MaxRow() - 16  // Could use "oPrinter:NewPage()" to start a new page
                     EXIT
                  ENDIF
               ENDIF
            ENDIF
            oPrinter:Line( 0, oPrinter:PosY + 5, 2000, oPrinter:PosY + 5 )
         NEXT
         oPrinter:SetFont( "Lucida Console", 8, { 3, -50 } )  // Alternative Compressed print
         oPrinter:CharSet( 0 )  // Reset default charset
         oPrinter:Bold( WIN_FW_EXTRABOLD )
         oPrinter:NewLine()
         oPrinter:TextOut( "This is on line" + Str( oPrinter:Prow(), 4 ) + ", Printed bold, " )
         oPrinter:TextOut( " finishing at Column: " )
         oPrinter:TextOut( Str( oPrinter:Pcol(), 4 ) )
         oPrinter:SetPrc( oPrinter:Prow() + 3, 0 )
         oPrinter:Bold( WIN_FW_DONTCARE )
         oPrinter:TextOut( "Notice: UNDERLINE only prints correctly if there is a blank line after", .T. )
         oPrinter:TextOut( "        it. This is because of :LineHeight and the next line", .T. )
         oPrinter:TextOut( "        printing over top of the underline. To avoid this happening", .T. )
         oPrinter:TextOut( "        you can to alter :LineHeight or use a smaller font, or use :SetBkMode( WIN_TRANSPARENT )" )
         oPrinter:NewLine()
         oPrinter:NewLine()
         oPrinter:SetFont( "Lucida Console", 18, 0 )  // Large print
         oPrinter:SetColor( HB_WIN_RGB_GREEN )
         oPrinter:TextOut( "Finally some larger print" )
         oPrinter:Box(   0, oPrinter:PosY + 100, 100, oPrinter:PosY + 200 )
         oPrinter:Arc( 200, oPrinter:PosY + 100, 300, oPrinter:PosY + 200 )
         oPrinter:Ellipse( 400, oPrinter:PosY + 100, 500, oPrinter:PosY + 200 )
         oPrinter:FillRect( 600, oPrinter:PosY + 100, 700, oPrinter:PosY + 200, HB_WIN_RGB_RED )

//       To print a barcode;
//       Replace 'BCod39HN' with your own bar code font or any other font
//         oPrinter:TextAtFont( oPrinter:MM_TO_POSX( 30 ), oPrinter:MM_TO_POSY( 60 ), "1234567890", "BCod39HN", 24, 0 )
//
         PrintBitMap( oPrinter, cBMPFile )

         oPrinter:EndDoc()
      ENDIF
      oPrinter:Destroy()
   ENDIF

   RETURN

STATIC PROCEDURE PrintBitMap( oPrn, cBitFile )
   LOCAL oBMP

   IF Empty( cBitFile )
      *
   ELSEIF ! hb_FileExists( cBitFile )
      Alert( cBitFile + " not found " )
   ELSE
      oBMP := Win_BMP():New()
      IF oBmp:loadFile( cBitFile )

         oBmp:Draw( oPrn, { 200, 200, 2000, 1500 } )

         // Note: Can also use this method to print bitmap
         //   oBmp:Rect := { 200, 200, 2000, 1500 }
         //   oPrn:DrawBitMap( oBmp )

      ENDIF
      oBMP:Destroy()
   ENDIF

   RETURN
IF oPrinter:PRow() > oPrinter:MaxRow() - 16 // Could use "oPrinter:NewPage()" to start a new page
EXIT
ENDIF


Saudações,
Itamar M. Lins Jr.

Saudações,
Itamar M. Lins Jr.

Re: Problemas Cabeçalho e Rodapé - II

Enviado: 08 Fev 2010 21:30
por sygecom
Não revisei sua rotina, mas tentou imprimir direto em impressora normal sem ser PDF, ou se for em PDF tente tirar fora o:
oPrinter:SetPrintQuality(-1)
E teste novamente.