Eu desejo imprimir 3 vezes o mesmo relatório, mas o código abaixo não está funcionando adequadamente e por isso só esta imprimindo uma única cópia do relatório.
Observem que eu coloquei 3 no parâmetro oPrinter:Copies.
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:Landscape:= .F.
oPrinter:FormType := DMPAPER_A4
oPrinter:Copies := 3
oPrinter:SetPrintQuality(1)
IF !oPrinter:Create()
Alert(" Impressora näo pode ser criada !!! ")
RETURN
ELSE
IF !oPrinter:startDoc("TPRINT("+xarqtxt+")")
Alert("StartDoc() falhou !!!")
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
IF xmaxLen <= 85
ncarpol:= 11
ELSEIF xmaxlen <= 100
ncarpol:= 13
ELSEIF xmaxlen <= 136
ncarpol:= 18
ELSEIF xmaxlen <= 160
ncarpol:= 21
ENDIF
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)
// EOF - impWinPrint()
*---------------------------
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
Obrigado a quem dedicar seu tempo a solução do meu problema
Gabriel
