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