by praul » Sun Dec 19, 2010 3:08 pm
Mira esto:
/*
Modificada por Diego
Atualizacao: Suporte para Impressao USB
*/
#include "fivewin.ch"
#include "fileio.ch"
#translate nTrim(<n>) => AllTrim(Str(<n>,10,0))
#define PF_BUFLEN 2048
//----------------------------------------------------------------------------//
CLASS TDosPrn
DATA LastError
DATA cPort, cCompress, cNormal, cFormFeed, cBuffer // AS STRING
DATA hDC, nRow, nCol, nLeftMargin, nTopMargin // AS NUMBER
DATA lAnsiToOem // AS LOGICAL
DATA ImpUSB // AS LOGICAL
DATA ImpCOM // AS LOGICAL
METHOD New(cPort,cVerUSB) CONSTRUCTOR
METHOD End()
METHOD StartPage() VIRTUAL
METHOD EndPage()
METHOD Command(xPar1, xPar2, xPar3, xPar4, xPar5)
METHOD SetCoors(nRow, nCol)
METHOD NewLine() INLINE (::cBuffer += CRLF ,;
::nRow++ ,;
::nCol := 0 )
METHOD Write(cText, lAToO) ;
INLINE (iif(lAtoO == NIL, lAtoO := .T.,),;
::cBuffer += iif(lAtoO, AnsitoOem(cText), cText) ,;
::nCol += len(cText) )
METHOD Say(nRow, nCol, cText)
METHOD SayCmp(nRow, nCol, cText)
METHOD PrintFile(cFile)
ENDCLASS
//----------------------------------------------------------------------------//
METHOD New(cPort,cVerUSB) CLASS TDosPrn
DEFAULT cPort := "LPT1", cVerUSB:=.F.
cPort := Upper(cPort)
::ImpUSB := .F.
::ImpCOM := .F.
::cCompress := "15"
::cNormal := "18"
::cFormFeed := "12"
::cBuffer := ""
::nLeftMargin := 0
::nTopMargin := 0
::nRow := 0
::nCol := 0
::lAnsiToOem := .T.
if cVerUSB .and. upper( PrnGetPort( ) )="USB" .or. cVerUSB .and. upper( PrnGetPort( ) )="COM"
::cPort := DirTempdoWindows()+"\usb.imp"
::ImpUSB := .T.
if cVerUSB .and. upper( PrnGetPort( ) )="COM"
::ImpCOM := .T.
endif
else
::cPort := cPort+iif(!"."$cPort,".PRN","")
endif
::hDC := fCreate(::cPort)
::LastError := 0
IF ::hDC < 0
::LastError := fError()
ENDIF
RETURN Self
//----------------------------------------------------------------------------//
METHOD End() CLASS TDosPrn
local thisprn, thisfile,opfile,nrow,n,oFont,arq2
IF !empty(::nRow+::nCol)
::EndPage()
ENDIF
::LastError := 0
IF !fClose(::hDC)
::LastError := fError()
else
if ::ImpUSB .and. !::ImpCOM
DEFINE FONT oFont NAME "COURIER NEW" SIZE 0,70
PRINT thisprn NAME "USB mode"
nrow:=20
PAGE
opFile:=tTxtFile():NEW(DirTempdoWindows()+"\usb.imp")
for n=1 to opFile:reccount()
thisprn:say(nrow,00,rtrim(opFile:readline()),oFont)
opFile:skip()
nrow:=nrow+80
next
opFile:End()
ENDPAGE
ENDPRINT
elseif ::ImpUSB .and. ::ImpCOM
ferase("impcom.bat")
arq2:=fcreate("impcom.bat")
fwrite(arq2,"copy "+DirTempdoWindows()+"\usb.imp "+LEFT(upper( PrnGetPort( ) ),4))
fclose(arq2)
winexec("impcom.bat",0)
endif
ENDIF
RETURN NIL
//----------------------------------------------------------------------------//
METHOD EndPage() CLASS TDosPrn
LOCAL nFor, nLen, nSec
LOCAL lError
* ::Command(::cFormFeed)
::LastError := 0
IF fWrite(::hDC, ::cBuffer) < len(::cBuffer)
::LastError := fError()
ENDIF
::cBuffer := ""
::nRow := 0
::nCol := 0
RETURN NIL
//----------------------------------------------------------------------------//
METHOD Command(xPar1, xPar2, xPar3, xPar4, xPar5) CLASS TDosPrn
LOCAL cCommand, cToken, cString
LOCAL nToken
cString := cValToChar(xPar1)
IF xPar2 != NIL
cString += ","+cValToChar(xPar2)
ENDIF
IF xPar3 != NIL
cString += ","+cValToChar(xPar3)
ENDIF
IF xPar4 != NIL
cString += ","+cValToChar(xPar4)
ENDIF
IF xPar5 != NIL
cString += ","+cValToChar(xPar5)
ENDIF
cCommand := ""
nToken := 1
DO WHILE !Empty(cToken := StrToken(cString, nToken++, ","))
cCommand += Chr(Val(cToken))
ENDDO
::cBuffer += cCommand
RETURN NIL
//----------------------------------------------------------------------------//
METHOD SetCoors(nRow, nCol) CLASS TDosPrn
nRow += ::nTopMargin
nCol += ::nLeftMargin
IF ::nRow > nRow
::EndPage()
::StartPage()
ENDIF
IF nRow == ::nRow .AND. nCol < ::nCol
::EndPage()
::StartPage()
ENDIF
DO WHILE ::nRow < nRow
::NewLine()
ENDDO
IF nCol > ::nCol
::Write(Space(nCol-::nCol))
ENDIF
RETURN NIL
//----------------------------------------------------------------------------//
METHOD Say(nRow, nCol, cText, lAToO) CLASS TDosPrn
DEFAULT lAToO := ::lAnsiToOem
::SetCoors(nRow, nCol)
::Write(cText, lAToO)
RETURN NIL
//----------------------------------------------------------------------------//
METHOD SayCmp(nRow, nCol, cText, lAToO) CLASS TDosPrn
DEFAULT lAToO := ::lAnsiToOem
::SetCoors(nRow, nCol)
::Command(::cCompress)
::cBuffer += iif(lAToO, AnsitoOem(cText), cText)
::nCol += Int(len(cText)/1.7+.5)
::Command(::cNormal)
RETURN NIL
//----------------------------------------------------------------------------//
METHOD PrintFile(cFile) CLASS TDosPrn
LOCAL hFile
LOCAL nRead
LOCAL cBuffer
hFile := FOpen(cFile, FO_READ)
IF hFile < 0
RETURN .F.
ENDIF
cBuffer := Space(PF_BUFLEN)
DO
nRead := fRead(hFile, @cBuffer, PF_BUFLEN)
IF fWrite(::hDC, Left(cBuffer, nRead)) < nRead
::LastError := fError()
fClose(hFile)
RETURN .F.
ENDIF
UNTIL nRead == PF_BUFLEN
fClose(hFile)
RETURN .T.
//----------------------------------------------------------------------------//
FUNCTION WorkSheet(cPort)
LOCAL oPrn
LOCAL cLine
LOCAL nFor
cLine := ""
FOR nFor := 0 TO 7
cLine += Str(nFor,1)+Replicate(".",9)
NEXT
cLine := Substr(cLine,3)
oPrn := TDosPrn():New(cPort)
oPrn:StartPage()
FOR nFor := 0 TO 65
oPrn:Say(nFor,0,StrZero(nFor,2)+cLine)
NEXT
oPrn:EndPage()
oPrn:End()
RETURN NIL
********************************
Function DirTempdoWindows()
Local cDir := GetEnv("TEMP")
// Se Vazio cDir Entao cDir := GetEnv("TMP")
If Right( cDir, 1 ) == "\"
cDir = SubStr( cDir, 1, Len( cDir ) - 1 )
EndIf
If !Empty(cDir)
If !lIsDir(cDir)
cDir := GetWinDir()
EndIf
Else
cDir := GetWinDir()
EndIf
Return(AllTrim(cDir))
********************************
// Classe Sysfar para Impressão Dos
********************************
CLASS SysDosPrn
DATA File,cPort,ImpUSB
METHOD New(USB) CONSTRUCTOR
METHOD Say(cText)
METHOD End()
ENDCLASS
*****************************
METHOD New(USB) CLASS SysDosPrn
DEFAULT USB:=.F.
::ImpUSB := .F.
if USB .and. upper( PrnGetPort( ) )="USB"
::cPort := DirTempdoWindows()+"\usb.imp"
::ImpUSB := .T.
else
::cPort := "LPT1.PRN"
endif
::File := fCreate(::cPort)
RETURN Self
*****************************
METHOD Say(cText) CLASS SysDosPrn
default ctext:=""
fwrite(::File,cText+chr(13)+chr(10))
RETURN NIL
*****************************
METHOD End() CLASS SysDosPrn
local thisprn, thisfile,opfile,nrow,n,oFont
fclose(::File)
if ::ImpUSB
DEFINE FONT oFont NAME "COURIER NEW" SIZE 0,70
PRINT thisprn NAME "USB mode"
nrow:=20
PAGE
opFile:=tTxtFile():NEW(DirTempdoWindows()+"\usb.imp")
for n=1 to opFile:reccount()
thisprn:say(nrow,00,rtrim(opFile:readline()),oFont)
opFile:skip()
nrow:=nrow+80
next
opFile:End()
ENDPAGE
ENDPRINT
endif
RETURN NIL
*****************************