Negritos, sublinhados, itálicos e assemelhados

[lugab]

Ola , masters do fórum.

Eu uso o win32prn() pra imprimir meus arquivos textos em tudo que é tipo de impressora (laser, jato de tinta, matricial lentona,etc) ,e de tudo que é marca (samsumg, HP, epson,etc).

A vezes eu sinto necessidade de jogar um negrito, itálico ou expandido , em apenas uma das linhas do relatório , como eu fazia antes no clipper, com as matricias da epson.

Hoje, com o win32prn() imprimindo em tudo q é tipo/marca de impressora, eu não sei mais por onde fazer isso acontecer e sequer faço a mínima idéia de "o que fazer".

Então, o que eu desejo de vcs, é algumas indicações entre as possíveis soluções, para que eu as estude e adote a menos complicada de todas.

Grato a todos,

Gabriel

[Toledo]

Gabriel, com a Win32prn você pode usar a função SetFont():

Código: Selecionar todos

oPrinter:setFont(<cFontName>,<nPointSize>,<nFontWidth>,<nFontWeight>,<lUnderline>,<lItalic>,<nCharSet>)

<nFontWeight>
Aqui você vai controlar a intensidade da fonte. Para negrito você pode usar o valor 700 ou 800.

<lUnderline>
Valor lógico que determina o modo sublinhado. O valor .T. para sublinhar, se omitido ou .F. o texto será em modo normal.

<lItalic>
Valor lógico que determina o modo itálico. O valor .T. para itálico, se omitido ou .F. o texto será em modo normal.

Exemplo de negrito:

Código: Selecionar todos

oPrinter:SetFont( 'Courier New',12,{3,-55},700,.F.,.F. )

Exemplo de negrito com sublinhado:

Código: Selecionar todos

oPrinter:SetFont( 'Courier New',12,{3,-55},700,.T.,.F. )

Exemplo de itálico:

Código: Selecionar todos

oPrinter:SetFont( 'Courier New',12,{3,-55},0,.F.,.T. )

Abraços,

[lugab]

Olha só !

Legal, Toledo. aprendi mais uma.

Mas no caso, não é bem isso o que eu preciso.

Essas dicas no win32prn() resolveria o meu problema, se eu fosse utilizar essa "maquiagem" em todas as linhas do relatório, e não em uma ou outra linha, como é o q eu preciso.

É que, pelo que eu entendi do win32prn() , ele recebe o arquivo texto completo e imprime ele completo, e se a gente programar alguma mudança nas linhas do texto, a mudança funcionará para todas as linhas do relatório e não para uma ou outra linha, como , por exemplo, eu quero as linhas do cabeçalho em negrito e o resto das linhas ser em normal.

Veja abaixo o meu código:

Código: Selecionar todos

Set device to printer  
Set printer to C:\SIG.TXT
Set printer off
Set printer to
Set devi to scree

If xGetImp()
    Auximp=alltrim(upper(aPrn[nPrn]))
    ImpWinPrint(aPrn[nPrn],"C:\SIG.TXT")	 
Endif

[anacatacombs]

Você pode usar a função do win32prn que imprime linha a linha e fazer esse tratamento em alguma função, colocando uma tag especial para negrito, sublinhado etc etc etc.. aí vc pode imprimir o texto e alterar a configurações, depois imprimir novamente.
Parece meio gambiarra, mas é uma solução que vai resolver seu problema.

Se eu não me engano é a função:
:TextOutAt()

[]'s

Ana

[Toledo]

Gabriel, pensei que você estava montando as linhas do seu relatório diretamente com os comandos da win32prn, mas pelo que pude notar você gera o TXT primeiro e depois usa a sua função ImpWinPrint() para imprimir o arquivo gerado. Bom, desta maneira você teria que colocar alguma tag no seu TXT para saber onde seria impresso o texto em negrito, itálico e sublinhado, ai na sua função ImpWinPrint() capturar o texto entre as tags e setar com a função setFont() o modo de impressão.

Poste aqui a sua função ImpWinPrint() atualizada, bem como as outras funções usadas nesta sua função. Vamos ver o que a gente consegui fazer!

Abraços,

[Toledo]

hahahahaha... agora que notei a mensagem da Ana... quando comecei a editar a minha mesagem acima, a Ana ainda não tinha postado a mensagem dela... mas como sou meio lerdo (tive que sair logo que comecei a editar a mensagem), terminei só agora depois que voltei.

[lugab]

Eu sabia, Toledo e Ana, que era eu quem estava usando errado...

Abaixo os códigos pedidos, q eu peguei aqui mesmo no fórum.

Espero que dê para enviar linha-a-linha pro win32prn(), pq ai sim, vai dar pra formatar cada uma delas com o padrão que eu quiser

Código: Selecionar todos

