#include 'Pscript.ch'
#include 'Printsys.ch'
// Em todos os .prg que forem usar os comandos do pagescript é necessário
// incluir esses dois .ch
// É necessários copiá-los para o seu \clipper5\include
* RELPAG.PRG
func RELPAG
LOCAL GetList := {}
sompag2 := SOMPAG := 0
ATRES=SAVESCREEN(2,0,24,79)
@ 2,0 clea to 24,79
inverso(2,0,'RELATORIO DE CONTAS A PAGAR')
/************ - A partir daqui até ########## é só definindo o *arquivo, filtrando, etc.*/
SELE PAGAR
SET RELA TO COFOCLI INTO FORNEC
@ 11,49 TO 13,62
@ 12,50 SAY 'DATA INICIAL'
@ 15,49 TO 17,60
@ 16,50 SAY 'DATA FINAL'
@ 11,64 TO 13,75
@ 15,64 TO 17,75
DATAIN=CTOD('')
DATAFI=DATAIN
@ 12,65 GET DATAIN
READ
MARIO2=.T.
DO WHIL MARIO2
IF !EMPT(DATAIN)
@ 16,65 GET DATAFI
READ
ELSE
EXIT
ENDI
IF DATAFI<DATAIN
TECLE('DATA FINAL INVALIDA.')
MARIO2=.F.
LOOP
ENDI
exit
ENDD
cli = 0
MOSTRA('Digite o código - (PgDn-Pesquisar)')
@ 4,1 say 'Digite o Código do fornecedor.: 'get cli pict '99999'
read
limpa()
IF LASTKEY()= 3
cli = escomer('FORNEC','NOME','CODFOR')
endif
if !empty(cli)
sele fornec
seek cli
if eof()
Tecle('Fornecedor não encontrado.')
@ 2, 0 clear to 24, 79
sele pagar
set rela to
limpa()
return nil
endif
cor(2)
@ 3,1 say cli pict '99999'
@ 3,10 say fornec->nome
cor(1)
end
MXDOCUM = SPAC(5)
MXDOCESC = GETADO(3,'CDT','INFORME.' , {'CHEQUE PRÉ' , 'DUPLICATAS', 'TODOS'})
MXDOCESC2 = if(MXDOCESC#"T",IF(MXDOCESC = "C" , 'CH' , 'DPL'),MXDOCESC)
DICA=GETADO(5,'NLTFX','INFORME.' , {'Não Liquidadas' , 'Liquidadas' , 'Todas' , 'Uma NF' , 'Sair'})
IF DICA = "X"
RESTSCREEN(2,0,24,79,ATRES)
set filt to
set rela to
limpa()
RETURN NIL
end
if dica = "F"
njdocum = space(9)
@ 24,1 say 'Entre o nº da NF.: ' get njdocum
read
@ 24,1
end
SELE PAGAR
dbgotop()
condicao = ''
IF !EMPT(DATAFI) .AND. !EMPT(DATAIN)
condicao = condicao + 'VENCTO>=DATAIN .AND. VENCTO<=DATAFI'
ENDI
*condicao = condicao + if(!empty(condicao),' .AND. ' , '')
if dica = "N"
condicao = condicao + if(!empty(condicao),' .AND. ' , '') + '!LIQUID'
elseif dica = "L"
condicao = condicao + if(!empty(condicao),' .AND. ' , '') + 'LIQUID'
elseif dica = "F"
condicao = condicao + if(!empty(condicao),' .AND. ' , '') + 'docum==njdocum'
end
if !empty(cli)
condicao = condicao + if(!empty(condicao),' .AND. ' , '') + 'COFOCLI = CLI'
end
if mxdocesc # "T"
condicao = condicao + if(!empty(condicao),' .AND. ' , '') + 'TIPO = MXDOCESC2'
end
if !empty(condicao)
set filter to &condicao
dbgotop()
end
PAG=1
@ 24,01 SAY 'ENTRE O NO. DA FOLHA: 'GET PAG PICT '999'
READ
@ 24,01
SELE ontem
CGCIM=VEM(CGC)
IESTIM=VEM(IEST)
ENDERIM=VEM(ENDER)
LOCALIM=VEM(CEP)+' '+TRIM(VEM(CIDAD))+' '+VEM(UF)
SELE PAGAR
aordem := getado(1,'VAF', 'Informe a Ordem' , {'Vencimento' , 'Fornecedor-Alfabética' , 'Fornecedor-Código'})
if aordem == 'A'
saiindex = 'tl'+estacao
index on fornec->nome to &saiindex EVAL CDXPROGRESS() EVERY LASTREC()/100
limpa()
elseif aordem == "V"
dbsetorder(2)
End
dbgotop()
LIN=9
@ 24,01 SAY 'TECLE <P> PARA PARAR'
*############ Até aqui só definiu arquivos, filtrou, perguntou etc.
* A partir de agora começa o relatório
VERIMP()
//Verimp é uma função que pergunta ao usuário a forma como ele quer imprimir:
* I - Impressora DOS
* V - Vídeo
* W - Impressora Windows
if onde # "W";SET DEVI TO PRIN;end
// onde é uma variável pública que pode assumir 4 estados:
* I - Impressora DOS
* V - Vídeo
* W - Impressora Windows
* ' ' - Nenhum relatório sendo impresso no momento
* No primeiro caso imprime numa impressora via MS-DOS.
* No segundo caso, imprime direto para um .txt
* No terceiro caso imprime usando os comandos do PageScript
* No quarto caso nehum relatório sendo impresso.
* Ela é definida logo de cara como " ".
COMPAC(15) // Esta é a minha rotina de compactação da impressora
* Veja-a mais abaixo.
contporc=1
DO WHIL .NOT. EOF()
set devi to scre
porcent(contporc,recc()) // Só faz aparecer a % no canto do vídeo
if onde # "W";SET DEVI TO PRIN;end
// Somente se onde for # "W" é que pode ficar set device to print porque
// no caso de Windows não pode ser set device to print.
LIN=9
CABPAG() // Esta é a função que faz o cabeçalho.
DO WHIL LIN<57
AS=UPPER(CHR(INKE()))
IF AS='P'
LIN=57
dbgobottom()
ENDI
ROTPAG()
SOMPAG= sompag+ if(!liquid , (VALOR - vlrpago) , 0 )
sompag2 := sompag2 + if(liquid , vlrpago , 0 )
SKIP
contporc++
LIN++
IF EOF()
DO WHIL LIN < 57
@ LIN,06 print '|' //Observe que aqui em vez de @ l,c say é
@ LIN,44 print '|' //usado: @ l,c print
@ LIN,57 print '|' //Existe uma função print. Veja-a mais abaixo
@ LIN,65 print '|'
@ LIN,81 print '|'
@ lin,97 print "|"
@ lin,113 print "|"
@ lin,126 print '|'
LIN++
ENDD
ENDI
ENDD
IF .NOT. EOF()
PAG++
@ LIN,0 print REPL('-',137)
@ LIN+1,0 print DTOC(DATE())+' - '+TIME()+' Hs'
eject(1)
ENDI
ENDD
@ LIN,0 print REPL('-',137)
@ LIN+1,0 print DTOC(DATE())+' - '+TIME()+' Hs'
@ LIN+2,0 print 'Total a pagar.: '+transform(SOMPAG,'@E 99,999,999.99')+ ' Total pago.: '+ transform(SOMPAG2, '@E 99,999,999.99')
COMPAC(18)
EJECt(2)
SET DEVI TO SCRE
//set scrnsave on
FinalFila()
RESTSCREEN(2,0,24,79,ATRES)
set filt to
set rela to
sele pagar
dbclosearea()
usei('pagar')
limpa()
RETU nil
*------
FUNC INVERSO
PARA LININV,COLINV,MSG,PIC
COR(2)
IF TYPE('PIC')='U'
@ LININV,COLINV SAY MSG
ELSE
@ LININV,COLINV SAY MSG PICT PIC
ENDIF
COR(1)
RETU 0
*-----
FUNC COR
PARA MSG
DO CASE
CASE MSG=1
*COR PADRAO
lcor = iif(mmtipvid='C',"w+/b,b/w+,b","w+/n,n/w+,n")
CASE MSG=2
*COR INVERSA
lcor = iif(mmtipvid='C',"b/w+,w+/b,b","n/w+,w+/n,n")
CASE MSG=3
*COR DOS PROMPT
lcor = iif(mmtipvid='C',"w+/b,b/w+,b","w+/n,n/w+,n")
CASE MSG=4
*COR NORMAL
lcor = ("w+/n,n/w+,n")
CASE MSG=5
*COR DA EMPRESA
lcor = iif(mmtipvid='C','w+/RB+','n/w+')
CASE MSG=6
*COR DA SENHA
lcor = iif(mmtipvid='C','g/b,b/b,b','w+/n,n/n,n')
CASE MSG=7
*COR DOS DBEDIT's
lcor = iif(mmtipvid='C','n/rb,rb/n,b',"w+/n,n/w+,n")
CASE MSG=8
*COR DA EMPRESA
lcor = iif(mmtipvid='C','w+/R',"w+/n,n/w+,n")
ENDC
set color to &lcor
RETU nil
*-----------
FUNC VERIMP(msgver)
msgver=iif( type('msgver')='U',.t.,msgver)
onde = if(msgver , getado(2,'IVW', 'Informe.' , {'Impressora DOS' , 'Vídeo' , 'Impressora WINDOWS'}) , 'I')
if onde = "W"
nPrinter := SelectPrinter()
if nprinter # 0
PSBeginDoc(nPrinter,'STOQ2000')
PSSetUnit(APS_TEXT)
PSSetRowCol(62, 80) // 62 lines and 80 columns
PSSetFont(APS_COURIER, APS_PLAIN, 12, APS_BLACK, APS_NONE)
//PSSetFont(APS_DRAFT10, APS_PLAIN, 10, APS_BLACK, APS_NONE)
//PSBitmap(10, 10, , , "Agrisolo.bmp")
retu "S"
else
Tecle('Nenhuma impressora encontrada ou Controlador desativado. Seu ícone encontra-se no menu iniciar.')
onde = "V"
end
end
if onde = "I"
if escoimp()
if printers->termusu # printers->termfor
set device to printer
retu "S"
end
end
end
if onde ='V' .or. !isprinter()
do whil !isprinter() .and. onde='I'
tecle('Impressora não pronta.')
if !msgver
if confirma('Deseja Imprimir')='N'
exit
else
loop
endif
else
exit
endif
enddo
else
// set scrnsave off
set device to printer
retu "S"
endif
tecle('Após o término do relatório, visualize-o através da opção B do menu relatórios ou simplesmente tecle Alt+V.')
arqsai = 'tl'+estacao+'.txt'
set printer to &arqsai
//set scrnsave off
set device to printer
Retu 'S'
FUNC COMPAC(jkj,imple)
declare aprin1[114]
aprin1[15] := 136
aprin1[77] := 92
aprin1[81] := 154
aprin1[99] := 80
aprin1[14] := aprin1[20] := aprin1[69] := aprin1[70] := aprin1[114] := nil
aprin1[67] := aprin1[48] := nil
ritorna = aprin1[jkj]
if printers->timp = 'EPSON ' .and. onde # "W"
set prin on
??chr(27)+chr(120)+chr(0) &&Modo draft
*??chr(27)+chr(40)+chr(116)+chr(0)+chr(3)+chr(0) && PC-850
do case
case jkj = 14
??chr(14)
case jkj = 15 && Condensado
??chr(15)
case jkj = 18 && Descondensa
??chr(18)
case jkj = 20 && Expandido
??chr(20)
case jkj = 48
do case
case imple='6'
??chr(27)+chr(50)
??chr(27)+chr(67)+chr(62)
case imple='8'
??chr(27)+chr(48)
??chr(27)+chr(67)+chr(83)
case imple='M'
??chr(27)+chr(51)+chr(10)
??chr(27)+chr(67)+chr(225)
end
case jkj = 67
??chr(27)+chr(67)+chr(imple)
case jkj = 69
??chr(27)+chr(69)
case jkj = 70
??chr(27)+chr(70)
case jkj = 77 && 12 cpi
??chr(27)+chr(77)
case jkj = 80 && 10 cpi
??chr(27)+chr(80)
case jkj = 81 && 12 cpi + expandido
??chr(27)+chr(77)
??chr(15)
case jkj = 99
??chr(18)
case jkj = 114
do case
case colorgel = 'PRETO'
??chr(27)+chr(114)+'0'
case colorgel = 'VERMELHO'
??chr(27)+chr(114)+'5'
case colorgel = 'VERDE'
??chr(27)+chr(114)+'6'
case colorgel = 'CYAN'
??chr(27)+chr(114)+'2'
case colorgel = 'AZUL'
??chr(27)+chr(114)+'2'
case colorgel = 'MAGENTA'
??chr(27)+chr(114)+'1'
case colorgel = 'AMARELO'
??chr(27)+chr(114)+'4'
endc
endc
set prin off
elseif printers->timp = 'HP ' .and. onde # "W"
o10 := '10'
o12 := '12'
// Suponha-se que seja uma HP
set prin on
??Chr(27)+chr(40)+chr(49)+chr(50)+chr(85) && PC-850
if printers->econo="S"
??Chr(27)+chr(40)+chr(115)+chr(49)+chr(81) && EconoMode
Else
// Comando Normal
??Chr(27)+chr(40)+chr(115)+chr(50)+chr(81) && Letter
End
do case
case jkj = 14
??Chr(27)+chr(40)+chr(115)+'05'+chr(72)
case jkj = 15
??Chr(27)+chr(40)+chr(115)+'15'+chr(72)
case jkj = 18 .or. jkj = 20
??Chr(27)+chr(40)+chr(115)+if(cpt77,o12,o10)+chr(72)
case jkj = 48
do case
case imple='6'
??chr(27)+chr(38)+chr(108)+'06'+chr(68)
??chr(27)+chr(38)+chr(108)+'62'+chr(80)
case imple='8'
??chr(27)+chr(38)+chr(108)+'08'+chr(68)
??chr(27)+chr(38)+chr(108)+'83'+chr(80)
case imple='M'
??chr(27)+chr(38)+chr(108)+'21'+chr(68)
??chr(27)+chr(38)+chr(108)+'225'+chr(80)
end
case jkj = 67
??chr(27)+chr(38)+chr(108)+ltri(str(imple))+chr(80)
case jkj = 69
??Chr(27)+chr(40)+chr(115)+chr(51)+chr(66)
case jkj = 70
??Chr(27)+chr(40)+chr(115)+chr(48)+chr(66)
case jkj = 77
??Chr(27)+chr(40)+chr(115)+'12'+chr(72)
cpt77 := .t.
case jkj = 80
??Chr(27)+chr(40)+chr(115)+'10'+chr(72)
cpt77 := .f.
case jkj = 81
??Chr(27)+chr(40)+chr(115)+'18'+chr(72)
case jkj = 99
??Chr(27)+chr(40)+chr(115)+if(cpt77,o12,o10)+chr(72)
case jkj = 114
Cor := CHR(27)+CHR(42)+CHR(114)+CHR(45)+CHR(51)+CHR(85)
Azul := CHR(27)+CHR(42)+CHR(118)+'1'+CHR(83)
Magenta := CHR(27)+CHR(42)+CHR(118)+'2'+CHR(83)
Cyan := CHR(27)+CHR(42)+CHR(118)+'3'+CHR(83)
Amarelo := CHR(27)+CHR(42)+CHR(118)+'4'+CHR(83)
Verde := CHR(27)+CHR(42)+CHR(118)+'5'+CHR(83)
Vermelho := CHR(27)+CHR(42)+CHR(118)+'6'+CHR(83)
Preto := CHR(27)+CHR(42)+CHR(118)+'7'+CHR(83)
do case
case colorgel = 'PRETO'
??cor+preto
case colorgel = 'VERMELHO'
??cor+vermelho
case colorgel = 'VERDE'
??cor+verde
case colorgel = 'CYAN'
??cor+cyan
case colorgel = 'AZUL'
??cor+azul
case colorgel = 'MAGENTA'
??cor+magenta
case colorgel = 'AMARELO'
??cor+amarelo
endc
endc
set prin off
elseif onde = "W"
//printers->timp = 'WINDOWS'
do case
case jkj = 14
PSSetRowCol(, 40) // 62 lines and 40 columns
PSSetFont(APS_COURIER, APS_PLAIN, 24, APS_BLACK, APS_NONE)
//PSSetFont(APS_DRAFT10, APS_PLAIN, 6, APS_BLACK, APS_NONE)
case jkj = 15 && Condensado
PSSetRowCol(, 135) // 62 lines and 135 columns
PSSetFont(APS_COURIER, APS_PLAIN, 07, APS_BLACK, APS_NONE)
//PSSetFont(APS_DRAFT17, APS_PLAIN, 10, APS_BLACK, APS_NONE)
case jkj = 18 && Descondensa
PSSetRowCol(, 80) // 62 lines and 80 columns
PSSetFont(APS_COURIER, APS_PLAIN, 12, APS_BLACK, APS_NONE)
//PSSetFont(APS_DRAFT10, APS_PLAIN, 10, APS_BLACK, APS_NONE)
case jkj = 20 && Expandido
PSSetRowCol(, 80) // 62 lines and 80 columns
PSSetFont(APS_COURIER, APS_PLAIN, 12, APS_BLACK, APS_NONE)
//PSSetFont(APS_DRAFT10, APS_PLAIN, 10, APS_BLACK, APS_NONE)
case jkj = 48
do case
case imple='6'
PSSetRowCol(62) // 62 lines
case imple='8'
PSSetRowCol(83) // 83 lines
case imple='M'
PSSetRowCol(225) // 225 lines
end
case jkj = 67
PSSetRowCol(imple) // imple lines
case jkj = 69
PSSetFont( , APS_BOLD)
case jkj = 70
PSSetFont( , APS_PLAIN)
case jkj = 77 && 12 cpi
PSSetRowCol(, 92) // 62 lines and 92 columns
PSSetFont(APS_COURIER, APS_PLAIN, 10, APS_BLACK, APS_NONE)
//PSSetFont(APS_DRAFT12, APS_PLAIN, 10, APS_BLACK, APS_NONE)
case jkj = 80 && 10 cpi
PSSetRowCol(, 80) // 62 lines and 80 columns
PSSetFont(APS_COURIER, APS_PLAIN, 12, APS_BLACK, APS_NONE)
//PSSetFont(APS_DRAFT10, APS_PLAIN, 10, APS_BLACK, APS_NONE)
case jkj = 81 && 12 cpi + expandido
PSSetRowCol(, 155) // 62 lines and 155 columns
PSSetFont(APS_COURIER, APS_PLAIN, 06, APS_BLACK, APS_NONE)
//PSSetFont(APS_DRAFT20, APS_PLAIN, 10, APS_BLACK, APS_NONE)
case jkj = 99
PSSetRowCol(, 80) // 62 lines and 80 columns
PSSetFont(APS_COURIER, APS_PLAIN, 12, APS_BLACK, APS_NONE)
//PSSetFont(APS_DRAFT10, APS_PLAIN, 10, APS_BLACK, APS_NONE)
case jkj = 114
//colorgel := ycor
endc
set prin off
endif
retu ritorna
func porcent()
parameters atual,total
@ 24,76 say m->atual * 100 / m->total pict '999'
@ 24,79 say '%'
retu nil
*--------------
FUNC CABPAG
*Observ e que neste função em vez de @say é @print.
central(1,trim(vem(ontem->fanta)),"N",2,137,onde)
@ 1,128 print 'FOLHA:'
@ 1,134 print transform(pag,'999')
central(2,'CONTROLE DO CONTAS A PAGAR','N',2,137,onde)
@ 4,0 print enderim
@ 4,110 print 'CGC(MF): '+cgcim
@ 5,0 print localim
@ 5,109 print 'I. ESTADUAL :'+iestim
@ 6,0 print repl('-',137)
@ 7,0 print 'C.FOR'
@ 7,06 print '|'
@ 7,16 print 'F O R N E C E D O R'
@ 7,44 print '|'
@ 7,46 print 'DOCUMENTO'
@ 7,57 print '|'
@ 7,59 print 'TIPO'
@ 7,65 print '|'
@ 7,71 print 'VALOR'
@ 7,81 print '|'
@ 7,85 print 'VALOR PAGO'
@ 7,97 print "|"
@ 7,99 print "JURO/DESCONTO"
@ 7,113 print "|"
@ 7,115 print 'VENCIMENTO'
@ 7,126 print '|'
@ 7,128 print 'LIQUIDADO'
@ 8,06 print '|'
@ 8,44 print '|'
@ 8,57 print '|'
@ 8,65 print '|'
@ 8,81 print '|'
@ 8,97 print '|'
@ 8,113 print '|'
@ 8,126 print '|'
retu 0
/*-----------------------------------------------------------------------------
Function .: Print(<n>, <n>, <c>) -> NIL
Descript. : Prints a line of text to the current device
Date .....: Jan 2000
By .......: Stephan St-Denis
Esta é a função print que substitui o @ say.
Toda vez que eu uso @ print é executada esta função.
O clipper sabe disso por causa do printsys.ch que acompanha o pacote do
pscript e que deve ser colocado no seu diretório \clipper5\include
-----------------------------------------------------------------------------*/
Function Print(nRow, nCol, cText)
/* Colorgel é uma variável pública que contém a string da cor.
ColorGel é definida como 'PRETO' logo de início.
Se eu quiser imprimir em outra cor basta definí-la como outra cor.
Changecolor é variável pública definida logo de início como .f.
Quando eu mudo a cor também dou um valor .t. à esta variável.*/
do case
case onde = "W"
if colorgel # 'PRETO'
do case
case colorgel = 'PRETO'
@ nRow, nCol textout ctext color APS_BLUE
case colorgel = 'VERMELHO'
@ nRow, nCol textout ctext color APS_RED
case colorgel = 'VERDE'
@ nRow, nCol textout ctext color APS_GREEN
case colorgel = 'CYAN'
@ nRow, nCol textout ctext color APS_CYAN
case colorgel = 'AZUL'
@ nRow, nCol textout ctext color APS_BLUE
case colorgel = 'MAGENTA'
@ nRow, nCol textout ctext color APS_MAGENTA
case colorgel = 'AMARELO'
@ nRow, nCol textout ctext color APS_YELLOW
endc
else
PSTextOut(nRow, nCol, cText )
end
case onde # "W"
if changecolor
compac(114)
changecolor := .f.
end
@nRow, nCol SAY cText
endcase
Return NIL
*-----------
FUNC CENTRAL
* CENTRAL.PRG
PARA LIN,MSG,RESP,LIN2,NUM3,mytpimp
/*
Uma pequena descrição dos parametros recebidos:
lin = a linha onde vai ser impresso
msg = o que vai ser impresso
resp = Se vai passar traço em baixo ou não
lin2 = linha onde vai ser passado o traço,
num3 = tamanho da linha para centralizar. ex.: se 80 ou 132
mytpimp = o tipo de impressora que está sendo usado
Na verdade, quando é um relatório, este parâmetros a mais é nada
mais, nada menos que a variável onde (que é pública, cuja expli-
cação está mais acima)*/
if valtype(mytpimp) = "U"
mytpimp="V"
end
if mytpimp # "W"
@ LIN,(NUM3-LEN(MSG))/2 SAY MSG
else
@ LIN,(NUM3-LEN(MSG))/2 print MSG
end
IF RESP='S'
if mytpimp # "W"
@ LIN2,(NUM3-LEN(MSG))/2 say REPL('-',LEN(MSG))
else
@ LIN2,(NUM3-LEN(MSG))/2 print REPL('-',LEN(MSG))
END
End
RETU nil
/* Tive que fazer tudo isso porque esta função serve tanto para centralizar
no vídeo como nos relatórios*/
FUNC ROTPAG
*ROTPAG.PRG
@ lin,0 print transform(fornec->codfor,'99999')
@ lin,06 print '|'
@ lin,08 print subs(fornec->nome,1,36)
@ lin,44 print '|'
@ lin,47 print docum
@ lin,57 print '|'
@ lin,59 print tipo
@ lin,65 print '|'
@ lin,67 print transform(valor, '@E 99,999,999.99')
@ lin,81 print '|'
@ lin,83 print transform(vlrpago, '@EZ 99,999,999.99')
@ lin,97 print '|'
if !empty(fjurmul)
@ lin,99 print if(fjurmul="J",'+','-')
end
@ lin,100 print transform(JURMUL,'@EZ 9,999,999.99')
@ lin,113 print '|'
@ lin,115 print vencto
@ lin,126 print '|'
set century off
@ lin,128 print datliq
set century on
retu 0
*---------------
Function Eject(qmodo)
if onde = "W"
if qmodo == 1
PSNewPage()
elseif qmodo == 2
PSEndDoc()
End
else
eject
End
Return Nil
Function FinalFila()
Set Printer To
if select('PRINTERS') = 0
usei('printers')
end
onde := ' '
Return NIl
Function Escoimp()
oqret = .f.
ondesta = select()
Select Printers
Set Filter to termusu = val(subs(estacao,5)) .and. !empty(porta)
Count to Qtasimp
Declare ifessora[Qtasimp],Codimp[Qtasimp]
Dbgotop()
Ctasimp = 1
While Ctasimp <= Qtasimp
ifessora[Ctasimp] = trim(timp)+'-'+trim(nome)+' em '+trim(porta) + ' no Terminal '+ltri(str(termfor))
Codimp[Ctasimp] = codigo
Ctasimp++
skip
End
eraimp = savescreen(5,11,13,60)
@ 5,11 clear to 13,60
@ 5,11 to 13,60
inverso(5,16,'IMPRESSORAS DISPONÍVEIS')
nossaimp = achoice(7,12,12,59,ifessora)
restscreen(5,11,13,60,eraimp)
if ltri(str(nossaimp)) > '0'
locate for codigo = Codimp[nossaimp]
else
onde = 'V'
dbgobottom()
if !eof()
skip
end
end
if !eof()
minport = porta
set printer to &minport
oqret = .t.
else
dbgotop()
oqret = .f.
endif
set filt to
dbselectarea(ondesta)
return oqret