PC Toledo

ola pessoal, estou imprimindo relatorio em arquivo txt pelo WIN32PRN, esta funcionando tudo certo, mas agora eu preciso imprimir o logotipo da empresa no cabecalho e encontrei essa rotina aqui no forum, mas esta dando erro na linha destacada, espero que essas informacoes sejam suficientes para alguem poder me ajudar, obrigado.

Código: Selecionar todos

STATIC PROCEDURE CABECALHO
   local cPrinter
   local oPrinter := Win32BMP():New(cPrinter)
   SET DEVICE TO PRINT
   SET PRINT ON
   SET PRINT TO C:\ESTOQUE\TESTE.TXT
   SETPRC(0,0)
   PrintBitMap(oPrinter, "C:\ESTOQUE\LOGOTIPO.png") <-- aqui eu quero imprimir o logotipo da empresa
   @ contl,01 SAY NOMEEMP         PICT "@!"
   @ contl,06 SAY END                  PICT "@!"
   Return

PROCEDURE PrintBitMap( oPrn, cBitFile )
     local oBMP
     IF Empty( cBitFile )
        *
     ELSEIF ! hb_FileExists( cBitFile )
        Alert( cBitFile + " not found " )
     ELSE
        IF FILE ( cBitFile )
           oBmp := Win32BMP():New()
           oBmp:loadFile( cBitFile )
           // coordenadas e tamanho de impressao do logo
           oBmp:Draw( oPrn, { 100, 100, 200, 150 } ) [b]<-- Warning Base/1004 message not found: WIN32BMP DRAWBITMPA[/b]
        ENDIF
        oBMP:Destroy()
     ENDIF
     RETURN

porter escreveu:PrintBitMap(oPrinter, "C:\ESTOQUE\LOGOTIPO.png")

porter escreveu:oBmp := Win32BMP():New()

Você está tentando imprimir um arquivo PNG, mas a classe Win32BMP() só imprimi arquivos no formato BMP.

Abraços,

ola Toledo, estou tentando fazer com um arquivo.BMP, mas da o mesmo erro, estou gerando um arquivo TXT, tem algum problema, na compilacao da nao ocorre o erro, so ocorre na execucao do programa.
A mensagem de erro e:
Warning Base/1004 message not found: WIN32BMP: DRAWBITMAP

obrigado.

https://pctoledo.org/forum/viewto ... f=4&t=7909

https://pctoledo.org/forum/viewto ... f=4&t=9920

boa noite Kapiaba, entrei no topico que voce sugeriu, e copiei a rotina para dentro dos meus fontes para fazer um teste, e o erro esta dando na mesma rotina com a mesma mensagem de erro: Warning Base/1004 message not found:WIN32BMP.

comando do topico sugerido
oBmp:Draw( oPrn, { 200,10000, 1000, 750 } ) <-- erro nessa linha na hora da execucao do sistema.

nos meus fontes
oBmp: draw(oPrn, {100, 100, 200, 150} )

estou compilando com a seguinte versao:
xHarbour Compilar build 1.2.1(Simplex) (Rev. 6633)
Borland C++ 5.5.1 for win32

obrigado.

porter escreveu:STATIC PROCEDURE CABECALHO
local cPrinter
local oPrinter := Win32BMP():New(cPrinter)

Amigo, este seu código da mensagem inicial deste tópico está meio estranho, no comando acima o correto é usar a função Win32PRN(), mas para criar este objeto você tem que passar o nome de uma impressora instalada no Windows, então cPrinter teria que ter o nome da impressora.
Outra coisa estranha e você estar usando os comandos SET PRINT TO C:\ESTOQUE\TESTE.TXT, misturando comandos da Win32Prn com comandos para criar um arquivo TXT, isto não vai dar certo.

porter escreveu:estou compilando com a seguinte versao:
xHarbour Compilar build 1.2.1(Simplex) (Rev. 6633)
Borland C++ 5.5.1 for win32

Bom, acho que a classe Win32Prn é nativa do xHarbour, então não teria problema algum em compilar com esta versão do xHarbour.

