/*
Compilado com xharbour 
BCC55 
Win32Prn 
*/


#define FORM_A4 9 
#define PS_SOLID 0 
#define RGB( nR,nG,nB ) ( nR + ( nG * 256 ) + ( nB * 256 * 256 ) ) 

#define BLACK RGB ( 0x0 ,0x0 ,0x0 ) 
#define BLUE RGB ( 0x0 ,0x0 ,0x85 ) 
#define GREEN RGB ( 0x0 ,0x85,0x0 ) 
#define CYAN RGB ( 0x0 ,0x85,0x85 ) 
#define RED RGB ( 0x85,0x0 ,0x0 ) 
#define MAGENTA RGB ( 0x85,0x0 ,0x85 ) 
#define BROWN RGB ( 0x85,0x85,0x0 ) 
#define WHITE RGB ( 0xC6,0xC6,0xC6 ) 



FUNCTION Main(cFilePRN,cSemConfiguracao) 
LOCAL GetList := {} 
LOCAL aPrn := GetPrinters() 
LOCAL aFiles 

cFilePRN := if(cFilePRN # NIL, cFilePRN , "") 
cSemConfiguracao := if(cSemConfiguracao # NIL, cSemConfiguracao, "") 

If File("USB.MEM") 
   Rest From USB.MEM additive
Endif 

vm_Prn := if(type("vm_Prn" ) = "U", 1 , vm_Prn ) 
vm_cFile := if(type("vm_cFile" ) = "U", "*.PRN " , vm_cFile ) 
vm_nTempo := if(type("vm_nTempo" ) = "U", 5 , vm_nTempo ) 
vm_nNormal := if(type("vm_nNormal" ) = "U", 11 , vm_nNormal ) 
vm_nCompri := if(type("vm_nCompri" ) = "U", 8 , vm_nCompri ) 
vm_nExpand := if(type("vm_nExpand" ) = "U", 18 , vm_nExpand ) 
vm_cNormal := if(type("vm_cNormal" ) = "U", '"[NORMAL]" ', vm_cNormal ) 
vm_cCompri := if(type("vm_cCompri" ) = "U", '"[COMPRIMIDO]" ', vm_cCompri ) 
vm_cExpand := if(type("vm_cExpand" ) = "U", '"[EXPANDIDO]" ', vm_cExpand ) 
vm_cNegrit := if(type("vm_cNegrit" ) = "U", '"[NEGRITO]" ', vm_cNegrit ) 
vm_cCancel := if(type("vm_cCancel" ) = "U", '"[CANCELANEGRITO]" ', vm_cCancel ) 

vm_Prn := GETDEFAULTPRINTER() 

* Imprime arquivo sem necessidade de configura‡Æo 
* Rotina executada por sistema principal 
* ----------------------------------------------- 
if !empty(cFilePRN) 
   if FILE(cFilePRN)
      PrnTeste( vm_Prn , cFilePRN)
      * PrnTeste( aPrn[ vm_Prn ], cFilePRN)
      DELETE FILE (cFilePRN)
   endif
   RETURN(NIL)
endif 

SetColor("bg+/b,w+/bg,w/w,w/w,w+/b") // Configuracao de cores PADRAO do sistema 
Set Key 28 to Help() 

CLS 
IF EMPTY(aPrn) 
   Alert("Nenhuma impressora instalada - N„o ‚ poss¡vel continuar")
   QUIT
ENDIF 

DO WHILE .T. //!EMPTY(vm_Prn) 
   CLS
   @ 00,00 TO maxRow(),maxCol()
   @ 01,02 say "Sistema de impress„o Via USB F1-Help"
   @ 02,01 TO 02,78

   @ 03,02 say "Nome do arquivo:" get vm_cFile PICT "@!K"
   @ 04,02 say " Exemplo: SPOOL.PRN"
   @ 05,02 say " *.PRN "
   @ 06,02 say " N„o usar: *.* "
   @ 07,02 say " *.TMP "

   @ 03,35 say "Tempo para Impress„o:" get vm_nTempo PICT "9.99"
   @ 03,62 say "Segundos"

   @ 08,01 TO 08,78
   @ 09,02 get vm_cNormal
   @ 09,23 say "Imprime caractere com fonte normal tamanho:" get vm_nNormal pict "99"
   @ 10,02 get vm_cCompri
   @ 10,23 say "Imprime caractere com fonte comprimida tamanho:" get vm_nCompri pict "99"
   @ 11,02 get vm_cExpand
   @ 11,23 say "Imprime caractere com fonte expandida tamanho:" get vm_nExpand pict "99"
   @ 12,02 get vm_cNegrit
   @ 12,23 say "Imprime caractere com fonte negrito"
   @ 13,02 get vm_cCancel
   @ 13,23 say "Imprime caractere com fonte cancelanegrito"

   @ 17,02 say "Impressora Default"
   @ 18,01 TO 18,78
   @ 19,02 say vm_Prn

   @ 21,01 TO 21,78
   @ 22,02 say "Desenvolvido por: Heveraldo Pereira heveraldo@veloxmail.com.br"
   @ 23,02 say " Fortaleza-CE (85) 8859.9770 heveraldo@msn.com "
   if !empty(cSemConfiguracao)
      CLEAR GETS
      * keyboard chr(13)
      * vm_Prn := ACHOICE(17,1,20,78,aPrn,.T.,,vm_Prn)
   else
      READ
      IF LASTKEY()=27
         EXIT
      ENDIF
      * vm_Prn := ACHOICE(17,1,20,78,aPrn,.T.,,vm_Prn)
      save to USB.MEM all like vm_*
   endif
   * READ
   * save to USB.MEM all like vm_*

   IF !EMPTY(vm_Prn)
      Do while .T. .and. lastkey() # 27
         Aviso(" Aguardando arquivos para impress„o ! ", vm_nTempo)

         * vm_Prn := GETDEFAULTPRINTER()
         * @ 19,02 say vm_Prn

         aFiles := {}
         asize( aFiles, aDir( alltrim(vm_cFile) ) )
         aDir ( alltrim(vm_cFile), aFiles )

         if !empty(aFiles)
            Aviso("Imprimindo relat¢rio...Agruarde!")
            * AEVAL( aFiles, { |cFile| Aviso("Imprimindo arquivo " + cFile + "...Agruarde!"), PrnTeste( aPrn[ vm_Prn ], cFile) } )
            AEVAL( aFiles, { |cFile| Aviso("Imprimindo arquivo " + cFile + "...Agruarde!"), PrnTeste( vm_Prn , cFile) } )
            AEVAL( aFiles, { |cFile| FERASE( cFile ) } )
            inkey(vm_nTempo)
         endif
      Enddo

      * Do while .T. .and. lastkey() # 27
      * Aviso("Aguardando arquivos para impress„o!", vm_nTempo)
      * if FILE(vm_cFile)
      * Aviso("Imprimindo relat¢rio...Agruarde!")
      * PrnTeste( aPrn[ vm_Prn ], vm_cFile)
      * DELETE FILE (vm_cFile)
      * inkey(vm_nTempo)
      * endif
      * Enddo

   ENDIF
   EXIT
ENDDO 
RETURN(NIL) 



STATIC FUNCTION PrnTeste() // (cPrinter, cBMPFile) 
PARA cPrinter, cBMPFile 

LOCAL oPrinter := Win32Prn():New(cPrinter) 
LOCAL aFonts 
LOCAL x 
LOCAL nColFixed 
LOCAL nColTTF 
LOCAL nColCharSet 

oPrinter:Landscape := .F. 
oPrinter:FormType := FORM_A4 
oPrinter:Copies := 1 

* Cria arquivo temporario 
TMP_Tela() 

Select Tela 
append from (cBMPFile) sdf && nome completo do arquivo sdf 

IF !oPrinter:Create() // Cria classe 
   Alert("N„o ‚ poss¡vel criar a impress„o")
ELSE 
   IF !oPrinter:startDoc("Win32Prn(Nome documento e suas propriedades)")
      Alert("StartDoc() Falhou")
   ELSE

      oPrinter:SetFont("Courier New",vm_nNormal, 0) // Normal
      oPrinter:Bold(0) // Normal

      dbgotop()
      Do while !eof()

         lCancelaNegrito := .F. // Semafaro de impressao negrito/cancela negrito
         cLinha := Tela->Linha // Busca linha de impressao
         lEject := (" " $ cLinha) // Procura caractete EJECT
         cLinha := strtran( cLinha, " ") // Elimina caractere EJECT

         oPrinter:newline() // Inicia nova linha
         if &vm_cNORMAL. $ cLinha // Verifica se linha existe cfg de fonte
            cLinha := strtran( cLinha, &vm_cNORMAL.) // Elimina caractere cfg de fonte
            oPrinter:SetFont("Courier New",vm_nNormal, 0) // Muda para padrao windows NORMAL
         endif
         if &vm_cCompri. $ cLinha
            cLinha := strtran( cLinha, &vm_cCompri.)
            oPrinter:SetFont("Courier New",vm_nCompri,{3,-50}) // Comprimida
         endif
         if &vm_cExpand. $ cLinha
            cLinha := strtran( cLinha, &vm_cExpand.)
            oPrinter:SetFont("Courier New",vm_nExpand, 0) // Expandido
         endif
         if &vm_cNegrit. $ cLinha
            cLinha := strtran( cLinha, &vm_cNegrit.)
            oPrinter:Bold(800) // Negrito/Bold
         endif
         If &vm_cCancel. $ cLinha
            cLinha := strtran( cLinha, &vm_cCancel.)
            * oPrinter:Bold(0) // Normal
            lCancelaNegrito := .T.
         endif

         oPrinter:TextOut(cLinha)
         oPrinter:Bold(0) // Normal
         dbskip()

         if(lEject .and. !eof(), oPrinter:NewPage(), ) // Usa "oPrinter:NewPage()" para iniciar nova pagina
            if (oPrinter:MaxRow() - 2) <= oPrinter:Prow() // Usa "oPrinter:NewPage()" para iniciar nova pagina
               oPrinter:NewPage()
            endif

      Enddo
      oPrinter:EndDoc() // Finaliza documento
   ENDIF
   oPrinter:Destroy() // Destroi classe
ENDIF 
Close Tela 
RETURN(NIL) 


Procedure PrintBitMap( oPrn, cBitFile ) 
LOCAL oBMP 
IF EMPTY( cBitFile ) 
   *
ELSEIF !FILE( cBitFile ) 
   Alert( cBitFile + " n„o encontrado " )
ELSE 
   oBMP:= Win32BMP():new()
   IF oBmp:loadFile( cBitFile )
      oBmp:Draw( oPrn, { 200,200, 2000, 1500 } )
      // Note: Can also use this method to print bitmap
      // oBmp:Rect:= { 200,2000, 2000, 1500 }
      // oPrn:DrawBitMap( oBmp )
   ENDIF
   oBMP:Destroy()
ENDIF 
RETURN 


* Criacao de arquivo temporario de auxilio impressao na tela 
* ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ 
Function TMP_Tela() 
local Retorna := .T. 
local aSCGTMP := { {"LINHA", "C", 200, 0} } 

set exclusive on 
* Arquivo1 := alltrim(left(sys_Usuario,4)) + "TELA.TMP" 
Arquivo1 := "TELA.TMP" 
if !file(Arquivo1)
   DBCREATE(Arquivo1,aSCGTMP)
endif
if select("Tela") # 0
   select Tela
   Tela->(__dbzap())
elseif select("Tela") = 0 .and. userede(Arquivo1,"Tela",.T.,10)
   Tela->(__dbzap())
endif
set exclusive off
Return (Retorna) 
* o arquivo testw32p.prg (ou algo assim que vem no pacote do xharbour apresenta todos os recursos da classe. 


Function UseRede(arquivo,apelido,exuse,tempo) 
local sempre := (tempo = 0) 
Do while (sempre .or. tempo > 0)
   If exuse
      USE (arquivo) Alias (apelido) Exclusive //NEW VIA 'MySQL'
   Else
      USE (arquivo) Alias (apelido) Shared //NEW VIA 'MySQL'
   Endif

   If !Neterr()
      Return .T.
   Endif
   aviso("Tentando acesso ao bancos de dados...Aguarde!",1)
   tempo -= 1
Enddo
* atencao(""," N„o foi poss¡vel acessar algum arquivo de dados.",;
* " O sistema ser finalizado para evitar perda",;
* " de dados e manter a consistˆncia dos arquivos. ",;
* " ",;
* " Acesse o sistema novamente. ",;
* " Qualquer d£vida, entre em contato com o suporte ",;
* " t‚cnico."," ",;
* " Tecle algo" )
* cls ; quit
Return .F.


Function Aviso(msg, tempo) 
local TelaAguarde := if(tempo # NIL, savescreen(), "") 
local ci 
local cf 

if !empty(msg) 
   msg := if(msg=NIL," Processando...Aguarde! ",msg)
   ci := int(40-(len(msg)/2)-2)
   cf := int(40+(len(msg)/2)+2)

   * Som(1)
   Jan(12,ci,16,cf,"w+/b","n+/b",.T. )
   @ 14,ci+1 say padc(msg,len(msg)+2) color "r*/b"

   If Tempo # NIL
      Inkey(tempo)
      TelaAguarde := restscreen(,,,,TelaAguarde)
   Endif
   * @ 48,78 Say ""
endif 
Return(.T.) 

Function Jan(li,ci,lf,cf,linhaS,linhaI,fundo) 
local CorJan := SetColor() 
if fundo = .T. // se .T. limpa a tela e coloca cor de fundos
   setColor(linhaS)
   @ li,ci clear to lf,cf
   setColor(CorJan)
endif

@ li,ci to lf,cf Color linhaS && faz um quadro 
@ lf,ci to lf,cf Color linhaI && linha inferior 
@ li,cf to lf,cf Color linhaI && linha direita 
@ li,cf say "¿" Color linhaI && canto superior direito 
@ lf,cf say "Ù" Color linhaI && canto inferior direito 
@ lf,ci say "À" Color linhaS && canto inferior esquerdo 
@ 48,78 say "" 
SetColor(CorJan) 
Return NIL 


Function Help() 
local TelaHelp := savescreen() 
* limpa() 
* cls 
* @ 08,01 say "Ajuda ao Sistema " 
* @ 09,01 say "ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ" 

CLS 
@ 00,00 TO maxRow(),maxCol() 
@ 01,02 say "Sistema de impress„o Via USB" 
@ 02,01 TO 02,78 

@ 04,01 say "1. Configura‡„o do Arquivo: USB.MEM " 
@ 05,01 say " Insira macros substitui‡„o de fontes em seu arquivo de impress„o ou" 
@ 06,01 say " altere para as que j s„o usadas como configura‡Æo de fonte no seu arquivo" 
@ 07,01 say " de impress„o e defina seus respectivos tamanhos de fontes. " 
@ 08,01 say " Use ASPAS no inicio e final de cada macro. " 

@ 10,01 say " Definir tamb‚m: " 
@ 11,01 say " Nome do arquivo, tempo para impress„o de cada arquivo. " 

@ 13,01 say "2. Como configurar ? " 
@ 14,01 say " Execute o programa USB.EXE e realize as devidas configura‡äes. " 

@ 16,01 say "3. Como imprimir ? " 
@ 17,01 say " Modo STAND ALONE -> Execute o programa assim: " 
@ 18,01 say ' USB "" "SEM CONFIGURACAO" ' 

@ 20,01 say " Imprimindo direto pelo seu aplicativo:Insira a linha abaixo no seu sistema:" 
@ 21,01 say " RUN USB NOME DO ARQUIVO DE IMPRESSAO " 

@ 23,01 say " Pressione qualquer tecla para continuar..." 
inkey(0) 

CLS 
@ 00,00 TO maxRow(),maxCol() 
@ 01,02 say "Sistema de impress„o Via USB" 
@ 02,01 TO 02,78 

@ 04,01 say "4. Como funciona a substitui‡„o de fonte ? " 
@ 05,01 say " O sistema procura as macros substiui‡„o no seu arquivo de impress„o e" 
@ 06,01 say " altera para defini‡„o de fonte padr„o windows. " 

@ 08,01 say " A configura‡„o de cada tipo de fonte ‚ configurada por linha inteira, n„o " 
@ 09,01 say " podendo mudar de fonte no meio de uma linha. " 

@ 11,01 say " Negrito sempre ser cancelada na linha seguinte. " 

@ 13,01 say ' O eject ‚ executado quando encontra este " " caractere no arquivo de' 
@ 14,01 say ' impress„o ou no final de cada p gina. ' 

@ 16,01 say " O arquivo impresso, ser exclu¡do ap¢s a impress„o. " 

@ 18,01 say " O programa direcionar as impress”es para a impressora default do windows." 

@ 20,01 say " Sugest„o: Crie uma pasta C:\Temp, copie os arquivos de impress„o para ela" 
@ 21,01 say " e execute o programa USB.EXE na mesma. " 

@ 23,01 say " Pressione qualquer tecla para continuar..." 
inkey(0) 

CLS 
@ 00,00 TO maxRow(),maxCol() 
@ 01,02 say "Sistema de impress„o Via USB" 
@ 02,01 TO 02,78 

@ 04,01 say "5. Exemplo: Seu arquivo de impress„o deve ficar assim: " 
@ 05,01 say " [NORMAL]Teste de impressao com fonte normal " 
@ 06,01 say " Ainda imprimindo com fonte normal " 

@ 08,01 say " [NEGRITO]Teste de impressao com fonte negrito " 
@ 09,01 say " Fonte negrito ‚ sempre cancelada a cada nova linha ou seja, valta ao normal" 
@ 10,01 say " Imprimindo com fonte normal " 

@ 12,01 say " [EXPANDIDO]Impressao EXPANDIDA " 
@ 13,01 say " Continua EXPANDIDO " 
@ 14,01 say " [NORMAL] Configura impressao com fonte normal " 

@ 16,01 say " [NORMAL]Temos que abrir m„o de certos recursos e est‚tica no in¡cio, para" 
@ 17,01 say " conseguir imprimir. Depois que aprender um pouco desse programa, trabalhe" 
@ 18,01 say " a est‚tica, os recursos e a facilidade de impress„o para o usu rio final. " 

@ 23,01 say " Pressione qualquer tecla para retornar..." 
inkey(0) 

Restscreen(,,,,TelaHelp) 
Return Nil