*----------------------------------------
Func Imprime
Local tela,resp,aimp,aimp2:={},i

Set device to printer  
Set printer to C:\SIG.TXT
@ L,c say cabec1
@ L+1,c say cabec2
@ L+1,c say cabec3
@ L+1,c say detalhe1
@ L+1,c say detalhe2
@ L+1,c say detalhe3
etc
(fim de garação de txt)

Set printer off
Set printer to
Set devi to scree
If xGetImp()
      Auximp=alltrim(upper(aPrn[nPrn]))
      If Paisagem
         ImpWinPrint(aPrn[nPrn],"C:\SIG.TXT")	 
      Endif
Endif

Código: Selecionar todos

*----------------------------------------
Function impWinPrint(cPrinter,xarqtxt)
*-----------------------------------------
#define DMPAPER_A4                   9  // A4 210 x 297 mm 

LOCAL oPrinter:= Win32Prn():New(cPrinter), aFonts, x, nColFixed,nColTTF, nColCharSet
LOCAL ncarpol, i, nHandle, cString


oPrinter:FormType := 9
oPrinter:Copies   := 1
oPrinter:SetPrintQuality(-4) // qualidade da impressÆo 1 rascunho 2 normal 3 media 4melhor
If Comprimi
   oPrinter:Landscape:= .F.  && retrato
Else   
   If Paisagem
      oPrinter:Landscape:= .T. && Paisagem      
   else
      oPrinter:Landscape:= .F. && Retrato
   Endif
Endif   



IF !oPrinter:Create()
   Aviso(" Impressora nõo pode ser criada !!! ")
   return
else
   IF !oPrinter:startDoc("TPRINT("+xarqtxt+")")
     Aviso("StartDoc() Falha na Impressora !")
     oPrinter:destroy()
     return
   endif
endif

nHandle:= Fopen( Xarqtxt ) // READ
cString:= ""
xmaxLen:= 0
For I:= 1 to 10
    IF gfreadline( @cString, nHandle )
       If len( CString ) > xmaxLen
          xmaxLen:= Len( cString )
       endif
    else
       exit
    endif
next 
** tentei 10 e 10.5 em vez de 11 e comeu as ult popsicoes
If Paisagem
   ncarpol:= 11
Else   
   IF xmaxLen <= 85
       ncarpol:= 11
   Elseif Xmaxlen <= 100
       ncarpol:= 13
   Elseif Xmaxlen <= 136
       ncarpol:= 18
   Elseif Xmaxlen <= 160
       ncarpol:= 21
   Endif
Endif

Paisagem=.f.
Comprimi=.f.

oPrinter:SetFont('Courier New',,ncarpol)

fSeek( nHandle, 0 )

cString:= ""
xprow:=0
endof_file=.f.
while !endof_file
    gfreadline( @cString, nHandle )
    IF ( xpos:= AT( CHR(12), cString ) ) > 0
       cString:= LEFT( cString, xpos-1 ) + SUBS( cString, xpos + 1, LEN( cString ) )
    ENDIF
    oPrinter:TextOut(cString)
    oPrinter:NewLine()
    IF xpos > 0
       oPrinter:NewPage()
       oPrinter:SetFont('Courier New',,ncarpol)
       oPrinter:NewLine()
       xprow:=0
    ELSE
       xprow++
    ENDIF
enddo

oPrinter:EndDoc()
oPrinter:Destroy()

fclose(nHandle)

RETURN(NIL)

Código: Selecionar todos

*---------------------------
procedure gfreadline(st,handle)
*---------------------------
st=xfgetline(handle)
return .t.

Código: Selecionar todos

*----------------------------------------
function xfgetline(script)
*-------------------------
local return_lin, chunk, bigchunk, oldoffset, at_chr13
return_lin = ''
bigchunk = ''
oldoffset = fseek (script, 0, 1)
do while .t.
   chunk = ''
   chunk = freadstr (script, 100)
   if len (chunk) = 0
      endof_file = .t.
      exit
   endif
   bigchunk = bigchunk + chunk
   if at (chr (10), bigchunk) > 0
      at_chr13 = at (chr (10), bigchunk)
      fseek (script, oldoffset)
      return_lin = freadstr (script, at_chr13 - 1)
      exit
   endif
enddo
fseek (script, 1, 1)
if right(return_lin,1)=chr(13)
   return_lin:=left(return_lin,len(return_lin)-1)
end if
return return_lin

[Toledo]

Gabriel, a função xGetImp() é a mesma que está no seu tópico "Win32prn() só tem me dado dor de cabeça"?

Abraços,

[lugab]

Ah, Toledo, faltou a Xgetimp(). Eis-lo.

Código: Selecionar todos

