Amigos do Forum Bom Dia,
Gostaria que alguém me pudesse ajudar.
Imprimo para a impressora pdfcreator e no final da última linha de impressão após o último caracter aparece-me um quadrado.
Como resolver?
Obrigado a todos.
Lapinhazzz
winprn32() e impressão de quadrados
Moderador: Moderadores
-
lapinhazzz
- Usuário Nível 3
- Mensagens: 130
- Registrado em: 20 Abr 2009 10:52
- Localização: LAGOA
-
sygecom
- Administrador
- Mensagens: 7131
- Registrado em: 21 Jul 2006 10:12
- Localização: Alvorada-RS
- Contato:
Re: winprn32() e impressão de quadrados
Se você imprime na WIN32PRN lendo um arquivo TXT, muito provavel que tenha algum CHR() nesse TXT que é criado pelo seu sistema, sendo no final pode ser que seja um EJECT : CHR(12), eu aqui para não imprimir esses CHR() eu verefico antes de imprimir se a linha é igual a CHR(12) e elimino esse caracter e no meu caso em especial o EJECT pula de pagina na minha impressão usando WIN32PRN EX:
Isso foi só um chute, se não for isso, post como está imprimindo para podermos lhe ajudar melhor.
Código: Selecionar todos
If Left(AllTrim(cLine),1)==Chr(12) //SALTO DA PAGINA
oPrinter:NewPage()
FOR TT=1 TO 2
oPrinter:newline()
NEXT
endif
Leonardo Machado
xHarbour.org + Hwgui + PostgreSql
xHarbour.org + Hwgui + PostgreSql
-
lapinhazzz
- Usuário Nível 3
- Mensagens: 130
- Registrado em: 20 Abr 2009 10:52
- Localização: LAGOA
Re: winprn32() e impressão de quadrados
Amigo Sygecom.
O código é este:
Apreciarei a sua resposta.
Muito obrigado.
lapinhazzz
O código é este:
Código: Selecionar todos
#define RED RGB( 0x85,0x0 ,0x0 )
#define BLACK RGB( 0x0 ,0x0 ,0x0 )
#define BLUE RGB( 0x0 ,0x0 ,0x85 )
Func mv_ip()
sele 3
OrdSetFocus("cprod")
SetImpressora("ON")
z=0
P=1
skip
While p<10
@ z+1,0 Say codigoprod+' '+prod+' '+str(precov)
skip
z++
IF eof()
z=0
p=p+1
go top
skip
ENDIF
EndDo
SetImpressora("OFF")
Return
***************************************************
Func SetImpressora(cSI)
// possiveis cSI = ON -> para iniciar a gravar o arquivo texto
// OFF -> para jogar na impressora
Local mImpr:= {}, aPrn:= {}, mTexto:= {}
Local nPrn:= 0, cPrinter:= Space(0)
Local TelaPrn:= SaveScreen(00,00,24,79)
Local cLinha:= Space(0)
xcorjane="W/B" //Estas variaveis tem que ser declaradas
xcorletra="GR+/RD" //sao as cores usadas na funcao
xcorcursor="N/W" //Menu( )
cSI:= UPPER(cSI)
If cSI = "ON"
Clear Screen
Public cModoImp:= Space(10)
opc=1
tel_si=SAVESCREEN(0,0,24,79)
DO WHILE .T.
v_m:={{"1 - IMPRES. PADRAO "," "},;
{"2 - IMPRES. NA REDE "," "},;
{"3 - GRAVAR ARQUIVO "," "},;
{"4 - VOLTAR"," "}}
l_m:="1234"
opc=Menu(v_m,10,22,l_m,TelaPrn,"- PARA IMPRIMIR -",opc,0)
IF opc=0
EXIT
ENDIF
Do Case
Case opc = 1
cModoImp:= "PADRAO"
Exit
Case opc = 2
cModoImp:= "NA REDE"
Exit
Case opc = 3
cModoImp:= "GRAVAR ARQUIVO"
Exit
Case opc = 4 .OR. opc = 0
cModoImp:= "VOLTAR"
Exit
EndCase
RestScreen(0, 0, 24, 79, Tel_opc)
EndDo
Aguarde(19,06,1)
SET PRINTER TO "ARQUIVO.TXT"
SET DEVICE TO PRINTER
OK:= 0
EndIf
If cSI = "OFF"
SET PRINTER TO
SET DEVICE TO SCREEN
Aguarde(19,06,1)
mTexto:= LerArqTxt("ARQUIVO.TXT")
nPrn:= 1
Do Case
Case cModoImp = "NA REDE"
aPrn:= GetPrinters()
@ 04, 04 Clear To 20, 70
@ 04, 04 To 20, 70
IF EMPTY(aPrn)
Alert("No printers installed - Cannot continue")
QUIT
ENDIF
@ 05, 06 Say " escolha a impressora : "
cPrinter:= AllTrim(SelAchoice(aPrn,@cPrinter,30))
Aguarde(19,06,1)
Case cModoImp = "GRAVAR ARQUIVO"
cNomeArq:= GravArqTxt("ArqImp",mTexto,"TXT")
Case cModoImp = "PADRAO"
cPrinter:= GetDefaultPrinter()
EndCase
If LastKey() <> 27 .AND. !Empty(cPrinter) .AND. Len(mTexto) > 0
PrinterArquivo(mTexto,cPrinter)
EndIf
RETURN
EndIf
RestScreen(00,00,24,79,TelaPrn)
Return NIL
***********************************************
Func GravTexto(wLocal,w_ArqTxt,mTexto)
* esta fun‡ao grava um arquivo .txt a partir da array
* ex: wlocal := "f:\nfe"
* ex: warqtxt := "&wlocal\nota.txt"
If !Empty(wLocal)
warqtxt:= AllTrim(wLocal)+"\"+AllTrim(w_ArqTxt)
Else
warqtxt:= AllTrim(w_ArqTxt)
EndIf
ret_line := "chr(13)+chr(10)"
errhandle := FCREATE("&warqtxt" + ".txt")
For z:=1 To Len(mTexto)
cLinha:= mTexto[z][1]
FWRITE(errhandle,cLinha+&ret_line.)
Next
FCLOSE(errhandle)
FCLOSE("&warqtxt" + ".txt")
nREG := recco()
Return
**************************************************************
Func LerArqTxt(cArquivo)
* esta fun‡ao grava uma array a partir de um arquivo .txt
Local aStruct:= {}, mTexto:= {}
cArqTxt:= cArquivo
If (!File("ArqImp.dbf"))
aStruct:={}
AAdd(aStruct, {"Txtlinha", "C",250, 0})
DBCreate("ArqImp.dbf",aStruct)
EndIf
USE ArqImp New
ArqImp->(__DBZap())
ArqImp->(DBCloseArea())
USE ArqImp New
APPEND FROM "&cArqTxt" SDF
ArqImp->(DbGoTop())
Do While !ArqImp->(Eof())
AAdd(mTexto,{ArqImp->Txtlinha})
Skip
EndDo
ArqImp->(__DBZap())
Delete File &cArqTxt
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
PrintCab( oPrinter )
oPrinter:NewLine()
lin:= 1
For z:=1 To Len(mTexto)
lin:= oPrinter:Prow()
oPrinter:TextOut(mTexto[z][1],.T.)
If lin > 60
oPrinter:NewPage()
PrintCab( oPrinter )
oPrinter:NewLine()
lin:= 1
EndIf
Next
oPrinter:EndDoc()
ENDIF
oPrinter:Destroy()
ENDIF
RETURN(NIL)
Procedure PrintCab( oPrinter )
LOCAL cFileName := "\ca6\espamol.bmp"
STATIC oBMp
if PCount() > 0
if oBMp == NIL
oBmp := Win32Bmp():new()
IF !oBmp:loadFile( cFileName )
Alert( "Arquivo BMP não encontrado" )
Return
ENDIF
EndIf
oBmp:draw( oPrinter, { 200, 200, 438, 290 } )
oPrinter:leftMargin := 1500
oPrinter:newline()
oPrinter:newline()
oPrinter:newline()
oPrinter:newline()
oPrinter:SetColor( BLUE ) //Azul negrito
* oPrinter:SetFont("Courier New",12,{3,-50})
oPrinter:SetFont('Courier New',10,{-1,14}, 700, .F., .F.)
oPrinter:TextOut(" Agrupamento de Escolas de Lagoa")
oPrinter:newline()
oPrinter:TextOut(" Listagem de Fotocopias")
//oPrinter:leftMargin :=
oPrinter:newline()
oPrinter:newline()
oPrinter:newline()
oPrinter:newline()
oPrinter:SetColor( BLACK )//Preto negrito
oPrinter:TextOut("Codigo Produto Esc Cor Preco")
oPrinter:SetFont('Courier New',10,{-1,14}, 0, .F., .F.) //Desliga o negrito
oPrinter:newline()
else
oBMP:Destroy()
endif
Return
*======================= Aqui come‡a a impressÆo de Imagens ===================
oBmp := Win32Prn():new()
cFileName := "\ca6\espamol.bmp"
oBmp := Win32Bmp():new()
IF .NOT. oBmp:loadFile( cFileName )
Alert( cFileName + " N’o encontrado..." )
ELSE
oBmp:draw( oPrinter, { 120, 120, 900, 400 } )
oPrinter:SetFont('Courier New',14,{1,14}, 0, .F., .F.)
oPrinter:SetPrc(oPrinter:Prow()+08, 40 )
* oPrinter:TextOut("Öcone impresso nas coordenadas: horizontal 1200, vertical 7500", .T.)
oPrinter:SetPrc(oPrinter:Prow()+01, 40 )
* oPrinter:TextOut("Tamanho do ¡cone: horizontal 1800, vertical 1500", .T.)
ENDIF
*====================== Usando sub-rotina para a impressÆo da imagem ========
cBmpFile := "\ca6\espamol.bmp"
PrintBitMap( oPrinter, cBMPFile )
oPrinter:EndDoc()
oPrinter:Destroy()
RETURN(NIL)
****************************************************************
Func Aguarde(nLin,nCol,nModo)
Local AntSC:= SetColor()
SetColor("b+*/gr+*")
If nModo = 1
Public TelMens:= SaveScreen(nLin-1,nCol-2,nLin+1,79)
@ nLin-1,nCol Clear to nLin+1,nCol+32
@ nLin-1,nCol to nLin+1,nCol+32
@ nLin,nCol+1 Say "Aguarde por favor .......... "
Else
RestScreen(nLin-1,nCol-2,nLin+1,79,TelMens)
EndIf
SetColor(AntSC)
Return
*************************************************************
Func SelAchoice(dir1,cSelec,xLen)
Local cTela
Local opc:= nLin1:= nLin2:= nCol1:= nCol2:= 0
Set Color To ("w+/bg+, w+/r+, bg+, ,w+/bg+")
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",(nCol2-nCol1))
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
**********************************************************************
Func GravArqTxt(NomeArq,mTexto,cModo)
* esta funcao escolhe um caminho apara gravar um arquivo .txt
Local TelAT:= SaveScreen(00,00,24,79)
Local cNomeArq:= Padr(NomeArq,8), SetCorAnt:= SetColor()
Local cUnid:= cCriar:= Space(1)
Local aDirx:= {}
cPasta:= Space(40)
Set Color To ("w+/bg+, w+/r+, bg+, ,w+/bg+")
@ 06,04 Clear To 12,50
@ 06,04 To 12,50
While cModo = "TXT"
@ 08,10 Say "Gravar na unidade: " Get cUnid Picture "@!"
@ 08,31 Say ":\"
@ 09,10 Say "Gravar na PASTA: " Get cPasta Picture "@S20!"
Read
cPasta:= AllTrim(cPasta)
cPasta:= cUnid + ":\" + cPasta + "\*."
aDirx:= Directory(cPasta,"D")
cPasta:= Left(cPasta,(Len(cPasta)-2))
If Len(aDirx) = 0
Alert(" pasta nÆo existe ")
@ 10,10 Say "Deseja criar esta pasta ? (S/N) " Get cCriar Picture "@!" Valid cCriar $"SN"
Read
If cCriar = "S"
RUN MD &cPasta
Else
Exit
EndIf
EndIf
@ 11,10 Say "Nome do Arquivo: " Get cNomeArq Picture "@S20!"
Read
Exit
EndDo
If LastKey() <> 27 .AND. cCriar <> "N"
GravTexto(AllTrim(cPasta),cNomeArq,mTexto)
EndIf
SetColor(SetCorAnt)
RestScreen(00,00,24,79,TelAT)
Return cNomeArq
*********************************************************************
FUNC Menu(v_msg,ylin,ycol,ldest,tel,tit,pos,PrimMenu,moldu)
*************************************************************
LOCAL vlen:=op_t:=pos_t:=1, ti:=ARRAY(6),cor_ant:=SETCOLOR(),;
yi, m_tam, col_i, lin_i, vti, tcol, tlin, op_n
IF PCOUNT() < 3
SETCOLOR(cor_ant)
RETURN(NIL)
ENDIF
tit = IF( VALTYPE(tit)="U","",tit)
op_n = IF( VALTYPE(pos)="U",1,pos)
moldu = IF( VALTYPE(moldu)="U","ÚÄ¿³ÙÄÀ³ ",moldu)
SET CURSOR OFF
If LastKey() = 27 // incluido por Rosalvo Rosa
KeyBoard Chr(0) // para quando uma funcao volta com ESC
EndIf
AFILL(ti," ")
IF LEN(v_msg) > 1
FOR yi = 1 TO LEN(v_msg)
IF vlen < LEN(v_msg[yi,1])
vlen=LEN(v_msg[yi,1])
ENDIF
NEXT
ELSE
vlen=LEN(v_msg[1,1])
ENDIF
IF !EMPTY(tit)
IF "|" $ tit
ti[op_t] = SUBSTR(tit,pos_t,yi-pos_t)
vti=SUBSTR(tit,pos_t-1,yi-(pos_t-1))
IF vlen < LEN(vti)
vlen=LEN(vti)
ENDIF
pos_t=yi
ELSE
ti[1]=tit
IF vlen < LEN(tit)
vlen=LEN(tit)
ENDIF
ENDIF
m_tam=ycol+vlen+3
IF m_tam > 80
ycol=INT((80 - (vlen+4)) / 2)
ENDIF
lin_i=ylin+op_t+LEN(v_msg)+2
col_i=ycol+vlen+2
tcol=vlen+2
tlin=LEN(v_msg)+op_t+1
SETCOLOR(xcorjane)
caixa(moldu,ylin,ycol,lin_i,col_i,.T.)
FOR yi=1 TO op_t
SETCOLOR(xcorjane)
@ ylin+yi, ycol+1 SAY PADC(ti[yi],vlen+1)
NEXT
@ ROW()+1,YCOL+1 SAY REPLICATE("Ä",vlen+1)
ylin=ylin+op_t+1
ELSE
m_tam=ycol+vlen+3
IF m_tam > 80
ycol=INT((80 - (vlen+4)) / 2)
ENDIF
lin_i=ylin+LEN(v_msg)+1
col_i=ycol+vlen+3
tcol=vlen+2
tlin=LEN(v_msg)+1
SETCOLOR(xcorjane)
caixa(moldu,ylin,ycol,lin_i,col_i,.T.)
vlen+=1
ENDIF
While .T.
SETCOLOR(xcorjane)
SET MESSAGE TO 24
SET WRAP ON
FOR yi = 1 TO LEN(v_msg)
@ ylin+yi, ycol+1 PROMPT " "+v_msg[yi,1]+REPLIC(" ",((vlen)-LEN(V_MSG[yi,1])));
MESSAGE v_msg[yi,2]+REPLIC(" ",68-LEN(v_msg[yi,2]))
NEXT
MENU TO op_n
SET CURSOR ON
SETCOLOR(cor_ant)
If op_n = 0 .AND. PrimMenu = 1
Loop
EndIf
Exit
EndDo
RETURN(op_n)
***************************************
Func caixa(ymoldura,ls,cs,li,ci,ysombra,ysom)
LOCAL vtela,cor_a:=SETCOLOR(), yi:=j:=k:=w:=x:=0, iouj:=1, yfim:=.f.
vtela:=SAVESCREEN(ls+1,cs+1,li+1,ci+2)
IF PCOUNT() < 6
SETCOLOR(cor_a)
RETURN
ENDIF
ysom = IF( VALTYPE( ysom ) = "U", 0, ysom)
IF ysombra
IF LEN(vtela)>3192 //2048
vtela:=TRANSFORM(SUBSTR(vtela,1,2048),REPLICATE("X"+CHR(6),1000))+;
TRANSFORM(SUBSTR(vtela,2049),REPLICATE("X"+CHR(6),1000))
ELSE
vtela:=TRANSFORM(vtela,REPLICATE("X"+CHR(6),LEN(vtela)/2))
ENDIF
ENDIF
yi:=INT((li-ls)/2+ls)
j:=INT((ci-cs)/2+cs)
k:=yi
w:=j+1
IF yi<j
iouj:=1
ELSE
iouj:=2
ENDIF
yfim=.f.
DO WHILE .t.
IF iouj=1
IF j=cs
yfim=.T.
ENDIF
ELSE
IF yi=ls
yfim=.T.
ENDIF
ENDIF
IF yfim
RESTSCREEN(ls+1,cs+1,li+1,ci+2,vtela)
@ ls,cs,li,ci BOX ymoldura+" "
EXIT
ELSE
@ yi,j,k,w BOX ymoldura+" "
IF yi!=ls
yi--
ELSE
yi=ls
ENDIF
IF j>cs
j--
ELSE
j=cs
ENDIF
IF k!=li
k++
ELSE
k=li
ENDIF
IF w<ci
w++
ELSE
w=ci
ENDIF
ENDIF
ENDDO
IF ysom!=0
IF xsom
TONE(ysom)
ENDIF
ENDIF
SETCOLOR(cor_a)
RETURN
*************************************************
*------------------------------------------------------------------------------
procedure PrintBitMap( oPrn, cBitFile )
LOCAL oBMP
IF EMPTY( cBitFile )
&& Pode-se incluir aqui uma imagem alternativa.
ELSEIF !FILE( cBitFile )
Alert( "Arquivo " + cBitFile + " nÆo encontrado." )
ELSE
oBMP:= Win32BMP():new()
IF oBmp:loadFile( cBitFile )
oBmp:Draw( oPrn, { 200,10000, 1000, 750 } )
&& Esta alternativa abaixo que tamb‚m pode ser usada.
oBmp:Rect:= { 2000,10000, 1000, 750 }
oPrn:DrawBitMap( oBmp )
ENDIF
oBMP:Destroy()
ENDIF
RETURN
Apreciarei a sua resposta.
Muito obrigado.
lapinhazzz
-
sygecom
- Administrador
- Mensagens: 7131
- Registrado em: 21 Jul 2006 10:12
- Localização: Alvorada-RS
- Contato:
Re: winprn32() e impressão de quadrados
Olá Lapinhazzz,
Seu problema não está nesse codigo ai, e sim no codigo que gera o ARQUIVO.TXT, ou você tirar fora na hora da criação do arquivo, ou use tranto dirento na sua função LerArqTxt() conforme o exemplo abaixo:
Seu problema não está nesse codigo ai, e sim no codigo que gera o ARQUIVO.TXT, ou você tirar fora na hora da criação do arquivo, ou use tranto dirento na sua função LerArqTxt() conforme o exemplo abaixo:
Código: Selecionar todos
**************************************************************
Func LerArqTxt(cArquivo)
* esta fun‡ao grava uma array a partir de um arquivo .txt
Local aStruct:= {}, mTexto:= {}
cArqTxt:= cArquivo
If (!File("ArqImp.dbf"))
aStruct:={}
AAdd(aStruct, {"Txtlinha", "C",250, 0})
DBCreate("ArqImp.dbf",aStruct)
EndIf
USE ArqImp New
ArqImp->(__DBZap())
ArqImp->(DBCloseArea())
USE ArqImp New
APPEND FROM "&cArqTxt" SDF
ArqImp->(DbGoTop())
Do While !ArqImp->(Eof())
IF alltrim(ArqImp->Txtlinha)=Chr(12) // EJECT( SALTO DE PAGINA )
skip
loop
endif
IF alltrim(ArqImp->Txtlinha)=Chr(15) // COMPACTAÇÃO DE CARACRTERES
skip
loop
endif
IF alltrim(ArqImp->Txtlinha)=Chr(18) // DESCOMPACTAÇÃO DE CARACRTERES
skip
loop
endif
AAdd(mTexto,{ArqImp->Txtlinha})
Skip
EndDo
ArqImp->(__DBZap())
Delete File &cArqTxt
Return mTexto
Leonardo Machado
xHarbour.org + Hwgui + PostgreSql
xHarbour.org + Hwgui + PostgreSql
-
lapinhazzz
- Usuário Nível 3
- Mensagens: 130
- Registrado em: 20 Abr 2009 10:52
- Localização: LAGOA
Re: winprn32() e impressão de quadrados
Boa Noite amigo sygecom e a todos do forum:
Alterei o codigo e continuo a ter quadrados
Aqui vai o codigo
Muito obrigado e aguardo na expectativa uma resposta.
Vai em anexo um arquivo pdf que demonstra o resultado
Cumprimentos
Lapinhazzz
Alterei o codigo e continuo a ter quadrados
Aqui vai o codigo
Código: Selecionar todos
#define RED RGB( 0x85,0x0 ,0x0 )
#define BLACK RGB( 0x0 ,0x0 ,0x0 )
#define BLUE RGB( 0x0 ,0x0 ,0x85 )
Func mv_imp2()
sele 4
OrdSetFocus("svenda4")
SetImpressora("ON")
inicio=ctod(' / / /')
fim=ctod(' / / ')
set devi to scree
@ 10,10 say "De:" get inicio
* @ 10,20 say "Ate:" get fim
read
set devi to prin
z=0
sele 6
*use escaloes
go bott
indicador=cescalao
go top
skip
indicador2=1
rescalao=cescalao
vescalao:=array(val(indicador))
nescalao:=array(val(indicador))
vaescalao:=array(val(indicador))
afill(vaescalao,0)
afill(vescalao,0)
afill(nescalao,0)
whil indicador2<=val(indicador)
nescalao[indicador2]=cescalao
vescalao[indicador2]=escalao
vaescalao[indicador2]=precov
skip
indicador2++
endd
n=0
sele 4
*use senhas
go top
rtaxa=taxav
nprecov:=array(val(indicador))
afill(nprecov,0)
rescalao=val(cescalao)
indicador2=1
While !eof() .OR. (inicio=datactual .or. inicio=datarefer) .AND. mardes=2
IF rescalao=indicador2
nprecov[indicador2]=nprecov[indicador2]+precov
IF taxa=1
rtaxa=rtaxa+taxav
n++
endif
skip
else
indicador2++
ENDIF
rescalao=val(cescalao)
endd
sele 4
indicador2=1
go top
While indicador2<=val(indicador)
IF indicador2=1
@ indicador2,00 Say "+----------------------------------------------+"
endif
@ indicador2+1,1 Say substr(str(val(nescalao[indicador2])),2,2)
@ indicador2+1,2 say vaescalao[indicador2]
@ indicador2+1,3 Say vescalao[indicador2]
@ indicador2+1,4 Say nprecov[indicador2]
@ indicador2+1,5 Say "Taxas: "+str(taxa)
indicador2++
endd
SetImpressora("OFF")
Return
***************************************************
Func SetImpressora(cSI)
// possiveis cSI = ON -> para iniciar a gravar o arquivo texto
// OFF -> para jogar na impressora
Local mImpr:= {}, aPrn:= {}, mTexto:= {}
Local nPrn:= 0, cPrinter:= Space(0)
Local TelaPrn:= SaveScreen(00,00,24,79)
Local cLinha:= Space(0)
xcorjane="W/B" //Estas variaveis tem que ser declaradas
xcorletra="GR+/RD" //sao as cores usadas na funcao
xcorcursor="N/W" //Menu( )
cSI:= UPPER(cSI)
If cSI = "ON"
Clear Screen
Public cModoImp:= Space(10)
opc=1
tel_si=SAVESCREEN(0,0,24,79)
DO WHILE .T.
v_m:={{"1 - IMPRES. PADRAO "," "},;
{"2 - IMPRES. NA REDE "," "},;
{"3 - GRAVAR ARQUIVO "," "},;
{"4 - VOLTAR"," "}}
l_m:="1234"
opc=Menu(v_m,10,22,l_m,TelaPrn,"- PARA IMPRIMIR -",opc,0)
IF opc=0
EXIT
ENDIF
Do Case
Case opc = 1
cModoImp:= "PADRAO"
Exit
Case opc = 2
cModoImp:= "NA REDE"
Exit
Case opc = 3
cModoImp:= "GRAVAR ARQUIVO"
Exit
Case opc = 4 .OR. opc = 0
cModoImp:= "VOLTAR"
Exit
EndCase
RestScreen(0, 0, 24, 79, Tel_opc)
EndDo
Aguarde(19,06,1)
SET PRINTER TO "ARQUIVO.TXT"
SET DEVICE TO PRINTER
OK:= 0
EndIf
If cSI = "OFF"
SET PRINTER TO
SET DEVICE TO SCREEN
Aguarde(19,06,1)
mTexto:= LerArqTxt("ARQUIVO.TXT")
nPrn:= 1
Do Case
Case cModoImp = "NA REDE"
aPrn:= GetPrinters()
@ 04, 04 Clear To 20, 70
@ 04, 04 To 20, 70
IF EMPTY(aPrn)
Alert("No printers installed - Cannot continue")
QUIT
ENDIF
@ 05, 06 Say " escolha a impressora : "
cPrinter:= AllTrim(SelAchoice(aPrn,@cPrinter,30))
Aguarde(19,06,1)
Case cModoImp = "GRAVAR ARQUIVO"
cNomeArq:= GravArqTxt("ArqImp",mTexto,"TXT")
Case cModoImp = "PADRAO"
cPrinter:= GetDefaultPrinter()
EndCase
If LastKey() <> 27 .AND. !Empty(cPrinter) .AND. Len(mTexto) > 0
PrinterArquivo(mTexto,cPrinter)
EndIf
RETURN
EndIf
RestScreen(00,00,24,79,TelaPrn)
Return NIL
***********************************************
Func GravTexto(wLocal,w_ArqTxt,mTexto)
* esta fun‡ao grava um arquivo .txt a partir da array
* ex: wlocal := "f:\nfe"
* ex: warqtxt := "&wlocal\nota.txt"
If !Empty(wLocal)
warqtxt:= AllTrim(wLocal)+"\"+AllTrim(w_ArqTxt)
Else
warqtxt:= AllTrim(w_ArqTxt)
EndIf
ret_line := "chr(13)+chr(10)"
errhandle := FCREATE("&warqtxt" + ".txt")
For z:=1 To Len(mTexto)
cLinha:= mTexto[z][1]
FWRITE(errhandle,cLinha+&ret_line.)
Next
FCLOSE(errhandle)
FCLOSE("&warqtxt" + ".txt")
nREG := recco()
Return
**************************************************************
/*
Func LerArqTxt(cArquivo)
* esta fun‡ao grava uma array a partir de um arquivo .txt
Local aStruct:= {}, mTexto:= {}
cArqTxt:= cArquivo
If (!File("ArqImp.dbf"))
aStruct:={}
AAdd(aStruct, {"Txtlinha", "C",250, 0})
DBCreate("ArqImp.dbf",aStruct)
EndIf
USE ArqImp New
ArqImp->(__DBZap())
ArqImp->(DBCloseArea())
USE ArqImp New
APPEND FROM "&cArqTxt" SDF
ArqImp->(DbGoTop())
Do While !ArqImp->(Eof())
AAdd(mTexto,{ArqImp->Txtlinha})
Skip
EndDo
ArqImp->(__DBZap())
Delete File &cArqTxt
Return mTexto */
**************************************************************
Func LerArqTxt(cArquivo)
* esta fun‡ao grava uma array a partir de um arquivo .txt
Local aStruct:= {}, mTexto:= {}
cArqTxt:= cArquivo
If (!File("ArqImp.dbf"))
aStruct:={}
AAdd(aStruct, {"Txtlinha", "C",250, 0})
DBCreate("ArqImp.dbf",aStruct)
EndIf
USE ArqImp New
ArqImp->(__DBZap())
ArqImp->(DBCloseArea())
USE ArqImp New
APPEND FROM "&cArqTxt" SDF
ArqImp->(DbGoTop())
Do While !ArqImp->(Eof())
IF alltrim(ArqImp->Txtlinha)=Chr(12) // EJECT( SALTO DE PAGINA )
skip
loop
endif
IF alltrim(ArqImp->Txtlinha)=Chr(15) // COMPACTAۂO DE CARACRTERES
skip
loop
endif
IF alltrim(ArqImp->Txtlinha)=Chr(18) // DESCOMPACTAۂO DE CARACRTERES
skip
loop
endif
AAdd(mTexto,{ArqImp->Txtlinha})
Skip
EndDo
ArqImp->(__DBZap())
Delete File &cArqTxt
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
PrintCab( oPrinter )
oPrinter:NewLine()
lin:= 1
For z:=1 To Len(mTexto)
lin:= oPrinter:Prow()
oPrinter:TextOut(mTexto[z][1],.T.)
If lin > 60
oPrinter:NewPage()
PrintCab( oPrinter )
oPrinter:NewLine()
lin:= 1
EndIf
Next
oPrinter:EndDoc()
ENDIF
oPrinter:Destroy()
ENDIF
RETURN(NIL)
Procedure PrintCab( oPrinter )
LOCAL cFileName := "\ca6\espamol.bmp"
STATIC oBMp
if PCount() > 0
if oBMp == NIL
oBmp := Win32Bmp():new()
IF !oBmp:loadFile( cFileName )
Alert( "Arquivo BMP não encontrado" )
Return
ENDIF
EndIf
oBmp:draw( oPrinter, { 200, 200, 438, 290 } )
oPrinter:leftMargin := 1500
oPrinter:newline()
oPrinter:newline()
oPrinter:newline()
oPrinter:newline()
oPrinter:SetColor( BLUE ) //Azul negrito
* oPrinter:SetFont("Courier New",12,{3,-50})
oPrinter:SetFont('Courier New',10,{-1,14}, 700, .F., .F.)
oPrinter:TextOut(" Agrupamento de Escolas de Lagoa")
oPrinter:newline()
oPrinter:TextOut(" Listagem de Senhas Vendidas")
oPrinter:TextOut(" ")
//oPrinter:leftMargin :=
oPrinter:newline()
oPrinter:newline()
oPrinter:newline()
oPrinter:newline()
oPrinter:SetColor( BLACK ) //Preto negrito
oPrinter:TextOut("Codigo Produto Esc Cor Preco")
oPrinter:SetFont('Courier New',10,{-1,14}, 0, .F., .F.) //Desliga o negrito
oPrinter:newline()
else
oBMP:Destroy()
endif
Return
*======================= Aqui come‡a a impressÆo de Imagens ===================
oBmp := Win32Prn():new()
cFileName := "\ca6\espamol.bmp"
oBmp := Win32Bmp():new()
IF .NOT. oBmp:loadFile( cFileName )
Alert( cFileName + " N’o encontrado..." )
ELSE
oBmp:draw( oPrinter, { 120, 120, 900, 400 } )
oPrinter:SetFont('Courier New',14,{1,14}, 0, .F., .F.)
oPrinter:SetPrc(oPrinter:Prow()+08, 40 )
* oPrinter:TextOut("Öcone impresso nas coordenadas: horizontal 1200, vertical 7500", .T.)
oPrinter:SetPrc(oPrinter:Prow()+01, 40 )
* oPrinter:TextOut("Tamanho do ¡cone: horizontal 1800, vertical 1500", .T.)
ENDIF
*====================== Usando sub-rotina para a impressÆo da imagem ========
cBmpFile := "\ca6\espamol.bmp"
PrintBitMap( oPrinter, cBMPFile )
oPrinter:EndDoc()
oPrinter:Destroy()
RETURN(NIL)
****************************************************************
Func Aguarde(nLin,nCol,nModo)
Local AntSC:= SetColor()
SetColor("b+*/gr+*")
If nModo = 1
Public TelMens:= SaveScreen(nLin-1,nCol-2,nLin+1,79)
@ nLin-1,nCol Clear to nLin+1,nCol+32
@ nLin-1,nCol to nLin+1,nCol+32
@ nLin,nCol+1 Say "Aguarde por favor .......... "
Else
RestScreen(nLin-1,nCol-2,nLin+1,79,TelMens)
EndIf
SetColor(AntSC)
Return
*************************************************************
Func SelAchoice(dir1,cSelec,xLen)
Local cTela
Local opc:= nLin1:= nLin2:= nCol1:= nCol2:= 0
Set Color To ("w+/bg+, w+/r+, bg+, ,w+/bg+")
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",(nCol2-nCol1))
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
**********************************************************************
Func GravArqTxt(NomeArq,mTexto,cModo)
* esta funcao escolhe um caminho apara gravar um arquivo .txt
Local TelAT:= SaveScreen(00,00,24,79)
Local cNomeArq:= Padr(NomeArq,8), SetCorAnt:= SetColor()
Local cUnid:= cCriar:= Space(1)
Local aDirx:= {}
cPasta:= Space(40)
Set Color To ("w+/bg+, w+/r+, bg+, ,w+/bg+")
@ 06,04 Clear To 12,50
@ 06,04 To 12,50
While cModo = "TXT"
@ 08,10 Say "Gravar na unidade: " Get cUnid Picture "@!"
@ 08,31 Say ":\"
@ 09,10 Say "Gravar na PASTA: " Get cPasta Picture "@S20!"
Read
cPasta:= AllTrim(cPasta)
cPasta:= cUnid + ":\" + cPasta + "\*."
aDirx:= Directory(cPasta,"D")
cPasta:= Left(cPasta,(Len(cPasta)-2))
If Len(aDirx) = 0
Alert(" pasta nÆo existe ")
@ 10,10 Say "Deseja criar esta pasta ? (S/N) " Get cCriar Picture "@!" Valid cCriar $"SN"
Read
If cCriar = "S"
RUN MD &cPasta
Else
Exit
EndIf
EndIf
@ 11,10 Say "Nome do Arquivo: " Get cNomeArq Picture "@S20!"
Read
Exit
EndDo
If LastKey() <> 27 .AND. cCriar <> "N"
GravTexto(AllTrim(cPasta),cNomeArq,mTexto)
EndIf
SetColor(SetCorAnt)
RestScreen(00,00,24,79,TelAT)
Return cNomeArq
*********************************************************************
FUNC Menu(v_msg,ylin,ycol,ldest,tel,tit,pos,PrimMenu,moldu)
*************************************************************
LOCAL vlen:=op_t:=pos_t:=1, ti:=ARRAY(6),cor_ant:=SETCOLOR(),;
yi, m_tam, col_i, lin_i, vti, tcol, tlin, op_n
IF PCOUNT() < 3
SETCOLOR(cor_ant)
RETURN(NIL)
ENDIF
tit = IF( VALTYPE(tit)="U","",tit)
op_n = IF( VALTYPE(pos)="U",1,pos)
moldu = IF( VALTYPE(moldu)="U","ÚÄ¿³ÙÄÀ³ ",moldu)
SET CURSOR OFF
If LastKey() = 27 // incluido por Rosalvo Rosa
KeyBoard Chr(0) // para quando uma funcao volta com ESC
EndIf
AFILL(ti," ")
IF LEN(v_msg) > 1
FOR yi = 1 TO LEN(v_msg)
IF vlen < LEN(v_msg[yi,1])
vlen=LEN(v_msg[yi,1])
ENDIF
NEXT
ELSE
vlen=LEN(v_msg[1,1])
ENDIF
IF !EMPTY(tit)
IF "|" $ tit
ti[op_t] = SUBSTR(tit,pos_t,yi-pos_t)
vti=SUBSTR(tit,pos_t-1,yi-(pos_t-1))
IF vlen < LEN(vti)
vlen=LEN(vti)
ENDIF
pos_t=yi
ELSE
ti[1]=tit
IF vlen < LEN(tit)
vlen=LEN(tit)
ENDIF
ENDIF
m_tam=ycol+vlen+3
IF m_tam > 80
ycol=INT((80 - (vlen+4)) / 2)
ENDIF
lin_i=ylin+op_t+LEN(v_msg)+2
col_i=ycol+vlen+2
tcol=vlen+2
tlin=LEN(v_msg)+op_t+1
SETCOLOR(xcorjane)
caixa(moldu,ylin,ycol,lin_i,col_i,.T.)
FOR yi=1 TO op_t
SETCOLOR(xcorjane)
@ ylin+yi, ycol+1 SAY PADC(ti[yi],vlen+1)
NEXT
@ ROW()+1,YCOL+1 SAY REPLICATE("Ä",vlen+1)
ylin=ylin+op_t+1
ELSE
m_tam=ycol+vlen+3
IF m_tam > 80
ycol=INT((80 - (vlen+4)) / 2)
ENDIF
lin_i=ylin+LEN(v_msg)+1
col_i=ycol+vlen+3
tcol=vlen+2
tlin=LEN(v_msg)+1
SETCOLOR(xcorjane)
caixa(moldu,ylin,ycol,lin_i,col_i,.T.)
vlen+=1
ENDIF
While .T.
SETCOLOR(xcorjane)
SET MESSAGE TO 24
SET WRAP ON
FOR yi = 1 TO LEN(v_msg)
@ ylin+yi, ycol+1 PROMPT " "+v_msg[yi,1]+REPLIC(" ",((vlen)-LEN(V_MSG[yi,1])));
MESSAGE v_msg[yi,2]+REPLIC(" ",68-LEN(v_msg[yi,2]))
NEXT
MENU TO op_n
SET CURSOR ON
SETCOLOR(cor_ant)
If op_n = 0 .AND. PrimMenu = 1
Loop
EndIf
Exit
EndDo
RETURN(op_n)
***************************************
Func caixa(ymoldura,ls,cs,li,ci,ysombra,ysom)
LOCAL vtela,cor_a:=SETCOLOR(), yi:=j:=k:=w:=x:=0, iouj:=1, yfim:=.f.
vtela:=SAVESCREEN(ls+1,cs+1,li+1,ci+2)
IF PCOUNT() < 6
SETCOLOR(cor_a)
RETURN
ENDIF
ysom = IF( VALTYPE( ysom ) = "U", 0, ysom)
IF ysombra
IF LEN(vtela)>3192 //2048
vtela:=TRANSFORM(SUBSTR(vtela,1,2048),REPLICATE("X"+CHR(6),1000))+;
TRANSFORM(SUBSTR(vtela,2049),REPLICATE("X"+CHR(6),1000))
ELSE
vtela:=TRANSFORM(vtela,REPLICATE("X"+CHR(6),LEN(vtela)/2))
ENDIF
ENDIF
yi:=INT((li-ls)/2+ls)
j:=INT((ci-cs)/2+cs)
k:=yi
w:=j+1
IF yi<j
iouj:=1
ELSE
iouj:=2
ENDIF
yfim=.f.
DO WHILE .t.
IF iouj=1
IF j=cs
yfim=.T.
ENDIF
ELSE
IF yi=ls
yfim=.T.
ENDIF
ENDIF
IF yfim
RESTSCREEN(ls+1,cs+1,li+1,ci+2,vtela)
@ ls,cs,li,ci BOX ymoldura+" "
EXIT
ELSE
@ yi,j,k,w BOX ymoldura+" "
IF yi!=ls
yi--
ELSE
yi=ls
ENDIF
IF j>cs
j--
ELSE
j=cs
ENDIF
IF k!=li
k++
ELSE
k=li
ENDIF
IF w<ci
w++
ELSE
w=ci
ENDIF
ENDIF
ENDDO
IF ysom!=0
IF xsom
TONE(ysom)
ENDIF
ENDIF
SETCOLOR(cor_a)
RETURN
*************************************************
*------------------------------------------------------------------------------
procedure PrintBitMap( oPrn, cBitFile )
LOCAL oBMP
IF EMPTY( cBitFile )
&& Pode-se incluir aqui uma imagem alternativa.
ELSEIF !FILE( cBitFile )
Alert( "Arquivo " + cBitFile + " nÆo encontrado." )
ELSE
oBMP:= Win32BMP():new()
IF oBmp:loadFile( cBitFile )
oBmp:Draw( oPrn, { 200,10000, 1000, 750 } )
&& Esta alternativa abaixo que tamb‚m pode ser usada.
oBmp:Rect:= { 2000,10000, 1000, 750 }
oPrn:DrawBitMap( oBmp )
ENDIF
oBMP:Destroy()
ENDIF
RETURN
*
*---------------------------------------------------------------------------------------------------
Vai em anexo um arquivo pdf que demonstra o resultado
Cumprimentos
Lapinhazzz
- Anexos
-
teste.pdf- (13.04 KiB) Baixado 166 vezes
-
sygecom
- Administrador
- Mensagens: 7131
- Registrado em: 21 Jul 2006 10:12
- Localização: Alvorada-RS
- Contato:
Re: winprn32() e impressão de quadrados
Olá Lapinhazzz,
Seu problema é que seus CHR() estão na mesma linha das palavras que devem sair impressão, e no seu LerArqTxt() você apenas ignora as linhas que SOMENTE tem CHR(), então você terá que usar um $ para percorrer pela linha toda atraz de um CHR() e subistitur ele por um caracter vazio( "" ).
Ou esses caracteres sejam acentuação que esteja vindo do DBF, tente retirar os acentos antes de imprimir.
Seu problema é que seus CHR() estão na mesma linha das palavras que devem sair impressão, e no seu LerArqTxt() você apenas ignora as linhas que SOMENTE tem CHR(), então você terá que usar um $ para percorrer pela linha toda atraz de um CHR() e subistitur ele por um caracter vazio( "" ).
Ou esses caracteres sejam acentuação que esteja vindo do DBF, tente retirar os acentos antes de imprimir.
Leonardo Machado
xHarbour.org + Hwgui + PostgreSql
xHarbour.org + Hwgui + PostgreSql
-
lapinhazzz
- Usuário Nível 3
- Mensagens: 130
- Registrado em: 20 Abr 2009 10:52
- Localização: LAGOA
Re: winprn32() e impressão de quadrados
Bom Dia sygecom e a todos do forum.
Tentei fazer uma pequena rotina para testar se chr(13)$txtlinha era verdadeiro e de facto existe e é .T.
Mas isto só detecta se houver pelo menos um chr(13)
Captei o tamanho de txtlinha ou seja len(txtlinha)
Depois faço um
Não estou conseguindo fazer isto.
Ajude-me por favor.
Muito agradecido.
lapinhazzz
Tentei fazer uma pequena rotina para testar se chr(13)$txtlinha era verdadeiro e de facto existe e é .T.
Mas isto só detecta se houver pelo menos um chr(13)
Captei o tamanho de txtlinha ou seja len(txtlinha)
Depois faço um
Código: Selecionar todos
if chr(13)$txtlinha
linha=txtlinha
for n= 1 to tamanho da txtlinha
if subs(txtlinha,n,1)=chr(13)
strtran(txtlinha...
endif
next n
endifAjude-me por favor.
Muito agradecido.
lapinhazzz
Editado pela última vez por Toledo em 09 Fev 2011 13:02, em um total de 1 vez.
Razão: Mensagem editada para colocar a tag [ code ]<br>Veja como utilizar esta tag: http://www.pctoledo.com.br/forum/faq.php?mode=bbcode#f2r1
Razão: Mensagem editada para colocar a tag [ code ]<br>Veja como utilizar esta tag: http://www.pctoledo.com.br/forum/faq.php?mode=bbcode#f2r1
-
lapinhazzz
- Usuário Nível 3
- Mensagens: 130
- Registrado em: 20 Abr 2009 10:52
- Localização: LAGOA
Re: winprn32() e impressão de quadrados
Bom Dia a todos do forum
Descobri que o problema reside nos arrays.
Quando mando imprimir os arrays para arquivo.txt e faço o append from então ficam no fim o chr(13)
Podem comprovar através do programa simple que fiz.
Compilem e verifiquem a base de dados.
Peço ajuda porque não consigo me livrar desses caracteres.
O problema é dos arrays.
Como resolvo?
Agradeço a todos
Lapinhazzz
Descobri que o problema reside nos arrays.
Quando mando imprimir os arrays para arquivo.txt e faço o append from então ficam no fim o chr(13)
Podem comprovar através do programa simple que fiz.
Compilem e verifiquem a base de dados.
Peço ajuda porque não consigo me livrar desses caracteres.
O problema é dos arrays.
Como resolvo?
Agradeço a todos
Lapinhazzz
- Anexos
-
teste.rar- (2.98 KiB) Baixado 134 vezes
-
Toledo
- Administrador
- Mensagens: 3133
- Registrado em: 22 Jul 2003 18:39
- Localização: Araçatuba - SP
- Contato:
Re: winprn32() e impressão de quadrados
Amigo Lapinhazzz, o problema é que você não está respeitando o espaço de impressão entre um campo e outro, em grosso modo você encavalando um campo sobre o outro.
Abraços,
Observe que no seu exemplo acima, a primeira linha será impressa na coluna 1, a segunda linha na coluna 2, a terceira na coluna 3, etc... Bom, acho que o conteúdo de cada uma destas colunas não tenha o tamanho apenas de 1 caractere ou um número. Então, basta respeitar o tamanho de cada coluna que não será mais apresentado os "quadrados". Procure utilizar a função TRANSFORM() ou STR() para definir um tamanho para cada coluna.Lapinhazzz escreveu: @ indicador2+1,1 Say substr(str(val(nescalao[indicador2])),2,2)
@ indicador2+1,2 say vaescalao[indicador2]
@ indicador2+1,3 Say vescalao[indicador2]
@ indicador2+1,4 Say nprecov[indicador2]
@ indicador2+1,5 Say "Taxas: "+str(taxa)
Abraços,
Toledo - Clipper On Line
toledo@pctoledo.com.br
Harbour 3.2/MiniGui/HwGui
Faça uma doação para o fórum, clique neste link: http://www.pctoledo.com.br/doacao
toledo@pctoledo.com.br
Harbour 3.2/MiniGui/HwGui
Faça uma doação para o fórum, clique neste link: http://www.pctoledo.com.br/doacao
-
lapinhazzz
- Usuário Nível 3
- Mensagens: 130
- Registrado em: 20 Abr 2009 10:52
- Localização: LAGOA
Re: winprn32() e impressão de quadrados
Boa Noite amigos do Forum,
Consegui fazer desaparecer os quadrados.
Aqui vai o código
Obrigado a todos
Lapinhazzz
Consegui fazer desaparecer os quadrados.
Aqui vai o código
Código: Selecionar todos
FOR inicioesc := 1 TO fimesc
IF inicioesc=1
@ 1,1 say "+-------------------------------------------------------------------------------------------------------------+"
ENDIF
linha=linha+tran(nescalao[inicioesc],'@E 999,999.99')
linha=linha+spac(5)+eescalao[inicioesc]
linha=linha+spac(5)+tran(vescalao[inicioesc],'@E 999,999.99')
linha=linha+spac(5)+tran(stotal[inicioesc],'@E 999,999.99')
linha=linha+spac(5)+tran(tescalao[inicioesc],'@E 999,999.99')
linha=linha+spac(5)+tran(sntaxa[inicioesc],'@E 999,999.99')
linha=linha+spac(5)+tran(staxa[inicioesc],'@E 999,999.99')
@inicioesc+1,1 say linha
linha=spac(1)
next
@ inicioesc+1,1 say "+-------------------------------------------------------------------------------------------------------------+"
@ inicioesc+2,1 say "Totais----------------------------------------->"+tran(quantt,'@E 999,999.99')+spac(5)+tran(ttotal,'@E 999,999.99')+spac(5)+tran(ntaxas,'@E 999,999.99')+spac(5)+tran(ttaxas,'@E 999,999.99')
Lapinhazzz