definir impressora padrao
Enviado: 08 Mai 2013 17:07
ola amigos
peguei o exemplo abaixo, se nao me angeno aqui mesmo no forum, tirei algumas funçoes como salver em arquivo e tal, esta funcionando mas, gostaria que fixasse a impressora padrao do windows na rotina anexa, por exemplo tenho as seguintes impressora instaladas:
PDFCreator
PDF Architect
HP DeskJet 3740 Series
\\192.168.0.11\user 3745
a impressora padrao no windows é a HP DeskJet 3740 Series mas quando mando imprimir aparece a relaçcao da impressora so que esta parado em PDFCreator gostaria o parace em HP DeskJet 3740 series
veja abaixo a rotina de impressao.
peguei o exemplo abaixo, se nao me angeno aqui mesmo no forum, tirei algumas funçoes como salver em arquivo e tal, esta funcionando mas, gostaria que fixasse a impressora padrao do windows na rotina anexa, por exemplo tenho as seguintes impressora instaladas:
PDFCreator
PDF Architect
HP DeskJet 3740 Series
\\192.168.0.11\user 3745
a impressora padrao no windows é a HP DeskJet 3740 Series mas quando mando imprimir aparece a relaçcao da impressora so que esta parado em PDFCreator gostaria o parace em HP DeskJet 3740 series
veja abaixo a rotina de impressao.
Código: Selecionar todos
PROCEDURE PRINTSERV( CALIAS, CPASTA, CARQUI )
LOCAL aPrn := {}
LOCAL mTexto := {}
LOCAL cPrinter := Space(0)
LOCAL TelaPrn := SaveScreen( 00,00,24,79 )
LOCAL SvOrd := (CALIAS)->( OrdSetFocus() )
LOCAL SvRec := (CALIAS)->( RecNo() )
SET PRINTER TO
SET DEVICE TO SCREEN
MTEXTO:= LERARQTXT( CPASTA, CARQUI )
aPrn := GetPrinters()
IF EMPTY(aPrn)
Alert("Nenhuma impressora foi instalada nesta estacao!")
QUIT
ENDIF
cPrinter:= AllTrim(SelAchoice(aPrn,@cPrinter,30))
If LastKey() <> 27 .AND. !Empty(cPrinter) .AND. Len(mTexto) > 0
PrinterArquivo( mTexto,cPrinter )
EndIf
RestScreen(00,00,24,79,TelaPrn)
DBSelectArea( CALIAS )
(CALIAS)->( OrderBy( SvOrd ) )
(CALIAS)->( DBGoTo( SvRec ) )
Return NIL
*-------------------------------------------------------------------------------------------------------
Func LerArqTxt( CPASTA, CARQUI )
Local aStruct:= {}, mTexto:= {}
cArqTxt := CPASTA + CARQUI + ".TXT"
CARQDBF := CPASTA + CARQUI + ".DBF"
IF FILE( CARQDBF )
DELETE FILE ( CARQDBF )
ENDIF
aStruct:={}
AAdd(aStruct, {"Txtlinha", "C",250, 0})
DBCreate( CARQDBF,aStruct,"DBFCDX" )
DBUseArea( .T., "DBFCDX", CARQDBF, "ArqImp", .F., .F. )
APPEND FROM "&cArqTxt" SDF
ArqImp->(DbGoTop())
Do While !ArqImp->(Eof())
AAdd(mTexto,{ArqImp->Txtlinha})
Skip
EndDo
ArqImp->(DBCloseArea())
Return mTexto
*----------------------------------------------------------------------------------------------------
#define FORM_A4 9
#define RGB( nR,nG,nB ) ( nR + ( nG * 256 ) + ( nB * 256 * 256 ) )
#define PS_SOLID 0
STATIC FUNC PrinterArquivo(mTexto,cPrinter )
LOCAL oPrinter:= WIN32PRN():New(cPrinter), aFonts, x, nColFixed, nColTTF, nColCharSet, aForms
oPrinter:Landscape:= .F.
oPrinter:FormType := FORM_A4
oPrinter:Copies := 1
oPrinter:SetFont('courier new',12,{1,12}, 0,.F.,.F.)
c_string:= " teste "
IF !oPrinter:Create()
Alert("Cannot Create Printer")
ELSE
IF !oPrinter:startDoc( c_string )
Alert("IMPRESSORA NAO ESTA PRONTA ")
ELSE
FOR N = 1 TO 2
oPrinter:NewLine()
NEXT N
lin:= nFim:= 1
For z:=1 To Len(mTexto)
lin:= oPrinter:Prow()
oPrinter:TextOut(mTexto[z][1],.T.)
If lin > 60 .AND. nFim = 1
oPrinter:NewPage()
oPrinter:NewLine()
lin:= 1
EndIf
Next
oPrinter:EndDoc()
ENDIF
oPrinter:Destroy()
ENDIF
Return
*--------------------------------------------------------------------------------------------------
Func SelAchoice(dir1,cSelec,xLen)
Local cTela
Local opc:= nLin1:= nLin2:= nCol1:= nCol2:= 0
If Len(dir1) < 22
nLin1:= INT((24 - (Len(dir1))) / 2)
nLin2:= (nLin1 + (Len(dir1)))
Else
nLin1:= 2
nLin2:= 22
EndIf
nCol1:= Round(((78 - (xLen)) / 2),2)
nCol2:= nCol1 + xLen + 1
If nCol2 > 78
nCol2:= 78
EndIf
cTela:= SaveScreen((nLin1-1),(nCol1-1),(nLin2+1),(nCol2+1))
@ (nLin1-1), (nCol1-1) Clear To (nLin2+1),(nCol2+1)
@ (nLin1-1), (nCol1-1) To (nLin2+1),(nCol2+1)
@ nLin1,nCol1 Say Padc("SELECIONE A IMPRESSORA",(nCol2-nCol1))
DO While opc = 0 .AND. Lastkey() <> 27
opc:= achoice((nLin1+1),nCol1,nLin2,nCol2,dir1,.T.,"")
EndDo
If Lastkey() = 27
cSelec:=""
Else
cSelec:= dir1[opc]
EndIf
RestScreen((nLin1-1),(nCol1-1),(nLin2+1),(nCol2+1),cTela)
Return cSelec