*------------
FUNC xGetImp 
*------------
#include "BOX.CH"
#include "INKEY.CH"
#include "visual2J.ch"

Public nPrn:= 1 

Public aPrn:= GetPrinters()
If Empty(aPrn) 
   Aviso("Nao Tem nenhuma impressora Adicionada ao seu Windows  !") 
   Return .f.
else 
   Setcolor( "n/w,n*/w, , , n*/w" )
   Jankey:=  win(11,10,17,70,"Selecione Impressora ou tecle <ESC> pra desistir" )
   @ 11,10 clea to 17,70
   nPrn:=ACHOICE(12,11,16,69, aPrn,.T.,,nPrn)
   Setcolor( "n/w,n*/w, , , n*/w" )
   RstEnv(Jankey)
endIf 

if lastkey() = K_ESC
   Return .F.
endif 
Return .T.

*-------------
Func SelImpR
*--------------
IF xGetImp()
   AUXIMP=alltrim(upper(aPrn[nPrn]))
   IF AT("LX",AUXIMP)>0 .OR. AT("FX",AUXIMP)>0
      PrintFileRaw(aPrn[nPrn],"C:\SIG.TXT", TNOMUSU)
   ELSE	    
      ImpWinPrint(aPrn[nPrn],"C:\SIG.TXT")	 
   ENDIF
ELSE	 
   **ALERT("Erro na Impressao")
ENDIF	    
Retu nil
  

TA funcionando direitinho.

E resumindo , o q eu esto precisando é algo tipo abaixo:

o Cabec1 em expandido,
o Cabec2 em normal,
o cabec3 em negrito,
em seguida imprimir uma linha contínua (eu só consigo imprimir traços, desse jeito: - - - - - - - -)
e as lihas de detalhe em padrão normal...

[Toledo]

Gabriel, segue abaixo um exemplo do que você pode fazer:

Código: Selecionar todos

*----------------------------------------
Func Main()
Local tela,resp,aimp,aimp2:={},i
Paisagem=.t.
Comprimi=.f.
cabec1:="$exp$Cabecalho Expandido"
cabec2:="$ita$Cabecalho Italico"
cabec3:="$neg$Cabecalho Negrito"
detalhe1:="Linha de Detalhe Normal"
detalhe2:="$sub$Linha de Detalhe Sublinhado"
detalhe3:="Linha de Detalhe Normal"
L:=1
C:=1
nexp:=28

Set device to printer  
Set printer to C:\SIG.TXT
@ L,c say cabec1
@ L+1,c say cabec2
@ L+2,c say cabec3
@ L+3,c say "$linha$"
@ L+4,c say detalhe1
@ L+5,c say detalhe2
@ L+6,c say detalhe3
@ L+7,c say ""

Set printer off
Set printer to
Set devi to scree
If xGetImp()
      Auximp=alltrim(upper(aPrn[nPrn]))
      If Paisagem
         ImpWinPrint(aPrn[nPrn],"C:\SIG.TXT")    
      Endif
Endif
Retu Nil

*----------------------------------------
Function impWinPrint(cPrinter,xarqtxt)
*-----------------------------------------
#define DMPAPER_A4                   9  // A4 210 x 297 mm 

LOCAL oPrinter:= Win32Prn():New(cPrinter), aFonts, x, nColFixed,nColTTF, nColCharSet
LOCAL ncarpol, i, nHandle, cString


oPrinter:FormType := 9
oPrinter:Copies   := 1
oPrinter:SetPrintQuality(-4) // qualidade da impressÆo 1 rascunho 2 normal 3 media 4melhor
If Comprimi
   oPrinter:Landscape:= .F.  && retrato
Else   
   If Paisagem
      oPrinter:Landscape:= .T. && Paisagem      
   else
      oPrinter:Landscape:= .F. && Retrato
   Endif
Endif   



IF !oPrinter:Create()
   Aviso(" Impressora nõo pode ser criada !!! ")
   return
else
   IF !oPrinter:startDoc("TPRINT("+xarqtxt+")")
     Aviso("StartDoc() Falha na Impressora !")
     oPrinter:destroy()
     return
   endif
endif

nHandle:= Fopen( Xarqtxt ) // READ
cString:= ""
xmaxLen:= 0
For I:= 1 to 10
    IF gfreadline( @cString, nHandle )
       If len( CString ) > xmaxLen
          xmaxLen:= Len( cString )
       endif
    else
       exit
    endif
next 
** tentei 10 e 10.5 em vez de 11 e comeu as ult popsicoes
If Paisagem
   ncarpol:= 11
Else   
   IF xmaxLen <= 85
       ncarpol:= 11
   Elseif Xmaxlen <= 100
       ncarpol:= 13
   Elseif Xmaxlen <= 136
       ncarpol:= 18
   Elseif Xmaxlen <= 160
       ncarpol:= 21
   Endif
