tenho um problema em que o sistema não está assimilando o READ no procedure INC_NEW (vejam o anexo abaixo). Quando eu pressiono F2 dentro do programa SIGVEIC a rotina INC_NEW é acionada, mas o sistema esta voltando a origem que mandou executar a rotina INC_NEW.
Talvez seja um problema de variavel, keyboard, etc.
Agradeço desde já.
EAndrioli
Código: Selecionar todos
FUNCTION SIGVEIC
*------------------------
* SIGVEIC.PRG - Incluir
*------------------------
#include "visual2.ch"
#include "Inkey.ch"
VLMouseOFF() // (VISUAL LIB)
TEL_EST=SAVENV()
SET CURSOR ON
SELE 12
USE SIGASTOS SHARED ALIAS SIGAS
SET INDEX TO SIGASTOS
SET ORDER TO 1
SELE 2
USE CLIENTES SHARED ALIAS CLI
SET INDEX TO CLIENTES
SET ORDER TO 1
* Desenhando Linha de Comandos...
DrawFn(02, "Gastos") // Coluna 2/10
DrawFn(03, "Inclui") // Coluna 3/10
DrawFn(04, "Fichas") // Coluna 4/10
DrawFn(05, "Placa") // Coluna 5/10
DrawFn(06, "Codigo") // Coluna 6/10
DrawFn(07, "Data") // Coluna 7/10
WIN(2,0,21,78,"MANUTEN€ÇO DO CADASTRO DE VEÖCULOS",'GR+/N+*','N+*/W')
SET COLOR TO "N*/W,W+/W+"
@03,1 SAY "CàDIGO³AQUISI€ÇO ³ MODELO ³ ANO/MOD ³COR ³ VALOR-R$ ³V"
@04,1 SAY "ÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÅÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÅÄ"
@19,1 SAY "ÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÁÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄÁÄ"
SET COLOR TO "N*/W,W+/N"
SELE 1
USE VEICULOS SHARED ALIAS VEI
SET INDEX TO VEICULOS
SET ORDER TO 2
DECLARE array_lan[1]
array_lan[1] :='TRANS(codigo,"999999")+"³"+DTOC(data)+"³ "+modelo+"³"+ano+"³"+LEFT(cor,4)+"³"+TRANS(ABS(vlr_venda),"@E 999,999.99")+"³"+vendido'
KEYBOARD CHR(176)
letra := ""
DBGOTOP()
DBEDIT(05,1,18,77,array_lan,"coluna2",,"","")
DBGOBOTTOM()
DESKTOP()
RSTENV(TEL_EST)
RETURN(.T.)
*-----------------
FUNCTION coluna2
*-----------------
FOR pin := 5 TO 18
@ pin,07 SAY "³"
@ pin,18 SAY "³"
@ pin,50 SAY "³"
@ pin,60 SAY "³"
@ pin,65 SAY "³"
@ pin,76 SAY "³"
NEXT pin
IF LASTKEY()=27 // Caso tecle ESC, Voltar...
RETURN(0)
ENDIF
t_placa=placa
origem =compra_de
CLI->(DBSEEK(origem))
COR_ANT=SETCOLOR()
SET COLOR TO N+*/W
@20,02 SAY "ADQUIRIDO DE:"
@20,63 SAY "PLACA:"
SET COLOR TO R*/W
@20,16 SAY CLI->(nome)
@20,70 say t_placa
SETCOLOR(COR_ANT)
SELE VEI
IF LASTKEY()= -1 // VER GASTOS...
TEL=SAVENV()
VER_GAS()
SELE VEI
RSTENV(TEL)
ENDIF
IF LASTKEY()= -4 // Achar por um outro Campo...
TEL=SAVENV()
WIN(08,09,11,27,"BUSCANDO PLACA",'W/R+*','R+*/W')
SET CURSOR ON
T_PLA = " - "
@10,10 SAY "NUMERO:" GET T_PLA
READ
IF LASTKEY()=27
RSTENV(TEL)
KEYBOARD CHR(176)
RETURN(1)
ENDIF
ffseek := T_PLA
SET SOFTSEEK ON
SET ORDER TO 3
DBSEEK(ffseek)
SET SOFTSEEK OFF
KEYBOARD CHR(176)
IF LEN(T_PLA) < 9
INKEY()
ENDIF
SET CURSOR OFF
RSTENV(TEL)
ENDIF
IF LASTKEY()= -5 // Achar por CODIGO...
TEL=SAVENV()
WIN(08,09,11,25,"BUSCAR CODIGO",'W/RB+*','RB+*/W')
SET CURSOR ON
T_VEBU = 0
@10,10 SAY "CODIGO:" GET T_VEBU PICT '999999'
READ
IF LASTKEY()=27
RSTENV(TEL)
KEYBOARD CHR(176)
RETURN(1)
ENDIF
ffseek := T_VEBU
SET SOFTSEEK ON
SET ORDER TO 1
DBSEEK(ffseek)
SET SOFTSEEK OFF
KEYBOARD CHR(176)
SET CURSOR OFF
RSTENV(TEL)
ENDIF
IF LASTKEY()= -6 // ORDENAR POR DATA...
SET ORDER TO 6
DBGOBOTTOM()
ENDIF
IF (LASTKEY() >= 65 .AND. LASTKEY() <= 122) .OR. LASTKEY() == 32 .OR. (LASTKEY() >= 40 .AND. LASTKEY() <= 57)
IF LEN(letra) < 30
letra += UPPER(CHR(LASTKEY()))
ENDIF
ffseek := letra
SET SOFTSEEK ON
SET ORDER TO 2
DBSEEK(ffseek)
SET SOFTSEEK OFF
KEYBOARD CHR(176)
INKEY(0)
ELSEIF LASTKEY() = 8 // BackSpace volta apagando...
letra = ""
ENDIF
IF letra = ""
@23,20 SAY PADC("BUSCAR: "+"_",40," ") COLOR("N+*/W")
ELSE
@23,20 SAY PADC("BUSCAR: "+letra+"_",40," ") COLOR("N+*/W")
ENDIF
IF LASTKEY() = -2 .OR. LASTKEY() = 22 // [F3] ou INS -> Inclusao
DO INC_VEIC
SELE VEI
SET ORDER TO 1
DBGOTOP()
DBGOBOTTOM()
ENDIF
IF LASTKEY() = -3 // [F4] -> Ficha do Ve¡culo Impressa..
...
ENDIF
IF LASTKEY()=13 // se ‚ ENTER Consulta c/ Conteudo
....
ENDIF
PARAMETERS MODO // Parametro somente p/ o Teste de EOF() e BOF() do Arquivo
DO CASE
CASE MODO = 1 .OR. MODO = 2 // Testa Inicio e Fim do arquivo com som
RETURN(1)
ENDCASE
RETURN(1)
********************
PROCEDURE INC_VEIC // Rotina: Inclusao de Veiculos...
********************
set key K_F2 to INC_NEW
TEL=SAVENV()
WIN(02,00,24,78,"INCLUINDO UM VEICULO","GR+/R*+","R+*/W",.F.) // .F. s/sombra
SET COLOR TO "N*/W,W+/W+"
SET CURSOR ON
DO LIMPANDO
v_data = DATE()
v_modelo = space(30)
v_fabrica = space(1)
v_ano = space(9)
v_cor = space(20)
v_placa = space(8)
v_combust = space(1)
v_condicao= space(10)
v_chassi = space(20)
v_renavam = space(20)
v_propdoc = 0
v_comprado= 0
v_propriet= 0
v_valor1 = 0 // Valor de Compra
v_valor2 = 0 // Valor de Venda
v_valor3 = 0 // Valor de Custo
v_unid = space(2) // Unidade de Medida
v_clafis = space(2) // Classificacao Fiscal
v_sitrib = space(2) // Situa‡ao Tributaria
v_ncm = space(8)
v_porconsi= 0 // % se venda de consignado
v_oriven = 0 // originado da venda de outro veiculo
store SPACE(30) TO v_obs1,v_obs2,v_obs3,v_obs4,v_obs5,v_obs6,v_obs7,v_obs8,v_obs9,v_obs10
store SPACE(30) TO v_aces1,v_aces2,v_aces3,v_aces4,v_aces5,v_aces6,v_aces7,v_aces8,v_aces9,v_aces10
store SPACE(8) to v_ncm
SELE VEI
DO WHILE .T.
SET DELETED OFF
SELE VEI
SET ORDER TO 1
DBGOBOTTOM()
SET DELETED ON
TSEQ=codigo+1 // Adiciona a TSEQ o ultimo lcto fisico + 1
* Rotina que trava Cancela o Sistema - C¢pia Amostra...
IF TESTE = "S"
IF TSEQ > 50
DO TRAVA
ENDIF
ENDIF
SET COLOR TO "GR+/R+*"
@02,72 SAY STUFF(PADL(TSEQ,6,"0"),6,0,"")
SET COLOR TO "N*/W,N/W"
@03,20 get v_data
@03,42 get v_modelo
@04,20 get v_fabrica VALID LER_FAB()
@04,50 get v_ano pict "9999/9999"
@04,69 GET V_NCM
@05,20 get v_cor
@05,58 get v_placa
@06,20 get v_combust pict "9" VALID LER_COMB()
@06,52 get v_condicao VALID V_CONDI()
@06,73 get v_porconsi pict "99.99"
@07,20 get v_chassi
@07,58 get v_renavam
@08,20 get v_propdoc pict "9999" VALID prop_doc()
@09,20 get v_comprado pict "9999" VALID ler_vend()
@10,20 get v_propriet pict "9999" VALID ler_prop()
@11,20 get v_valor1 pict "999,999.99"
@11,59 get v_valor2 pict "999,999.99" valid le_porcen()
@12,20 get v_valor3 pict "999,999.99" // VALID le_valcu()
@12,51 get v_unid
@12,61 get v_clafis
@12,71 get v_sitrib
@13,06 get v_obs1
@14,06 get v_obs2
@15,06 get v_obs3
@16,06 get v_obs4
@17,06 get v_obs5
@18,06 get v_obs6
@19,06 get v_obs7
@20,06 get v_obs8
@21,06 get v_obs9
@22,06 get v_obs10
@13,43 get v_aces1
@14,43 get v_aces2
@15,43 get v_aces3
@16,43 get v_aces4
@17,43 get v_aces5
@18,43 get v_aces6
@19,43 get v_aces7
@20,43 get v_aces8
@21,43 get v_aces9
@22,43 get v_aces10
@23,33 get v_oriven PICT '999999'
READ
IF v_valor3 < v_valor1
MSGBOX1("O VALOR DE CUSTO ESTµ MENOR QUE O VALOR DE COMPRA!!!",,12)
ENDIF
IF LASTKEY()=27
RSTENV(TEL)
RETURN
ENDIF
DO WHILE .T.
TELA_1=SAVENV(12,18,18,62)
WIN(12,18,17,60,"CONFIRMA GRAVAۂO?",'W/RB+*','RB+*/W')
opcao := LinButton2(,2,15,,,"Sim",,"NÆo")
do case
case opcao=1
DO GRAVA_IT // Grava Itens de Seguran‡a do Veiculo
DO GRAVA_V // Grava os dados do veiculo
OTI := MsgBox2("INCLUIR PENDÒNCIAS?",,12,"NAO","SIM")
IF OTI=2
DO INCLUIPEN
ENDIF
v_data = DATE()
v_modelo = space(30)
v_fabrica = space(1)
v_ano = space(9)
v_cor = space(20)
v_placa = space(8)
v_combust = space(1)
v_condicao= space(10)
v_chassi = space(20)
v_renavam = space(20)
v_propdoc = 0
v_comprado= 0
v_propriet= 0
v_valor1 = 0
v_valor2 = 0
v_valor3 = 0
v_unid = space(2)
v_clafis = space(2)
v_sitrib = space(2)
v_ncm = space(8)
v_porconsi= 0
v_oriven = 0
store SPACE(30) TO v_obs1,v_obs2,v_obs3,v_obs4,v_obs5,v_obs6,v_obs7,v_obs8,v_obs9,v_obs10
store SPACE(30) TO v_aces1,v_aces2,v_aces3,v_aces4,v_aces5,v_aces6,v_aces7,v_aces8,v_aces9,v_aces10
store SPACE(8) TO v_ncm
SET COLOR TO "N*/W,W+/W+"
RSTENV(TEL)
KEYBOARD CHR(255)
DBGOTOP()
RETURN(1)
case opcao=2
RSTENV(TELA_1)
OTHERWISE
IF LASTKEY()=27
KEYBOARD CHR(255)
RSTENV(TEL)
RETURN(1)
ENDIF
ENDCASE
RSTENV(TELA_1)
EXIT
ENDDO
ENDDO
********************
PROCEDURE GRAVA_V
********************
SELE VEI
DBRLOCK()
DBAPPEND()
REPLACE codigo WITH tseq
REPLACE data WITH v_data
REPLACE modelo WITH v_modelo
REPLACE fabricante WITH v_fabrica
REPLACE ano WITH v_ano
REPLACE cor WITH v_cor
REPLACE placa WITH v_placa
REPLACE t_combust WITH v_combust
REPLACE condicao WITH v_condicao
REPLACE n_chassis WITH v_chassi
REPLACE n_document WITH v_renavam
REPLACE prop_doc WITH v_propdoc
REPLACE compra_de WITH v_comprado
REPLACE propriet WITH v_propriet
REPLACE vlr_compra WITH v_valor1
REPLACE vlr_venda WITH v_valor2
REPLACE vlr_custo WITH v_valor3
REPLACE unidade WITH v_unid
REPLACE clasfis WITH v_clafis
REPLACE sitribu WITH v_sitrib
REPLACE ncm with v_ncm
REPLACE obs1 WITH v_obs1
REPLACE obs2 WITH v_obs2
REPLACE obs3 WITH v_obs3
REPLACE obs4 WITH v_obs4
REPLACE obs5 WITH v_obs5
REPLACE obs6 WITH v_obs6
REPLACE obs7 WITH v_obs7
REPLACE obs8 WITH v_obs8
REPLACE obs9 WITH v_obs9
REPLACE obs10 WITH v_obs10
REPLACE aces1 WITH v_aces1
REPLACE aces2 WITH v_aces2
REPLACE aces3 WITH v_aces3
REPLACE aces4 WITH v_aces4
REPLACE aces5 WITH v_aces5
REPLACE aces6 WITH v_aces6
REPLACE aces7 WITH v_aces7
REPLACE aces8 WITH v_aces8
REPLACE aces9 WITH v_aces9
REPLACE aces10 WITH v_aces10
REPLACE vendido WITH "N"
REPLACE porconsi WITH v_porconsi
REPLACE oriven WITH v_oriven
DBCOMMIT()
DBUNLOCK()
*********************
PROCEDURE LIMPANDO
*********************
@03,02 SAY "AQUISIۂO.......: / / "
@03,34 SAY "MODELO:"
@04,02 SAY "FABRICANTE......:"
@04,38 SAY "ANO/MODELO:"
@04,64 say "NCM:"
@05,02 SAY "COR PREDOMINANTE:"
@05,42 SAY "PLACAS........:"
@06,02 SAY "COMBUSTÖVEL.....:"
@06,42 SAY "CONDICAO:"
@06,67 SAY "%CSG:"
@07,02 SAY "N§ CHASSI.......:"
@07,42 SAY "N§ DOCUMENTO..:"
@08,02 SAY "PORTE (NOME)....:"
@09,02 SAY "CLIENTE.........:"
@10,02 SAY "PROPRIETµRIO....:"
@11,02 SAY "VALOR DE COMPRA.:"
@12,02 SAY "VALOR DE CUSTO..:"
@12,42 SAY "UNIDADE:"
@12,56 SAY "CF.:"
@12,66 SAY "ST.:"
@11,42 SAY "VALOR DE VENDA:"
@11,72 SAY "%="
@13,04 SAY "O"; @13,41 SAY "A"
@14,04 SAY "B"; @14,41 SAY "C"
@15,04 SAY "S"; @15,41 SAY "E"
@16,04 SAY "E"; @16,41 SAY "S"
@17,04 SAY "R"; @17,41 SAY "S"
@18,04 SAY "V"; @18,41 SAY "à"
@19,04 SAY "A"; @19,41 SAY "R"
@20,04 SAY "€"; @20,41 SAY "I"
@21,04 SAY "Ç"; @21,41 SAY "O"
@22,04 SAY "O"; @22,41 SAY "S"
@23,02 SAY "ENTRADA PELA VENDA DO VEICULO:"
T0 = 0
T1 = SPACE(1)
T2 = CTOD("00/00/0000")
T3 = SPACE(10)
T4 = SPACE(30)
T5 = SPACE(40)
T6 = SPACE(9)
T7 = SPACE(20)
T8 = SPACE(8)
@03,20 GET T2
@03,42 GET T4
@04,20 GET T1
@04,50 GET T6
@04,69 GET T8
@05,20 GET T7
@05,58 GET T8
@06,20 GET T1
@06,52 GET T3
@06,73 GET T0 PICT '99.99'
@07,20 GET T7
@07,58 GET T7
@08,20 GET T0 PICT '9999'
@09,20 GET T0 PICT '9999'
@10,20 GET T0 PICT '9999'
@11,20 GET T0 PICT '999,999.99'
@12,20 GET T0 PICT '999,999.99'
@11,59 GET T0 PICT '999,999.99'
@13,06 GET T4
@14,06 GET T4
@15,06 GET T4
@16,06 GET T4
@17,06 GET T4
@18,06 GET T4
@19,06 GET T4
@20,06 GET T4
@21,06 GET T4
@22,06 GET T4
@13,43 GET T4
@14,43 GET T4
@15,43 GET T4
@16,43 GET T4
@17,43 GET T4
@18,43 GET T4
@19,43 GET T4
@20,43 GET T4
@21,43 GET T4
@22,43 GET T4
@23,33 GET T0 PICT '999999'
CLEAR GETS
*------------------------
static function LER_FAB
*------------------------
IF v_fabrica = '1'
@04,22 SAY '- VOLKSWAGEM'
ELSEIF v_fabrica = '2'
@04,22 SAY '- CHEVROLET '
ELSEIF v_fabrica = '3'
@04,22 SAY '- FIAT '
ELSEIF v_fabrica = '4'
@04,22 SAY '- FORD '
ELSEIF v_fabrica = '5'
@04,22 SAY '- MOTOS '
ELSEIF v_fabrica = '6'
@04,22 SAY '- OUTROS '
ELSEIF v_fabrica = '7'
@04,22 SAY '- RENAULT '
ELSEIF v_fabrica = '8'
@04,22 SAY '- HONDA '
ELSEIF v_fabrica = '9'
@04,22 SAY '- TOYOTA '
ELSEIF v_fabrica = 'A'
@04,22 SAY '- CITROEN '
ELSEIF v_fabrica = 'B'
@04,22 SAY '- MITSUBISHI'
ELSEIF v_fabrica = 'C'
@04,22 SAY '- CHRYSLER '
ELSEIF v_fabrica = 'D'
@04,22 SAY '- HYUNDAI '
ELSEIF v_fabrica = 'E'
@04,22 SAY '- KIA '
ELSEIF v_fabrica = 'F'
@04,22 SAY '- PEUGEOT '
ELSEIF v_fabrica = 'G'
@04,22 SAY '- NISSAN '
ELSEIF v_fabrica = 'H'
@04,22 SAY '- LAND ROVER'
ELSEIF v_fabrica = 'I'
@04,22 SAY '- JEEP '
ELSEIF v_fabrica <> '1' .or. v_fabrica <> '2' .or. ;
v_fabrica <> '3' .or. v_fabrica <> '4' .or. ;
v_fabrica <> '5' .or. v_fabrica <> '6' .or. ;
v_fabrica <> '7' .or. v_fabrica <> '8' .or. ;
v_fabrica <> '9' .or. v_fabrica <> 'A' .or. v_fabrica <> 'B' .or. ;
v_fabrica <> 'C' .or. v_fabrica <> 'D' .or. v_fabrica <> 'E' .or. ;
v_fabrica <> 'F' .or. v_fabrica <> 'G' .or. v_fabrica <> 'H' .or. ;
v_fabrica <> 'I'
@04,22 say " "
TEL_FAB=SAVENV(03,34,23,52)
WIN(03,34,22,50,"FABRICANTES",'GR+/N+*','N+*/W')
@04,36 SAY '1 - VOLKSWAGEM'
@05,36 SAY '2 - CHEVROLET '
@06,36 SAY '3 - FIAT '
@07,36 SAY '4 - FORD '
@08,36 SAY '5 - MOTOS '
@09,36 SAY '6 - OUTROS '
@10,36 SAY '7 - RENAULT '
@11,36 SAY '8 - HONDA '
@12,36 SAY '9 - TOYOTA '
@13,36 SAY 'A - CITROEN '
@14,36 SAY 'B - MITSUBISHI'
@15,36 SAY 'C - CHRYSLER '
@16,36 SAY 'D - HYUNDAI '
@17,36 SAY 'E - KIA '
@18,36 SAY 'F - PEUGEOT '
@19,36 SAY 'G - NISSAN '
@20,36 SAY 'H - LAND ROVER'
@21,36 SAY 'I - JEEP '
INKEY(0)
RSTENV(TEL_FAB)
RETURN .F.
ENDIF
RETURN .T.
*------------------------
static function LER_COMB
*------------------------
IF v_combust = '1'
@06,22 say '- ALCOOL '
ELSEIF v_combust = '2'
@06,22 say '- GASOLINA '
ELSEIF v_combust = '3'
@06,22 say '- DIESEL '
ELSEIF v_combust = '4'
@06,22 say '- A/G FLEX '
ELSEIF v_combust = '5'
@06,22 say '- OUTROS '
ELSEIF v_combust <> '1' .or. v_combust <> '2'.or. ;
v_combust <> '3' .or. v_combust <> '4' .or. v_combust <> '5'
@06,22 say " "
TEL_COMB=SAVENV(04,34,13,52)
WIN(5,34,12,49,"COMBUSTÖVEIS",'GR+/N+*','N+*/W')
@07,36 say '1 -ALCOOL '
@08,36 say '2 -GASOLINA '
@09,36 say '3 -DIESEL '
@10,36 say '4 -A/G FLEX '
@11,36 say '5 -OUTROS '
INKEY(0)
RSTENV(TEL_COMB)
RETURN .F.
ENDIF
RETURN .T.
********************
PROCEDURE prop_doc
********************
SELE CLI
SET ORDER TO 1
DBGOTOP()
IF (v_propdoc != 0)
DBSEEK(v_propdoc)
IF (FOUND())
@08,20 say CODIGO
@08,24 SAY " - "+NOME
v_propdoc=CODIGO
v_nome =NOME
return .t.
ENDIF
ENDIF
IF LASTKEY()=27 .AND. LASTKEY()=13
RETURN .F.
ENDIF
TELACLI=SAVENV()
WIN(03,02,21,78,'CONTAS CADASTRADAS','GR+/RB','RB*/W')
ar_dbf:=ALIAS()
nCol:=20
v_tel_p:=SAVESCREEN(0,0,MAXROW(),79)
nVar=0
IF !EMPTY(ar_dbf) // sava situacao atual
ultreg =RECNO() // registro e
ord_ind=INDEXORD() // indice utilizado
ENDIF
SELE CLI
SET ORDER TO 2
DBGOTOP()
KEYBOARD CHR(27)
dbedit(6,3,20,77, {"CODIGO", "NOME", "PESSOA"},,, {"Codigo", "Nome", "Pessoa"},'Ý')
@ 04, 05 SAY "Localizar:"
@ 04, 20 SAY SPAC(30) COLOR "N/W"
nCol=20
@ 04, 20 SAY "" COLOR "N/W"
cNome=SPAC(00)
DO WHILE .T.
IF LASTKEY()=13
IF !EMPTY(ar_dbf)
SELE (ar_dbf)
DBSETORDER(ord_ind)
GO ultreg
ENDIF
RESTSCREEN(0,0,MAXROW(),79,v_tel_p)
KEYBOARD STR(nVar)
v_propdoc=nVar
v_nome =NOME
KEYBOARD CHR(176)
RSTENV(TELACLI)
@08,20 SAY v_propdoc PICT "9999"
SET ORDER TO 1
DBGOTOP()
DBSEEK(v_propdoc)
v_propdoc=codigo
v_nome =NOME
@08,24 SAY " - "+NOME
RETURN (.t.)
ELSE
nKey=INKEY(0)
IF nKey=27
RSTENV(TELACLI)
RETURN(.F.)
* EXIT
ENDIF
IF nKey=13
IF !EMPTY(ar_dbf)
SELE (ar_dbf)
DBSETORDER(ord_ind)
GO ultreg
ENDIF
RESTSCREEN(0,0,MAXROW(),79,v_tel_p)
KEYBOARD STR(nVar)
v_propdoc=nVar
KEYBOARD CHR(176)
RSTENV(TELACLI)
@08,20 SAY v_propdoc PICT "9999"
SET ORDER TO 1
DBGOTOP()
DBSEEK(v_propdoc)
v_propdoc=codigo
v_nome =NOME
@08,24 SAY " - "+NOME
RETURN (.t.)
ENDIF
ENDIF
IF nKey=8 .or. nKey=19
nCol=nCol-1
IF nCol < 20
nCol=20
ENDIF
cNome=SUBS(cNome,1,LEN(cNome)-1)
@ 04, 20 SAY cNome+" " COLOR "N/W"
ELSEIF (nKey>=32 .and. nKey<=165)
nCol=nCol+1
IF nCol>=50
nCol=50
cNome=SUBS(cNome,1,LEN(cNome)-1)
ENDIF
cNome=UPPER(cNome+CHR(nKey))
@ 04,20 SAY cNome COLOR "N/W"
ENDIF
IF !PESQ_DBED2(cNome)
nCol=nCol - 1
IF nCol <20
nCol=20
ENDIF
cNome=SUBS(cNome,1,LEN(cNome)-1)
@ 04,20 SAY cNome COLOR "N/W"
ENDIF
@ 04,20 SAY cNome COLOR "N/W"
ENDDO
IF !EMPTY(ar_dbf)
SELE (ar_dbf)
DBSETORDER(ord_ind)
GO ultreg
ENDIF
RESTSCREEN(0,0,MAXROW(),79,v_tel_p)
RETURN
********************
PROCEDURE ler_vend
********************
SELE CLI
SET ORDER TO 1
DBGOTOP()
IF (v_comprado != 0)
DBSEEK(v_comprado)
IF (FOUND())
@09,20 say CODIGO
@09,24 SAY " - "+NOME
v_comprado=CODIGO
v_nome =NOME
return .t.
ENDIF
ENDIF
IF LASTKEY()=27 .AND. LASTKEY()=13
RETURN .F.
ENDIF
TELACLI=SAVENV()
WIN(03,02,21,78,'CONTAS CADASTRADAS','GR+/RB','RB*/W')
ar_dbf:=ALIAS()
nCol:=20
v_tel_p:=SAVESCREEN(0,0,MAXROW(),79)
nVar=0
IF !EMPTY(ar_dbf) // sava situacao atual
ultreg =RECNO() // registro e
ord_ind=INDEXORD() // indice utilizado
ENDIF
SELE CLI
SET ORDER TO 2
DBGOTOP()
KEYBOARD CHR(27)
dbedit(6,3,20,77, {"CODIGO", "NOME", "PESSOA"},,, {"Codigo", "Nome", "Pessoa"},'Ý')
@ 04, 05 SAY "Localizar:"
@ 04, 20 SAY SPAC(30) COLOR "N/W"
nCol=20
@ 04, 20 SAY "" COLOR "N/W"
cNome=SPAC(00)
DO WHILE .T.
IF LASTKEY()=13
IF !EMPTY(ar_dbf)
SELE (ar_dbf)
DBSETORDER(ord_ind)
GO ultreg
ENDIF
RESTSCREEN(0,0,MAXROW(),79,v_tel_p)
KEYBOARD STR(nVar)
v_comprado=nVar
v_nome =NOME
KEYBOARD CHR(176)
RSTENV(TELACLI)
@09,20 SAY v_comprado PICT "9999"
SET ORDER TO 1
DBGOTOP()
DBSEEK(v_comprado)
v_comprado=codigo
v_nome =NOME
@09,24 SAY " - "+NOME
RETURN (.t.)
ELSE
nKey=INKEY(0)
IF nKey=27
RSTENV(TELACLI)
RETURN(.F.)
* EXIT
ENDIF
IF nKey=13
IF !EMPTY(ar_dbf)
SELE (ar_dbf)
DBSETORDER(ord_ind)
GO ultreg
ENDIF
RESTSCREEN(0,0,MAXROW(),79,v_tel_p)
KEYBOARD STR(nVar)
v_comprado=nVar
KEYBOARD CHR(176)
RSTENV(TELACLI)
@09,20 SAY v_comprado PICT "9999"
SET ORDER TO 1
DBGOTOP()
DBSEEK(v_comprado)
v_comprado=codigo
v_nome =NOME
@09,24 SAY " - "+NOME
RETURN (.t.)
ENDIF
ENDIF
IF nKey=8 .or. nKey=19
nCol=nCol-1
IF nCol < 20
nCol=20
ENDIF
cNome=SUBS(cNome,1,LEN(cNome)-1)
@ 04, 20 SAY cNome+" " COLOR "N/W"
ELSEIF (nKey>=32 .and. nKey<=165)
nCol=nCol+1
IF nCol>=50
nCol=50
cNome=SUBS(cNome,1,LEN(cNome)-1)
ENDIF
cNome=UPPER(cNome+CHR(nKey))
@ 04,20 SAY cNome COLOR "N/W"
ENDIF
IF !PESQ_DBED2(cNome)
nCol=nCol - 1
IF nCol <20
nCol=20
ENDIF
cNome=SUBS(cNome,1,LEN(cNome)-1)
@ 04,20 SAY cNome COLOR "N/W"
ENDIF
@ 04,20 SAY cNome COLOR "N/W"
ENDDO
IF !EMPTY(ar_dbf)
SELE (ar_dbf)
DBSETORDER(ord_ind)
GO ultreg
ENDIF
RESTSCREEN(0,0,MAXROW(),79,v_tel_p)
RETURN
********************
PROCEDURE ler_prop
********************
SELE CLI
SET ORDER TO 1
DBGOTOP()
IF (v_propriet != 0)
DBSEEK(v_propriet)
IF (FOUND())
@10,20 say CODIGO
@10,24 SAY " - "+NOME
v_propriet=CODIGO
v_nome =NOME
return .t.
ENDIF
ENDIF
IF LASTKEY()=27 .AND. LASTKEY()=13
RETURN .F.
ENDIF
TELACLI=SAVENV()
WIN(03,02,21,78,'CONTAS CADASTRADAS','GR+/RB','RB*/W')
ar_dbf:=ALIAS()
nCol:=20
v_tel_p:=SAVESCREEN(0,0,MAXROW(),79)
nVar=0
IF !EMPTY(ar_dbf) // sava situacao atual
ultreg =RECNO() // registro e
ord_ind=INDEXORD() // indice utilizado
ENDIF
SELE CLI
SET ORDER TO 2
DBGOTOP()
KEYBOARD CHR(27)
dbedit(6,3,20,77, {"CODIGO", "NOME", "PESSOA"},,, {"Codigo", "Nome", "Pessoa"},'Ý')
@ 04, 05 SAY "Localizar:"
@ 04, 20 SAY SPAC(30) COLOR "N/W"
nCol=20
@ 04, 20 SAY "" COLOR "N/W"
cNome=SPAC(00)
DO WHILE .T.
IF LASTKEY()=13
IF !EMPTY(ar_dbf)
SELE (ar_dbf)
DBSETORDER(ord_ind)
GO ultreg
ENDIF
RESTSCREEN(0,0,MAXROW(),79,v_tel_p)
KEYBOARD STR(nVar)
v_propriet=nVar
v_nome =NOME
KEYBOARD CHR(176)
RSTENV(TELACLI)
@10,20 SAY v_propriet PICT "9999"
SET ORDER TO 1
DBGOTOP()
DBSEEK(v_propriet)
v_propriet=codigo
v_nome =NOME
@10,24 SAY " - "+NOME
RETURN (.t.)
ELSE
nKey=INKEY(0)
IF nKey=27
RSTENV(TELACLI)
RETURN(.F.)
* EXIT
ENDIF
IF nKey=13
IF !EMPTY(ar_dbf)
SELE (ar_dbf)
DBSETORDER(ord_ind)
GO ultreg
ENDIF
RESTSCREEN(0,0,MAXROW(),79,v_tel_p)
KEYBOARD STR(nVar)
v_propriet=nVar
KEYBOARD CHR(176)
RSTENV(TELACLI)
@10,20 SAY v_propriet PICT "9999"
SET ORDER TO 1
DBGOTOP()
DBSEEK(v_propriet)
v_propriet=codigo
v_nome =NOME
@10,24 SAY " - "+NOME
RETURN (.t.)
ENDIF
ENDIF
IF nKey=8 .or. nKey=19
nCol=nCol-1
IF nCol < 20
nCol=20
ENDIF
cNome=SUBS(cNome,1,LEN(cNome)-1)
@ 04, 20 SAY cNome+" " COLOR "N/W"
ELSEIF (nKey>=32 .and. nKey<=165)
nCol=nCol+1
IF nCol>=50
nCol=50
cNome=SUBS(cNome,1,LEN(cNome)-1)
ENDIF
cNome=UPPER(cNome+CHR(nKey))
@ 04,20 SAY cNome COLOR "N/W"
ENDIF
IF !PESQ_DBED2(cNome)
nCol=nCol - 1
IF nCol <20
nCol=20
ENDIF
cNome=SUBS(cNome,1,LEN(cNome)-1)
@ 04,20 SAY cNome COLOR "N/W"
ENDIF
@ 04,20 SAY cNome COLOR "N/W"
ENDDO
IF !EMPTY(ar_dbf)
SELE (ar_dbf)
DBSETORDER(ord_ind)
GO ultreg
ENDIF
RESTSCREEN(0,0,MAXROW(),79,v_tel_p)
RETURN
*-----------------------
FUNC PESQ_DBED2(cNome)
*-----------------------
IF DBSEEK(cNome,.T.)
nVar=CODIGO
IF LASTKEY() <> 5 .AND. LASTKEY() <> 24
KEYBOARD CHR(27)
ENDIF
dbedit(6,3,20,77, {"CODIGO", "NOME", "PESSOA"},"CONTROLE2",, {"Codigo", "Nome", "Pessoa"},'Ý')
ELSE
RETURN (.F.)
ENDIF
RETURN (.T.)
*-------------------
FUNC CONTROLE2(nMod)
*-------------------
IF nMod=4
IF LASTKEY()=13
nVar=CODIGO
RETURN(0)
ELSE
RETURN(0)
ENDIF
ENDIF
RETURN(1)
*------------------------
static function LEVALOR_V
*------------------------
IF LASTKEY()=5
RETURN .T.
ENDIF
IF T_VLRVEN = 0 .OR. T_VLRVEN < 0.01
MSGBOX1("VALOR DEVE SER INFORMADO...",,12)
RETURN .F.
ENDIF
RETURN .T.
*------------------------
static function LE_VALCU
*------------------------
v_valor3=v_valor1
RETURN .T.
*------------------------
Static function LE_PORCEN
*------------------------
@11,74 SAY ( v_valor2 / v_valor1 ) * 100 - 100 pict "9999"
RETURN .T.
**********************
PROCEDURE GRAVA_IT
**********************
TEL_OB=SAVENV()
* Variaveis de tela dos Itens Obrigatorios...
T_ITEM01 = 'S'
T_ITEM02 = 'S'
T_ITEM03 = 'S'
T_ITEM04 = 'S'
T_ITEM05 = 'S'
T_ITEM06 = 'S'
T_ITEM07 = 'S'
WIN(7,20,16,40,"ITENS OBRIGATàRIOS:",'W/RB+*','RB+*/W')
@09,24 SAY 'EXTINTOR.:' GET T_ITEM01 PICT "@S1!" VALID T_ITEM01 $ "SN"
@10,24 SAY 'ESTEPE...:' GET T_ITEM02 PICT "@S1!" VALID T_ITEM02 $ "SN"
@11,24 SAY 'MACACO...:' GET T_ITEM03 PICT "@S1!" VALID T_ITEM03 $ "SN"
@12,24 SAY 'CH.RODA..:' GET T_ITEM04 PICT "@S1!" VALID T_ITEM04 $ "SN"
@13,24 SAY 'TRIANGULO:' GET T_ITEM05 PICT "@S1!" VALID T_ITEM05 $ "SN"
@14,24 SAY 'CINTO....:' GET T_ITEM06 PICT "@S1!" VALID T_ITEM06 $ "SN"
@15,24 SAY 'BUZINA...:' GET T_ITEM07 PICT "@S1!" VALID T_ITEM07 $ "SN"
READ
SELE 13
USE SIGITENS SHARED ALIAS ITE
SET ORDER TO 1
DBGOTOP()
DBRLOCK()
DBAPPEND()
REPLACE VEICULO WITH TSEQ
REPLACE ITEM01 WITH T_ITEM01
REPLACE ITEM02 WITH T_ITEM02
REPLACE ITEM03 WITH T_ITEM03
REPLACE ITEM04 WITH T_ITEM04
REPLACE ITEM05 WITH T_ITEM05
REPLACE ITEM06 WITH T_ITEM06
REPLACE ITEM07 WITH T_ITEM07
DBCOMMIT()
DBUNLOCK()
RSTENV(TEL_OB)
********************
PROCEDURE TRAVA // Prazo de Teste expirado, Saindo totalmente...
********************
WIN(07,07,18,70,"*** PRAZO DE VALIDADE EXPIROU ***",'GR+/R','R*/W')
SET COLOR TO "N*/W,W+/W+"
@09,16 say " Providencie a atualiza‡Æo para obter a c¢pia "
@10,16 say " original e atualizada deste sistema, "
@11,16 say " ENTRE EM CONTATO COM: "
SET COLOR TO "GR*+/B"
@13,16 say " Programador: Erasmo Andrioli "
@14,16 say " Fone 3544-6937 Celular 9215-7741 Sorriso/MT "
@15,16 say " E-Mail: eandrioli@hotmail.com "
SET COLOR TO "R+*/W"
@17,34 say "Obrigado!!!"
@17,45 SAY ""
SET COLOR TO
* Coloca numero de serie para nao acessar mais nada...
*--------------
USE SIGSENHA
*--------------
DBRLOCK()
REPLACE PASS WITH 123321
DBUNLOCK()
CLOSE ALL
INKEY(20)
CLS
QUIT
********************
PROCEDURE INCLUIPEN
********************
WIN(12,04,19,76,"INCLUSÇO DE PENDÒNCIAS")
SET COLOR TO "N*/W,N/W+"
SET CURSOR ON
SELE 11
USE SIGPEND SHARED ALIAS SIPEN
SET INDEX TO SIGPEND
SET ORDER TO 1
DBGOTOP()
@14,5 SAY "DATA.....:"
@16,5 SAY "HISTàRICO:"
LIXO2 = DATE()
LIXO3 = SPACE(60)
TDTPEN = date()
THPPEN = space(60)
THPPEN2 = space(60)
THPPEN3 = space(60)
@14,16 GET LIXO2
@16,16 GET LIXO3
@17,16 GET LIXO3
@18,16 GET LIXO3
CLEAR GETS
DO WHILE .T.
@14,16 GET TDTPEN
@16,16 GET THPPEN
@17,16 GET THPPEN2
@18,16 GET THPPEN3
READ
SELE SIPEN
IF LASTKEY()=27
SELE VEI
SET ORDER TO 2
RSTENV(TEL)
RETURN(1)
ENDIF
DBAPPEND()
DBRLOCK()
REPLACE VEIC_PEN WITH TSEQ
REPLACE VENOM_PEN WITH V_MODELO
REPLACE VEPLA_PEN WITH V_PLACA
REPLACE DT_PEN WITH TDTPEN
REPLACE HIST_PEN WITH THPPEN
REPLACE HIST_PEN2 WITH THPPEN2
REPLACE HIST_PEN3 WITH THPPEN3
DBUNLOCK()
SELE VEI
SET ORDER TO 2
RSTENV(TEL)
RETURN(1)
ENDDO
*------------------------
static function V_CONDI
*------------------------
IF v_condicao <> "LOJA" .and. v_condicao <> "CONSIGNADO" .and. v_condicao <> "TERCEIROS" .and. v_condicao <> "OUTROS"
MSGBOX1("CONDIۂO = LOJA, CONSIGNADO, TERCEIROS ou OUTROS")
RETURN .F.
ENDIF
RETURN .T.
*--------------------------------
PROCEDURE INC_NEW
*--------------------------------
SELE 2
USE CLIENTES SHARED ALIAS CLI
SET INDEX TO CLIENTES
SET ORDER TO 2
* Inicializando variaveis...
var0 =0 // Codigo
var1 =SPACE(1) // Pessoa
var2 =space(40) // Nome
var3 =space(40) // Endereco
var4 =space(20) // Bairro
var5 =space(30) // Cidade
var6 =space(2) // UF
var7 =space(8) // C.E.P.
var8 =space(14) // CNPJ/CPF
var9 =space(14) // Insc.Est
var10=SPACE(15) // RG
var11=SPACE(15) // Telefone
var12=SPACE(15) // Celular
var13=space(20) // Ref.Bancaria
var14=date() // Data Abertura
var15=space(1) // Tipo
var16=SPACE(15) // Fax
var17=space(20) // Naturalidade
var18=date() // Data Nascimento
var19=space(30) // Pai
var20=space(30) // Mae
var21=space(20) // Ref. Comercial
var22=space(20) // Ref. Pessoal
var23=SPACE(15) // Telefone Ref. Banco
var24=SPACE(15) // Telefone Ref. Comercial
var25=SPACE(15) // Telefone Ref. Pessoal
var26=space(15) // Carteira Motorista
var27=space(10) // numero endereco clifor
var28=space(7) // codigo cidade clifor
var29=space(2) // codigo uf clifor
TEL=SAVENV()
WIN(03,03,22,77,'INCLUSÇO DE CONTAS')
SET COLOR TO "N*/W,N/W+"
SET CURSOR ON
SELE CLI
DO WHILE .T.
IF LASTKEY()=27
RSTENV(TEL)
RETURN
ENDIF
DBSEEK(var0)
SET COLOR TO "R*/W,N/W+"
@05,05 CLEAR TO 18,74
TEL_FIS=SAVENV(11,33,15,70) // Salva area que a PJ vai ocupar...
@05,05 say "Pessoa.......:"
@06,05 say "Tipo.........:"
@07,05 say "Nome.........:"
@08,05 say "Endereco.....: Nr"
@09,05 say "Bairro.......: COD.CID/IBGE: COD.UF:"
@10,05 say "Cidade.......:"
@10,60 say "UF:"
@11,05 say "C.E.P........: NATURALIDADE:"
@12,05 say "CNPJ/CPF.....: NASCIMENTO..:"
@13,05 say "Insc.Est.....: CNH.........:"
@14,05 say "RG (PF)......: PAI:"
@15,05 say "Telefone.....: MAE:"
@16,05 say "Fax..........:"
@17,05 say "Celular......:"
@18,05 say "Ref.Bancaria.: Fone:"
@19,05 say "Ref.Comercial: Fone:"
@20,05 say "Ref.Pessoal..: Fone:"
@21,05 say "Data Abertura:"
SET COLOR TO "BG*/W,N/W+"
@05,20 GET var1 VALID var1$("FJ"); @5,25 SAY "F=Fisica J=Juridica"
VLREAD
IF var1 = "F" .or. var1 = "f"
@06,20 GET var15 VALID var15$("CFSO"); @6,25 SAY "C=Cliente F=Fornecedor S=S¢cio O=Outros"
@07,20 GET var2
@08,20 GET var3
@08,64 get var27
@09,20 GET var4
@09,55 get var28 PICT '@R 9999999'
@09,71 get var29 VALID(var29$"111213141516172122232425262728293132333541424350515253")
@10,20 GET var5
@10,64 GET var6 VALID var6$("RO AC AM RR PA AP TO MA PI CE RN PB PE AL SE BA MG ES RJ SP PR SC RS MS MT GO DF")
@11,20 GET var7 PICT "@R 99.999-999"
@12,20 GET var8 PICT "@R 999.999.999-99" valid VerCicCgc(var8,1) // CPF
@11,55 get var17
@12,55 get var18
@13,20 get var9
@13,55 GET VAR26
@14,20 get var10
@14,46 get var19
@15,20 get var11 PICT "@R (99) 9999-9999"
@15,46 get var20
@16,20 get var16
@17,20 get var12
@18,20 get var13
@18,48 get var23
@19,20 get var21
@19,48 get var24
@20,20 get var22
@20,48 get var25
@21,20 get var14
READ
ELSEIF var1 = "J" .or. var1 = "j"
RSTENV(TEL_FIS)
@06,20 GET var15 VALID var15$("CFSO"); @6,25 SAY "C=Cliente F=Fornecedor S=S¢cio O=Outros"
@07,20 GET var2
@08,20 GET var3
@08,64 get var27
@09,20 GET var4
@09,55 get var28 PICT '@R 9999999'
@09,71 get var29 VALID(var29$"111213141516172122232425262728293132333541424350515253")
@10,20 GET var5
@10,64 GET var6 VALID var6$("RO AC AM RR PA AP TO MA PI CE RN PB PE AL SE BA MG ES RJ SP PR SC RS MS MT GO DF")
@11,20 GET var7 PICT "@R 99.999-999"
@12,20 GET var8 PICT "@R 99.999.999/9999-99" valid VerCicCgc(var8,2) // CGC
@13,20 GET var9
@13,55 GET VAR26
@14,20 GET var10
@15,20 GET var11 PICT "@R (99) 9999-9999"
@16,20 GET var16
@17,20 GET var12
@18,20 GET var13
@18,48 get var23
@19,20 get var21
@19,48 get var24
@20,20 get var22
@20,48 get var25
@21,20 get var14
READ
ENDIF
IF LASTKEY()=27
LOOP
ENDIF
SET DELETED OFF
SET ORDER TO 1
DBGOBOTTOM()
SET DELETED ON
var0=CODIGO+1
DBAPPEND()
DBRLOCK()
REPLACE CODIGO WITH var0
REPLACE PESSOA WITH var1
REPLACE NOME WITH var2
REPLACE ENDERECO WITH var3
REPLACE ENDNUM WITH var27
REPLACE BAIRRO WITH var4
REPLACE NCIDCLI WITH var28
REPLACE NUFCLI WITH var29
REPLACE CIDADE WITH var5
REPLACE UF WITH var6
REPLACE CEP WITH var7
REPLACE CPF_CGC WITH var8
REPLACE INSCRICAO WITH var9
REPLACE RG WITH var10
REPLACE FONE WITH var11
REPLACE CELULAR WITH var12
REPLACE REFBANCO WITH var13
REPLACE DATAABRE WITH var14
REPLACE TIPO WITH var15
REPLACE FAX WITH var16
REPLACE LOCALNAS WITH var17
REPLACE DTNASCE WITH var18
REPLACE PAI WITH var19
REPLACE MAE WITH var20
REPLACE REFCOM WITH var21
REPLACE REFPES WITH var22
REPLACE FONEBAN WITH var23
REPLACE FONECOM WITH var24
REPLACE FONEPES WITH var25
REPLACE CNH WITH var26
DBCOMMIT()
DBUNLOCK()
* Limpando as variaveis apos alteracao...
var1 =space(1) // Pessoa
var2 =space(40) // Nome
var3 =space(40) // Endereco
var4 =space(20) // Bairro
var5 =space(30) // Cidade
var6 =space(2) // UF
var7 =space(8) // C.E.P.
var8 =space(14) // CNPJ/CPF
var9 =space(14) // Insc.Est
var10=SPACE(15) // RG
var11=SPACE(15) // Telefone
var12=SPACE(15) // Celular
var13=space(20) // Ref.Bancaria
var14=date() // Data Abertura
var15=space(1) // Tipo
var16=SPACE(15) // Fax
var17=space(20) // Naturalidade
var18=date() // Data Nascimento
var19=space(30) // Pai
var20=space(30) // Mae
var21=space(20) // Ref. Comercial
var22=space(20) // Ref. Pessoal
var23=SPACE(15) // Telefone Ref. Banco
var24=SPACE(15) // Telefone Ref. Comercial
var25=SPACE(15) // Telefone Ref. Pessoal
var26=space(15) // carteira motorista
var27=space(10) // num end cli
var28=space(7) // codigo cid cli
var29=space(2) // codigo uf cli
DBGOBOTTOM()
KEYBOARD CHR(32)
RETURN(1)
ENDDO