Agora só uma observação, na minha mensagem anterior eu disse que a classe Win32BMP() só aceitava arquivos no formato BMP. No xHarbour acho que é isto mesmo, apenas arquivos BMP, mas olhando os fontes do Harbour 3.2 (\contrib\hbwin\win_tbmp.prg) aceita arquivos BMP, JPEG e PNG.

Porter, veja novamente os links postados pelo nosso amigo Kapiaba ou clique nestas tags: Win32PRN Win32BMP

Abraços,

Bom dia, veja se este exemplo te ajuda:

Código: Selecionar todos

/*
 * $Id: testw32p.prg 8142 2007-12-05 08:17:30Z vszakats $
 */

#define FORM_A4 9

#define PS_SOLID            0

#define RGB( nR,nG,nB )   ( nR + ( nG * 256 ) + ( nB * 256 * 256 ) )

#define BLACK          RGB( 0x0 ,0x0 ,0x0  )
#define BLUE           RGB( 0x0 ,0x0 ,0x85 )
#define GREEN          RGB( 0x0 ,0x85,0x0  )
#define CYAN           RGB( 0x0 ,0x85,0x85 )
#define RED            RGB( 0x85,0x0 ,0x0  )
#define MAGENTA        RGB( 0x85,0x0 ,0x85 )
#define BROWN          RGB( 0x85,0x85,0x0  )
#define WHITE          RGB( 0xC6,0xC6,0xC6 )

PROCEDURE Main()

   LOCAL nPrn := 1
   LOCAL cBMPFile := Space( 40 )
   LOCAL aPrn := GetPrinters()
   LOCAL GetList := {}

   CLS

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

   DO WHILE nPrn != 0
      CLS
      @ 0, 0 SAY "Win32Prn() 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 )
      ENDIF
   ENDDO

   RETURN