Endif

Paisagem=.f.
Comprimi=.f.

oPrinter:SetFont('Courier New',,ncarpol)

fSeek( nHandle, 0 )

cString:= ""
xprow:=0
endof_file=.f.
while !endof_file
    gfreadline( @cString, nHandle )
    IF ( xpos:= AT( CHR(12), cString ) ) > 0
       cString:= LEFT( cString, xpos-1 ) + SUBS( cString, xpos + 1, LEN( cString ) )
    ENDIF
    oPrinter:SetFont('Courier New',10,ncarpol,400,.f.,.f.)
    IF "$exp$" $ cString
     oPrinter:SetFont('Courier New',nexp,ncarpol,400,.f.,.f.)
     cString:=STRTRAN(cString,"$exp$","")
    ENDIF
    IF "$ita$" $ cString
     oPrinter:SetFont('Courier New',10,ncarpol,400,.f.,.t.)
     cString:=STRTRAN(cString,"$ita$","")
    ENDIF
    IF "$sub$" $ cString
     oPrinter:SetFont('Courier New',10,ncarpol,400,.t.,.f.)
     cString:=STRTRAN(cString,"$sub$","")
    ENDIF
    IF "$neg$" $ cString
     oPrinter:SetFont('Courier New',10,ncarpol,700,.f.,.f.)
     cString:=STRTRAN(cString,"$neg$","")
    ENDIF
    IF "$linha$" $ cString
     If Paisagem
       oPrinter:line(oPrinter:posX,oPrinter:posY-50,9000,oPrinter:posY-50)
     Else
       oPrinter:line(oPrinter:posX,oPrinter:posY-50,6000,oPrinter:posY-50)
     Endif
    ELSE
     oPrinter:TextOut(cString)
    ENDIF

    oPrinter:NewLine()
    IF xpos > 0
       oPrinter:NewPage()
       oPrinter:SetFont('Courier New',,ncarpol)
       oPrinter:NewLine()
       xprow:=0
    ELSE
       xprow++
    ENDIF
enddo

oPrinter:EndDoc()
oPrinter:Destroy()

fclose(nHandle)

RETURN(NIL)

*---------------------------
procedure gfreadline(st,handle)
*---------------------------
st=xfgetline(handle)
return .t.

*----------------------------------------
function xfgetline(script)
*-------------------------
local return_lin, chunk, bigchunk, oldoffset, at_chr13
return_lin = ''
bigchunk = ''
oldoffset = fseek (script, 0, 1)
do while .t.
   chunk = ''
   chunk = freadstr (script, 100)
   if len (chunk) = 0
      endof_file = .t.
      exit
   endif
   bigchunk = bigchunk + chunk
   if at (chr (10), bigchunk) > 0
      at_chr13 = at (chr (10), bigchunk)
      fseek (script, oldoffset)
      return_lin = freadstr (script, at_chr13 - 1)
      exit
   endif
enddo
fseek (script, 1, 1)
if right(return_lin,1)=chr(13)
   return_lin:=left(return_lin,len(return_lin)-1)
end if
return return_lin

*------------
FUNC xGetImp 
*------------
Public nPrn:= 1 

Public aPrn:= GetPrinters()
If Empty(aPrn) 
   Aviso("Nao Tem nenhuma impressora Adicionada ao seu Windows  !") 
   Return .f.
else 
   Setcolor( "n/w,n*/w, , , n*/w" )
   Jankey:=  win(11,10,17,70,"Selecione Impressora ou tecle  pra desistir" )
   @ 11,10 clea to 17,70
   nPrn:=ACHOICE(12,11,16,69, aPrn,.T.,,nPrn)
   Setcolor( "n/w,n*/w, , , n*/w" )
   RstEnv(Jankey)
endIf 

if lastkey() = 27
   Return .F.
endif 
Return .T.

*-------------
Func SelImpR
*--------------
IF xGetImp()
   AUXIMP=alltrim(upper(aPrn[nPrn]))
   IF AT("LX",AUXIMP)>0 .OR. AT("FX",AUXIMP)>0
      PrintFileRaw(aPrn[nPrn],"C:\SIG.TXT", TNOMUSU)
   ELSE       
      ImpWinPrint(aPrn[nPrn],"C:\SIG.TXT")    
   ENDIF
ELSE    
   **ALERT("Erro na Impressao")
ENDIF       
Retu nil

Agora é só dar uma melhorada, mas a idéia é esta!

Abraços,

[anacatacombs]

Só tome cuidado para não colocar o operador macro (&) nas TAGS.

[]'s

Ana

[lugab]

Valeu Toledo, Ana...

Ficou fácil de entender o q foi feito e agora é testar e testar...

Muito obrigado, mais uma vez

Gabriel