FUNCTION Main(cARQTXT)
LOCAL nPrn:=1
LOCAL aPrn:= GetPrinters()
SETMODE(25,80)
CLS
IF EMPTY(cARQTXT)
Alert("Obrigatorio informar o arquivo")
quit
ENDIF
IF EMPTY(aPrn)
aOptions := { "SIM", "NAO" }
nChoice := Alert( "ATENÇÃO !!! Não foi possivel localizar Nenhuma impressora Instalada no Windows, Deseja Instalar uma Agora ?", aOptions, , 5)
DO CASE
CASE nChoice == 0
QUIT
CASE nChoice == 1
RunApplet_imp( "AddPrinter" )
CASE nChoice == 2
QUIT
ENDCASE
ENDIF
DO WHILE !EMPTY(nPrn)
CLS
@ 0,0 SAY 'Programa de teste Classe WIN32PRN(). Escolha uma impressora. ESC' +;
' para sair.'
@ 1,0 TO maxRow(),maxCol()
nPrn:= ACHOICE(2,1,maxRow()-1,maxCol()-1,aPrn,.T.,,nPrn)
IF !EMPTY(nPrn)
PrnTest(aPrn[nPrn], cARQTXT )
ENDIF
ENDDO
@ 22,00 say ""
RETURN(NIL)
*******************************************
Function PrnTest(cPrinterName, cFile, TAM )
*******************************************
LOCAL aPrn := GetPrinters(.t.,.f.)
Local cPrinterPort
Local cMsg := ""
IF TAM=Nil
TAM="S"
ENDIF
for i=1 to len(aPrn)
IF aPrn[i,1] = cPrinterName
cPrinterPort = aPrn[i,2]
exit
ENDIF
next
IF cPrinterPort#Nil
IF LEFT(UPPER(cPrinterPort),3)="LPT"
nResult := PrintFileRaw( cPrinterName, cFile, "Impressao Pelo Sistema" )
IF nResult = -1
cMsg = "Parametros Invalido, Favor Tentar Novamente"
ELSEIF nResult = -2
cMsg = "Falha na chamada da Impressora, Favor Verificar a Impressora"
ELSEIF nResult = -3
cMsg = "Falha ao Iniciar Impressão, Favor Verificar a Impressora"
ELSEIF nResult = -4
cMsg = "Falha ao Iniciar a Primeira Pagina, Favor Verificar a Impressora"
ELSEIF nResult = -5
cMsg = "Falha de Memoria da Impressora, Favor Verificar a Impressora"
ELSEIF nResult = -6
cMsg = "Não foi Possivel localizar o arquivo de Impressão, Favor Tentar Novamente"
ENDIF
IF len(alltrim(cMsg)) > 1
alert(cMsg)
Return
ENDIF
ELSE
IF TAM="S"
IF !EMPTY(cPrinterName)
Imprime(cFILE,136,cPrinterName)
ENDIF
ELSE
IF !EMPTY(cPrinterName)
Imprime(cFILE,80,cPrinterName)
ENDIF
ENDIF
ENDIF
ENDIF
RETURN NIL
FUNCTION RunApplet_imp( cApplet ) //CONFIGURA IMPRESSORA NO WINDOWS
ShellExecute("rundll32.exe","open","shell32.dll, SHHelpShortcuts_RunDLL "+cApplet,"2")
RETURN Nil
*****************************************
Function Imprime( cArq, tamrel ,cPrinter)
*****************************************
local cTexto, nLinhas, nA, cLinha, oBMP
#ifdef __XHARBOUR__
local oPrinter := win32prn():New(cPrinter)
#else
local oPrinter := win_prn():New(cPrinter)
#endif
cText := memoread( cArq )
oPrinter:Landscape:= .F.
oPrinter:FormType:= 9
oprinter:SetPrintQuality(-1) // qualidade da impressão
oPrinter:Copies:= 1
IF !oPrinter:Create()
alert("ATENÇÃO !!! Não foi possivel Iniciar a Impressão, Favor Verificar se a Impressora esta Ligada.")
return NIL
else
IF !oPrinter:StartDoc("Impressao Pelo Sistema SAGI")
alert("ATENÇÃO !!! Não foi possivel Iniciar a Impressão, Favor Verificar a Impressora")
Return NIL
endif
FOR TT=1 TO 2
oPrinter:newline()
NEXT
IF TAMREL=80
oPrinter:setfont('Courier New',,12,,,,255) // Normal
nLines2 := 85
ELSE
oPrinter:SetFont("Courier New",13,{3,-50},0,.F.,.F.) // Comprimida
nLines2 := 150
ENDIF
oPrinter:Bold(0) // Normal
nLines := mlcount( cText, nLines2 )
for nA := 1 to nLines
cLine := memoline( cText, nLines2, nA, 1, .F. )
IF Left(AllTrim( cLine ), 1 ) == Chr( 15 ) .or. Left( AllTrim(cLine), 1 ) == Chr( 18 )
loop
ENDIF
If Left(AllTrim(cLine),1)==Chr(12) //SALTO DA PAGINA
oPrinter:NewPage()
FOR TT=1 TO 2
oPrinter:newline()
NEXT
endif
oPrinter:TextOut( cLine, .T. )
oPrinter:Bold(0) // Normal
if (oPrinter:MaxRow()-2 ) <= oPrinter:Prow()
oPrinter:NewPage()
FOR TT=1 TO 2
oPrinter:newline()
NEXT
endif
next
oPrinter:EndDoc()
oPrinter:Destroy()
ENDIF
RETURN NIL
#pragma BEGINDUMP
#include "windows.h"
#include "hbapi.h"
/*
* ShellExecute( cFile, cOperation, cParams, cDir, nFlag )
*/
HB_FUNC( SHELLEXECUTE )
{
hb_retnl( (LONG) ShellExecute( GetActiveWindow(),
ISNIL(2) ? NULL : (LPCSTR) hb_parc(2),
(LPCSTR) hb_parc(1),
ISNIL(3) ? NULL : (LPCSTR) hb_parc(3),
ISNIL(4) ? "C:\\" : (LPCSTR) hb_parc(4),
ISNIL(5) ? 1 : hb_parni(5) ) ) ;
}
#pragma ENDDUMP
Nota: Pode ser compilado tanto com Harbour como com xHarbour. Se poder de preferencia pelo Harbour que esta evoluindo muito rapido !