STATIC PROCEDURE PrnTest( cPrinter, cBMPFile )

   LOCAL oPrinter := Win32Prn():New( cPrinter )
   LOCAL aFonts
   LOCAL x
   LOCAL nColFixed
   LOCAL nColTTF
   LOCAL nColCharSet

   oPrinter:Landscape := .F.
   oPrinter:FormType  := FORM_A4
   oPrinter:Copies    := 1

   IF !oPrinter:Create()
      Alert( "Cannot Create Printer" )
   ELSE
      IF !oPrinter:startDoc( "Win32Prn(Doc name in Printer Properties)" )
         Alert( "StartDoc() failed" )
      ELSE
         oPrinter:SetPen(PS_SOLID, 1, RED)
         oPrinter:Bold(800)
         oPrinter:TextOut(oPrinter:PrinterName+": MaxRow() = "+STR(oPrinter:MaxRow(),4)+"   MaxCol() = "+STR(oPrinter:MaxCol(),4))
         oPrinter:Bold(0)     // Normal
         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() - 10  // Could use "oPrinter:NewPage()" to start a new page
                     EXIT
                  ENDIF
               ENDIF
            ENDIF
            oPrinter:Line(0, oPrinter:PosY+5, 2000, oPrinter:PosY+5)
         NEXT x
         oPrinter:SetFont("Lucida Console",8,{3,-50})  // Alternative Compressed print
         oPrinter:CharSet(0)  // Reset default charset
         oPrinter:Bold(800)
         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(0)
         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")
         oPrinter:NewLine()
         oPrinter:NewLine()
         oPrinter:SetFont("Lucida Console",18, 0)  // Large print
         oPrinter:SetColor( 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, 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 !File( cBitFile )
      Alert( cBitFile + " not found " )
   ELSE
      oBMP := Win32BMP():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

Olá, testei em FWH e xHarbour e funcionou perfeito.

http://fivewin.com.br/index.php?/topic/ ... -win32prn/

Abs,

olá, o primeiro exemplo que você me passou, eu compilei ele em outra pasta fora do sistema para teste, e imprimiu corretamente o logotipo.bmp, só que imprimiu muito grande, agora eu vou ver como que faz para diminuir o tamanho e tentar adequa-lo ao meu sistema, assim que eu fizer eu retorno com o resultado.

abç kapiaba, e obrigado por sua atenção.

uso assim

if NFB_grafica = .t. && Pedido Grafica em A4
_PrintBitMap( oPrinter )
else
static function _PrintBitMap( oPrn ) //função para imprimir imagem do logotipo
LOCAL oBMP

xlogo_bmp = "\dbdc\logo\logo.bmp"

if File(xlogo_bmp)
if pfig_ci > 0

oBMP:= Win32BMP():new()
oBmp:loadFile( xlogo_bmp )
* C I , L I , C F , Tamanho (linhas)
xpulo_image = 0
oBmp:Draw( oPrn, { pfig_ci, xpulo_image+pfig_li, pfig_cf, pfig_lf } )

oBMP:Destroy()

emprimiu_logo = .t.

endif

if val(plargura) > 2
xxx_largura = val(plargura)
else
xxx_largura = 3
endif

if pfaz_dav = .t.
* a IMAGEM fica a esquerda do cabecalho NAO precisando avancar
else
for x_lar = 1 to xxx_largura
oPrinter:NewLine()
next
endif
endif

RETURN

olá, imprimi no meu sistema, o primeiro exemplo que você passou, só que imprime o logotipo e junto varios nomes de fontes que ocupa a folha inteira e o meu relatorio só sai na segunda folha, tente imprimir um logotipo com estensao png mas não imprime, mas com extensão bmp da certo, o problema que está acontecendo é esse de imprimir na primeira folha, o logotipo e o nome de fontes que ocupa a folha inteira.

Olá Porter,

Se você já ajustou o exemplo do colega Kapiaba e deu certo, então apenas limpe os códigos que imprimem os exemplos de fontes. Para isso, faça um teste trocando sua função STATIC PROCEDURE PrnTest( cPrinter, cBMPFile ) da seguinte forma e acho que vai funcionar:

Código: Selecionar todos

STATIC PROCEDURE PrnTest( cPrinter, cBMPFile )

   LOCAL oPrinter := Win32Prn():New( cPrinter )

   oPrinter:Landscape := .F.
   oPrinter:FormType  := FORM_A4
   oPrinter:Copies    := 1

   IF !oPrinter:Create()
      Alert( "Cannot Create Printer" )
   ELSE
      IF !oPrinter:startDoc( "Win32Prn(Doc name in Printer Properties)" )
         Alert( "StartDoc() failed" )
      ELSE

         PrintBitMap( oPrinter, cBMPFile )
         
         oPrinter:EndDoc()
      ENDIF
      oPrinter:Destroy()
   ENDIF

   RETURN

olá Jairo, agora deu certo com essa rotina que você passou, imprimiu corretamente, agora eu preciso ver se o posicionamento e o tamanho do logotipo são definidos dentro do sistema, ou se o tamanho é definido quando se desenha o logotipo, no meu caso estou fazendo no Power Point, é a primeira vez que faço portanto não sei se é a melhor maneira de criar um logotipo.

obrigado.

Olá Porter,

porter escreveu:agora eu preciso ver se o posicionamento e o tamanho do logotipo são definidos dentro do sistema, ou se o tamanho é definido quando se desenha o logotipo

Ambas coisas. Depende muito de como você quer seu logotipo no formulário. Desenhe-o com a proporção desejada e depois ajuste no sistema na função de impressão.

De uma forma simplificada para seu caso, apenas ajuste por tentativa-e-erro esta linha: oBmp:Draw( oPrn, { 200, 200, 2000, 1500 } ), na função: PrintBitMap().

Quanto a melhor forma de você criar seu logo, não tenho opinião, mas se está funcionando assim, siga em frente.

PC Toledo

erro ao imprimir logotipo em relatorio

erro ao imprimir logotipo em relatorio

erro ao imprimir logotipo em relatorio

erro ao imprimir logotipo em relatorio

erro ao imprimir logotipo em relatorio

erro ao imprimir logotipo em relatorio

erro ao imprimir logotipo em relatorio

erro ao imprimir logotipo em relatorio

erro ao imprimir logotipo em relatorio

erro ao imprimir logotipo em relatorio

erro ao imprimir logotipo em relatorio

erro ao imprimir logotipo em relatorio

erro ao imprimir logotipo em relatorio

erro ao imprimir logotipo em relatorio

erro ao imprimir logotipo em relatorio

erro ao imprimir logotipo em relatorio