Em homenagem a Paulo Cesar Toledo
https://pctoledo.org/
Código: Selecionar todos
procedure cliente
public wcodpro, wpesmer, wnommer, wmarmer, wqtdest, registro, wobspro
public wvlrcus, wperdes, wvlrven, westmin, wlocpro, wunimer, wcodgrp, wrefpro
do abrearqs
do while .t.
tela (7, 10, 22, 70)
@ 7, 12 say 'Cadastro de Produtos'
@ 7, 42 prompt 'Inclusao'
@ 7, col () + 1 prompt 'Alteracao'
@ 7, col () + 1 prompt 'Exclusao'
menu to op
save screen to telacad
do case
case op = 0
close databases
release all like *
return
case op = 1
do inclui3
case op = 2
do altera3
case op = 3
do exclui3
endcase
restore screen from telacad
enddo
procedure inclui3
do zeracampos
do while .t.
@ 9, 29 say ' -0'
registro = 0
do getcampos1
read
if lastkey () = 27
return
endif
if confirma () = .f.
loop
endif
select controle
wcodpro = codpro + 9
select produtos
set order to 1
do while .t.
find (wcodpro)
if found ()
wcodpro = wcodpro + 9
else
exit
endif
enddo
select controle
if reglock ()
replace codpro with wcodpro
unlock
endif
select produtos
if adireg ()
do grava1
endif
@ 9, 29 say wcodpro picture '99999-9'
do TEC061a with wcodpro
mensagem ('Produto cadastrado...')
wvlrcus = 0.00
loop
enddo
return
procedure altera3
if confsenha () = .t.
return
endif
do while .t.
do zeracampos
@ 9, 12 say 'Codigo Produto:' get wcodpro picture '99999-9'
read
if lastkey () = 27
return
endif
select produtos
set order to 1
find (wcodpro)
if found ()
registro = recno ()
do pegacampos
do getcampos1
read
if lastkey () = 27
loop
endif
if confirma ('Confirma a Alteracao deste Produto ?')
select produtos
find (wcodpro)
do grava1
do TEC061a with wcodpro
mensagem ('Produto Alterado..')
endif
else
mensagem ('Produto Nao Cadastrado..')
endif
enddo
procedure exclui3
do while .t.
do zeracampos
@ 9, 12 say 'Codigo Produto:' get wcodpro picture '99999-9'
read
if lastkey () = 27
return
endif
select produtos
set order to 1
find (wcodpro)
if found ()
registro = recno ()
do pegacampos
do getcampos1
clear gets
opcao = 2
if confirma ('Tem Certeza que deseja excluir este cadastro ?')
save screen to telaex
select movimentos
goto top
do while ! eof ()
if wcodpro = codven
mensagem ('Existe Movimento de Vendas deste produto, Impossivel Excluir...')
keyboard chr (27)
read
exit
endif
skip 1
enddo
restore screen from telaex
if lastkey () = 27
loop
endif
select produtos
set order to 1
find (wcodpro)
if found ()
unlock
if reglock ()
delete
unlock
endif
else
mensagem ('Erro na Localizacao do Produto...')
endif
endif
else
mensagem ('Produto Nao Cadastrado..')
endif
enddo
procedure zeracampos
wcodpro = 0
wpesmer = 0.000
wnommer = space (40)
wmarmer = space (20)
wqtdest = 0.00
wunimer = 'PC'
wvlrcus = 0.00
wperdes = 0.00
wvlrven = 0.00
westmin = 0.00
wlocpro = space (10)
wcodgrp = 0
wrefpro = space (15)
wobspro = space (76)
return
procedure getcampos1
@ 9, 12 say 'Codigo Produto:'
@ 10, 12 say 'Desc.Produto..:' get wnommer picture '@!k' valid valmer()
@ 11, 12 say 'Marca.........:' get wmarmer picture '@!k'
@ 12, 12 say 'Referencia....:' get wrefpro picture '@!k'
@ 13, 12 say 'Qtde Estoque..:' get wqtdest picture '999999.99'
@ 14, 12 say 'Unidade.......:' get wunimer picture '!!'
@ 15, 12 say 'Peso Liquido..:' get wpesmer picture '9999.999'
@ 16, 12 say 'Valor Custo...:' get wvlrcus picture '999999.99'
@ 17, 12 say 'Perc. Lucro...:' get wperdes picture '999.99' valid vvenda()
@ 18, 12 say 'Valor Venda...:' get wvlrven picture '999,999.99' valid perluc()
@ 19, 12 say 'Localizacao...:' get wlocpro picture '@!k'
@ 19, 45 say 'Grupo.:' get wcodgrp picture '999'
@ 20, 12 say 'Estoque Minimo:' get westmin picture '9999.99'
@ 21, 12 say 'Observ‡äes....:' get wobspro picture '@s40'
return
procedure grava1
wperdes = val (str (wperdes, 5, 2))
if reglock ()
replace qtdest with wqtdest, unimer with wunimer, codpro with wcodpro
replace vlrcus with wvlrcus, perdes with wperdes, vlrven with wvlrven
replace locpro with wlocpro, estmin with westmin, pesmer with wpesmer
replace nommer with wnommer, marmer with wmarmer, codgrp with wcodgrp
replace refpro with wrefpro, obspro with wobspro
unlock
endif
return
procedure pegacampos
wpesmer = pesmer
wcodpro = codpro
wnommer = nommer
wmarmer = marmer
wqtdest = qtdest
wunimer = unimer
wvlrcus = vlrcus
wperdes = perdes
wvlrven = vlrven
westmin = estmin
wlocpro = locpro
wcodgrp = codgrp
wrefpro = refpro
wobspro = obspro
return
* essa procedure nao pertence a esse arquivo.. so coloquei aki pra vc ver na forma que é aberto os arquivos
* desse programa
procedure abrearqs
aguarde2 ('Abrindo Arquivos...')
set exclusive off
select (1)
if netuse ('cadfun', .f., 10, 'funcionario')
set index to cadfunc, cadfunn
else
mensagem ('Cadastro de Funcionarios Nao Esta Disponivel !')
endif
select (2)
if netuse ('connum', .f., 10, 'controle')
else
mensagem ('Controle de Numeros Nao Esta Disponivel !')
endif
select (3)
if netuse ('cadcli', .f., 10, 'cliente')
set index to cadclic, cadclin
else
mensagem ('Cadastro de Clientes Nao Esta Disponivel !')
endif
select (4)
if netuse ('cadpro', .f., 10, 'produtos')
set index to cadproc, cadpron, cadprom, cadprof
else
mensagem ('Cadastro de Produtos Nao Esta Disponivel !')
endif
select (5)
if netuse ('cadser', .f., 10, 'servicos')
set index to cadserc, cadsern
else
mensagem ('Cadastro de Servicos Nao Esta Disponivel !')
endif
select (6)
if netuse ('cadord', .f., 10, 'ordem')
set index to cadordn, cadordc, cadordp
else
mensagem ('Cadastro de Ordens Nao Esta Disponivel !')
endif
select (7)
if netuse ('movser', .f., 10, 'movimentos')
set index to movsern, movserc, movserf, movserp, movserd
else
mensagem ('Cadastro de Movimentos Nao Esta Disponivel !')
endif
select (8)
if netuse ('cadfor', .f., 10, 'fornece')
set index to cadforc, cadforn
else
mensagem ('Cadastro de Fornecedores Nao Esta Disponivel !')
endif
select (9)
if netuse ('duprcb', .f., 10, 'areceber')
set index to duprcbnn, duprcbc, duprcbe, duprcbv
else
mensagem ('Cadastro de Contas a Receber Nao Esta Disponivel !')
endif
select (10)
if netuse ('duprbd', .f., 10, 'recebido')
set index to duprbdnn, duprbdc, duprbde, duprbdv, duprbdp
else
mensagem ('Cadastro de Contas Recebidas Nao Esta Disponivel !')
endif
select (11)
if netuse ('cadbco', .f., 10, 'banco')
set index to cadbcoc, cadbcon
else
mensagem ('Cadastro de Bancos Nao Esta Disponivel !')
endif
select (12)
if netuse ('cadcpa', .f., 10, 'compra')
set index to cadcpacn, cadcpaf
else
mensagem ('Cadastro de Compras Nao Esta Disponivel !')
endif
select (13)
if netuse ('itecpa', .f., 10, 'itecpa')
set index to itecpacn, itecpaf
else
mensagem ('Cadastro de Itens de Compras Nao Esta Disponivel !')
endif
select (14)
if netuse ('cadtel', .f., 10, 'telefones')
set index to cadtelc, cadteln
else
mensagem ('Cadastro de Telefones Nao Esta Disponivel !')
endif
select (15)
if netuse ('caddol', .f., 10, 'dolar')
set index to caddold
else
mensagem ('Cadastro de Dolar Nao Esta Disponivel !')
endif
select (16)
if netuse ('itegar', .f., 10, 'igarantia')
set index to itegart, itegarn
else
mensagem ('Cadastro de itens da Garantia Nao Esta Disponivel !')
endif
restore screen from mensagem2
select (17)
if netuse ('cadgar', .f., 10, 'garantia')
set index to cadgarn
else
mensagem ('Cadastro de Temporario Garantia Nao Esta Disponivel !')
endif
select (18)
if netuse ('cadmaq', .f., 10, 'maquinas')
set index to cadmaqc, cadmaqn
else
mensagem ('Cadastro de Maquinas Nao Esta Disponivel !')
endif
select (19)
if netuse ('itemaq', .f., 10, 'itemaq')
set index to itemaqc
else
mensagem ('Cadastro de Maquinas Nao Esta Disponivel !')
endif
restore screen from mensagem2
limpa24 ()
return
Código: Selecionar todos
SAVE SCREEN TO SECUNDARIA
RESTORE SCREEN FROM ARQUIVA
PRINCI1=DIR+"ARQCONF.DBF"
IF .NOT. ABRE_ARQ(PRINCI1,PRINCI1,"5",".F.")
CLOSE ALL
RETURN
ENDIF
PUBLIC LINHA_CUPOM,MENS1,MENS2,MENS3,SPC,TIPOREL,ZERACO,MENSP1,MENSP2,MENSP3,MENSP4,MENSP5,MENSP6,MENSP7,MENSP8
LINHA_CUPOM=LINCUP
IF TIPO_CLIE=60
MENSP1=MENSSAP1
MENSP2=MENSSAP2
MENSP3=MENSSAP3
MENSP4=MENSSAP4
MENSP5=MENSSAP5
MENSP6=MENSSAP6
MENSP7=MENSSAP7
MENSP8=MENSSAP8
ELSE
MENS1=MENSS1
MENS2=MENSS2
MENS3=MENSS3
ENDIF
SPC=MARGIN
TXJURO=TRANS(JURO_DIA,"99.9999 %")
TIPOREL=RELTIPO
ZERACO=ZERACODIGO
PRINCI1=DIR+"CADCLIE.DBF"
INDICE1=DIR+"CADCLIE.NTX"
INDICE2=DIR+"NOMCLIE.NTX"
IF .NOT. ABRE_ARQ(PRINCI1,PRINCI1,"1",".F.")
CLOSE ALL
RETURN
ENDIF
SET INDEX TO &INDICE1,&INDICE2
SET ORDER TO 1
PRINCI1=DIR+"CADCONV.DBF"
INDICE1=DIR+"CADCONV.NTX"
INDICE2=DIR+"NOMCONV.NTX"
IF .NOT. ABRE_ARQ(PRINCI1,PRINCI1,"2",".F.")
CLOSE ALL
RETURN
ENDIF
SET INDEX TO &INDICE1,&INDICE2
SET ORDER TO 1
PRINCI1=DIR+"TABVEND.DBF"
INDICE1=DIR+"TABVEND.NTX"
INDICE2=DIR+"NOMVEND.NTX"
IF .NOT. ABRE_ARQ(PRINCI1,PRINCI1,"3",".F.")
CLOSE ALL
RETURN
ENDIF
SET INDEX TO &INDICE1,&INDICE2
SET ORDER TO 1
PRINCI1=DIR+"RECIBO.DBF"
INDICE1=DIR+"RECIBO.NTX"
INDICE2=DIR+"RECDAT.NTX"
INDICE3=DIR+"RECLIE.NTX"
INDICE4=DIR+"RECEXT.NTX"
INDICE5=DIR+"RECVEN.NTX"
INDICE6=DIR+"RECCOR.NTX"
INDICE7=DIR+"REPAGO.NTX"
INDICE8=DIR+"RECMES.NTX"
INDICE9=DIR+"RECEBER.NTX"
IF .NOT. ABRE_ARQ(PRINCI1,PRINCI1,"7",".F.")
CLOSE ALL
RETURN
ENDIF
SET INDEX TO &INDICE1,&INDICE2,&INDICE3,&INDICE4,&INDICE5,&INDICE6,&INDICE7,&INDICE8,&INDICE9
SET ORDER TO 1
PRINCI1=DIR+"FICHA.DBF"
INDICE1=DIR+"FICHA.NTX"
INDICE2=DIR+"FICDT.NTX"
INDICE3=DIR+"FICVE.NTX"
INDICE4=DIR+"FISER.NTX"
IF .NOT. ABRE_ARQ(PRINCI1,PRINCI1,"8",".F.")
CLOSE ALL
RETURN
ENDIF
SET INDEX TO &INDICE1,&INDICE2,&INDICE3,&INDICE4
SET ORDER TO 1
PRINCI1=DIR+"QUITA.DBF"
INDICE1=DIR+"QUITA.NTX"
INDICE2=DIR+"QUIDT.NTX"
INDICE3=DIR+"QUIFD.NTX"
IF .NOT. ABRE_ARQ(PRINCI1,PRINCI1,"6",".F.")
CLOSE ALL
RETURN
ENDIF
SET INDEX TO &INDICE1,&INDICE2,&INDICE3
SET ORDER TO 1
PRINCI1=CADMERC
INDICE1=CODMERC
INDICE2=NOMMERC
INDICE3=GRUMERC
IF .NOT. ABRE_ARQ(PRINCI1,4,.F.)
RETURN
ENDIF
SET INDEX TO &INDICE1,&INDICE2,&INDICE3
SET ORDER TO 1
PRINCI1=DIR+"SERFUN.DBF"
INDICE1=DIR+"SERFUN.NTX"
INDICE2=DIR+"SERDAT.NTX"
INDICE3=DIR+"SERCOM.NTX"
IF .NOT. ABRE_ARQ(PRINCI1,PRINCI1,"9",".F.")
CLOSE ALL
RETURN
ENDIF
SET INDEX TO &INDICE1,&INDICE2,&INDICE3
SET ORDER TO 1
SAIU=0
PUBLIC TOQUINAFICHA:=.F.
DO WHILE .T.
SET COLOR TO &FAIX_TRAB
@ 01,00 SAY " CADASTRO & FICHA DE CLIENTES "
SET COLOR TO &TELA_TRAB
@ 02,00 SAY "ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿"
@ 03,00 SAY "³ Codigo........: Proximo: ³"
@ 04,00 SAY "³ Data/cadastro.: ³"
@ 05,00 SAY "³ Nome/cliente..: ³"
@ 06,00 SAY "³ Data/nasc.....: ³"
@ 07,00 SAY "³ Endereco......: ³"
@ 08,00 SAY "³ Bairro........: ³"
@ 09,00 SAY "³ Cidade........: Estado: Cep: ³"
@ 10,00 SAY "³ Telefones.....: ³"
@ 11,00 SAY "³ Telefax.......: ³"
@ 12,00 SAY "³ RG............: Data/exp: DP: ³"
@ 13,00 SAY "³ CPF/CGC.......: ³"
@ 14,00 SAY "³ Estado civil..: Conjuge: ³"
@ 15,00 SAY "³ Naturalidade..: ³"
@ 16,00 SAY "³ Pai...........: ³"
@ 17,00 SAY "³ Mae...........: ³"
@ 18,00 SAY "³ Local/trabalho: ³"
@ 19,00 SAY "³ Observacao....: ³"
@ 20,00 SAY "ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ"
SET COLOR TO &FAIX_TRAB
@ 21,00 SAY "ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿"
@ 22,00 SAY "³ ³"
@ 23,00 SAY "ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ"
SET COLOR TO &TELA_TRAB
A01=SPACE(4)
SELE 1
SET ORDER TO 1
GO BOTT
IF CODCLIE="9999"
SKIP -1
ENDIF
ULTIREG=VAL(CODCLIE)+1
GO TOP
@ 03,33 SAY RIGHT(STRZERO(ULTIREG),4)
PUBLIC A01,A02,A03,A04,A05,A06,A07,A08,A09,A10,A11,A12,A13,A14,A15,A16,A17,A18,A19,A20,A21,A22,NOVO
PUBLIC A26,A27,A28,A29,A30,A31,A32,A33,A34,A35,A36,A37,A38,A39,A40,A41,A42,A43,A44,A45,A46,A47,A48,Q01
SET KEY -1 TO CLIFIC()
SET CURSOR ON
SET CONFIRM ON
@ 03,18 GET A01
READ
A01=RIGHT(STRZERO(VAL(A01)),4)
IF SAIU=1
SAIU=0
ELSE
IF LASTKEY()=27
SET KEY -1 TO
SET CONFIRM OFF
RESTORE SCREEN FROM SECUNDARIA
RETURN
ENDIF
ENDIF
IF A01=" " .OR. A01="0000"
A01=SPACE(4)
LOOP
ENDIF
SET COLOR TO &CAMPO_DIGIT
@ 03,18 SAY A01
SET COLOR TO &TELA_TRAB
SELE 1
SET ORDER TO 1
SEEK A01
DO CASE
CASE EOF() .OR. DELETED()
NOVO=.T.
A02=DATA_HOJE
A03=SPACE(40)
A04=CTOD(" / / ")
A05=SPACE(40)
A06=SPACE(20)
A07=SPACE(22)
A08=SPACE(02)
A09=SPACE(09)
A10=SPACE(30)
A11=SPACE(15)
A12=SPACE(15)
A13=CTOD(" / / ")
A14=SPACE(08)
A15=SPACE(20)
A16=SPACE(15)
A17=SPACE(35)
A18=SPACE(25)
A19=SPACE(35)
A20=SPACE(35)
A21=SPACE(35)
A22=SPACE(50)
A26=SPACE(40)
A27=SPACE(15)
A28=SPACE(40)
A29=SPACE(15)
A30=SPACE(40)
A31=SPACE(15)
A36=SPACE(40)
A37=SPACE(15)
A38=SPACE(15)
A39=CTOD(" / / ")
A40=SPACE(08)
A41=SPACE(15)
A42=SPACE(40)
A43=SPACE(15)
A44=SPACE(15)
A45=CTOD(" / / ")
A46=SPACE(08)
A47=SPACE(15)
A48=.F.
Q01="I"
DO WHILE .T.
SELE 1
VARIGET=GET_CLI()
IF VARIGET = 1
IF EOF()
IF ADI_REG("1")
GRAVA_CLI()
SELE 1
EXIT
ELSE
SELE 1
EXIT
ENDIF
ELSEIF DELETED()
IF BLO_REG()
RECALL
ENDIF
GRAVA_CLI()
SELE 1
EXIT
ENDIF
ELSEIF VARIGET = 2
SELE 1
EXIT
ELSEIF VARIGET = 3
LOOP
ENDIF
ENDDO
LOOP
OTHERWISE
NOVO=.F.
PUBLIC COCLI
COCLI=CODCLIE
PECLI()
MOSTRA_CLI()
DO WHILE .T.
IF A48
SET COLOR TO &CAMPO_DIGIT
TONE(600,1)
@ 03,45 SAY "/// C A N C E L A D O ///"
ENDIF
IF A48
OPCOES=1
EXEC=1
DO WHILE .T.
SET CONFIRM OFF
SET COLOR TO &FAIX_TRAB
@ 22,03 CLEAR TO 22,75
@ 22,02 PROMPT " F-Ficha "
@ 22,13 PROMPT " X-Extrato "
@ 22,26 PROMPT " R-Reativa cliente "
@ 22,47 PROMPT " I-Imprime "
MENU TO OPCOES
IF LASTKEY()=27
EXEC=0
EXIT
ENDIF
DO CASE
CASE OPCOES=1
SELE 1
RECPA=RECNO()
DO RECIBO
SELE 1
GOTO RECPA
LOOP
CASE OPCOES=2
SELE 1
RECPA=RECNO()
DO EXTRATO
SELE 1
GOTO RECPA
LOOP
CASE OPCOES=3
IF .NOT. SENHA("ALTERAR")
SELE 1
EXEC=0
EXIT
ENDIF
SELE 1
SET COLOR TO &TELA_TRAB
@ 03,45 SAY " "
IF .NOT. BLO_REG()
EXEC=0
EXIT
ENDIF
REPLACE CANCELADO WITH .F.
COMMIT
UNLOCK
A48=.F.
EXEC=1
EXIT
CASE OPCOES=4
SELE 1
RECPA=RECNO()
DO IMPRIXA
SELE 1
GOTO RECPA
LOOP
OTHERWISE
LOOP
ENDCASE
ENDDO
IF EXEC=0
EXIT
ENDIF
ENDIF
OPCOES=1
SET CURSOR OFF
SET COLOR TO &FAIX_TRAB
@ 22,01 CLEAR TO 22,71
SET COLOR TO &FAIX_TRAB
@ 22,03 PROMPT " Ficha "
@ 22,11 PROMPT " Altera "
@ 22,20 PROMPT " Outros "
@ 22,29 PROMPT " Cancela "
@ 22,39 PROMPT " Exclui "
@ 22,48 PROMPT " Imprime "
@ 22,58 PROMPT " Extrato "
@ 22,68 PROMPT " Tipo "
MENU TO OPCOES
IF LASTKEY()=27
EXIT
ENDIF
SET COLOR TO &TELA_TRAB
SET CURSOR ON
DO CASE
CASE OPCOES=1
SELE 1
RECPA=RECNO()
DO RECIBO
SELE 1
GOTO RECPA
CASE OPCOES=2
IF .NOT. SENHA("ALTERAR")
SELE 1
LOOP
ENDIF
EXEC=1
DO WHILE .T.
SELE 1
VARIGET=GET_CLI()
DO CASE
CASE VARIGET=1
MOSTRA_CLI()
GRAVA_CLI()
SELE 1
EXEC=1
EXIT
CASE VARIGET=2
EXEC=2
EXIT
CASE VARIGET=3
LOOP
ENDCASE
ENDDO
IF EXEC=2
EXIT
ENDIF
LOOP
CASE OPCOES=3
DO COMPLEMENTA
CASE OPCOES=4
IF .NOT. SENHA("EXCLUIR")
SELE 1
LOOP
ENDIF
DO WHILE .T.
SET COLOR TO &FAIX_TRAB
@ 22,01 CLEAR TO 22,78
CER=" "
SET CONFIRM OFF
@ 22,15 SAY "Quer mesmo cancelar o cliente ? [S/N] " GET CER
READ
SET COLOR TO &TELA_TRAB
SET CONFIRM ON
DO CASE
CASE CER="S" .OR. CER="s"
IF .NOT. BLO_REG()
EXEC=1
EXIT
ENDIF
REPLACE CANCELADO WITH .T.
COMMIT
UNLOCK
A48=.T.
EXEC=0
EXIT
CASE CER="N" .OR. CER="n"
EXEC=0
EXIT
OTHERWISE
LOOP
ENDCASE
ENDDO
IF EXEC=1
EXIT
ELSE
LOOP
ENDIF
CASE OPCOES=5
If .Not. Senha("EXCLUIR")
Sele 1
Loop
Endif
Sele 1
Tone(900,3)
If Alert("Nao e' recomendado excluir um cliente, pois, se excluir, sera eliminado todos os dados da ficha de compra, pagamentos e caixa."+;
" O ideal e' apenas CANCELAR a ficha do mesmo. Isto possibilitara' futuras consultas !",{"Nao excluir","Excluir"}) = 2
SELE 1
RECPA=RECNO()
Do Deletar With 1
Tone(750,1)
Alert("Cliente EXCLUIDO com sucesso !",{" Ok "})
Exit
Else
Tone(400,1)
Alert("O cliente NAO foi excluido !",{" Ok "})
Loop
Endif
CASE OPCOES=6
SELE 1
RECPA=RECNO()
DO IMPRIXA
SELE 1
GOTO RECPA
PECLI()
LOOP
CASE OPCOES=7
SELE 1
RECPA=RECNO()
DO EXTRATO
SELE 1
GOTO RECPA
LOOP
CASE OPCOES=8
SELE 1
RECPA=RECNO()
DO TIPODOCL with 1
SELE 1
GOTO RECPA
LOOP
OTHERWISE
LOOP
ENDCASE
ENDDO
LOOP
ENDCASE
ENDDO
FUNCTION CLIFIC
SET KEY -1 TO
DO CASE
CASE READVAR()="A01"
VARANTES=A01
CLI_LIS(1)
IF EMPTY(COD)
A01=VARANTES
ELSE
A01=COD
ENDIF
CASE READVAR()="V03"
VARANTES=V03
CON_LIS(2)
IF EMPTY(COD)
V03=VARANTES
ELSE
V03=COD
ENDIF
CASE READVAR()="V05"
VARANTES=V05
VEN_LIS(4)
IF EMPTY(COD)
V05=VARANTES
ELSE
V05=COD
ENDIF
CASE READVAR()="VEND"
VARANTES=Vend
VEN_LIS(3)
IF EMPTY(COD)
Vend=VARANTES
ELSE
Vend=COD
ENDIF
OTHERWISE
IF TOQUINAFICHA
VARANTES=Matriz01[q]
IF FICHA1
MER_LIS(4)
ELSE
VEN_LIS(3)
ENDIF
IF EMPTY(COD)
Matriz01[xq]=VARANTES
ELSE
Matriz01[xq]=Cod
ENDIF
KEYBOARD CHR(13)+CHR(13)
SET KEY -1 TO CLIFIC()
RETURN .T.
ELSE
IF UPPER(LEFT(READVAR(),8))="MATRIZ01"
VARANTES=Matriz01[q]
IF FICHA1
MER_LIS(4)
ELSE
VEN_LIS(3)
ENDIF
IF EMPTY(COD)
Matriz01[q]=VARANTES
ELSE
Matriz01[q]=Cod
ENDIF
ELSE
TONE(900,1)
ENDIF
ENDIF
ENDCASE
SAIU=1
SET KEY -1 TO CLIFIC()
RETURN .T.
PROCEDURE COMPLEMENTA
SAVE SCREEN TO COMP
SOMBRA(04,05,21,73)
SET COLOR TO &FAIX_TRAB
@ 04,05 SAY " DADOS COMPLEMENTARES "
SET COLOR TO &TELA_TRAB
@ 05,05 SAY "ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ Referencias comerciais ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»"
@ 06,05 SAY "º 1)Nome......: º"
@ 07,05 SAY "º Telefone..: º"
@ 08,05 SAY "º 2)Nome......: º"
@ 09,05 SAY "º Telefone..: º"
@ 10,05 SAY "º 3)Nome......: º"
@ 11,05 SAY "º Telefone..: º"
@ 12,05 SAY "ºÄÄÄÄÄÄÄÄÄÄÄ Pessoas autorizadas a retirar em seu nome ÄÄÄÄÄÄÄÄÄÄÄÄĺ"
@ 13,05 SAY "º Nome......: º"
@ 14,05 SAY "º Parentesco: º"
@ 15,05 SAY "º RG........: Data/exp: DP: º"
@ 16,05 SAY "º CIC.......: º"
@ 17,05 SAY "º Nome......: º"
@ 18,05 SAY "º Parentesco: º"
@ 19,05 SAY "º RG........: Data/exp: DP: º"
@ 20,05 SAY "º CIC.......: º"
@ 21,05 SAY "ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ"
SET CONFIRM ON
@ 06,21 GET A26
@ 07,21 GET A27
@ 08,21 GET A28
@ 09,21 GET A29
@ 10,21 GET A30
@ 11,21 GET A31
@ 13,19 GET A36
@ 14,19 GET A37
@ 15,19 GET A38
@ 15,48 GET A39 PICT "99/99/99"
@ 15,64 GET A40
@ 16,19 GET A41
@ 17,19 GET A42
@ 18,19 GET A43
@ 19,19 GET A44
@ 19,48 GET A45 PICT "99/99/99"
@ 19,64 GET A46
@ 20,19 GET A47
READ
SET CONFIRM OFF
SELE 1
IF ! NOVO
IF .NOT. BLO_REG()
RESTORE SCREEN FROM COMP
RETURN
ENDIF
REPLACE NOME_REF1 WITH A26
REPLACE FONE_REF1 WITH A27
REPLACE NOME_REF2 WITH A28
REPLACE FONE_REF2 WITH A29
REPLACE NOME_REF3 WITH A30
REPLACE FONE_REF3 WITH A31
REPLACE NOME_AUT1 WITH A36
REPLACE PARE_AUT1 WITH A37
REPLACE RG___AUT1 WITH A38
REPLACE EXP__AUT1 WITH A39
REPLACE DEPA_AUT1 WITH A40
REPLACE CIC__AUT2 WITH A41
REPLACE NOME_AUT2 WITH A42
REPLACE PARE_AUT2 WITH A43
REPLACE RG___AUT2 WITH A44
REPLACE EXP__AUT2 WITH A45
REPLACE DEPA_AUT2 WITH A46
REPLACE CIC__AUT2 WITH A47
COMMIT
UNLOCK
ENDIF
CLEAR TYPEAHEAD
RESTORE SCREEN FROM COMP
RETURN
FUNCTION GRAVA_CLI
SELE 1
IF BLO_REG()
REPLACE CODCLIE WITH A01
REPLACE DATA_CAD WITH A02
REPLACE NOMECLIE WITH A03
REPLACE DATA_NASC WITH A04
REPLACE ENDE_CLIE WITH A05
REPLACE BAIR_CLIE WITH A06
REPLACE CIDA_CLIE WITH A07
REPLACE ESTA_CLIE WITH A08
REPLACE CEP__CLIE WITH A09
REPLACE FONE_CLIE WITH A10
REPLACE TELE_FAX WITH A11
REPLACE RG___CLIE WITH A12
REPLACE DATA_EXPED WITH A13
REPLACE DEPARTA WITH A14
REPLACE CIC_CGC WITH A15
REPLACE EST_CIVIL WITH A16
REPLACE CONJUGE WITH A17
REPLACE NATURAL WITH A18
REPLACE PAI WITH A19
REPLACE MAE WITH A20
REPLACE LOCAL_TRAB WITH A21
REPLACE OBSERVACAO WITH A22
IF NOVO
REPLACE TIPO_PAG WITH Q01
REPLACE NOME_REF1 WITH A26
REPLACE FONE_REF1 WITH A27
REPLACE NOME_REF2 WITH A28
REPLACE FONE_REF2 WITH A29
REPLACE NOME_REF3 WITH A30
REPLACE FONE_REF3 WITH A31
REPLACE NOME_AUT1 WITH A36
REPLACE PARE_AUT1 WITH A37
REPLACE RG___AUT1 WITH A38
REPLACE EXP__AUT1 WITH A39
REPLACE DEPA_AUT1 WITH A40
REPLACE CIC__AUT2 WITH A41
REPLACE NOME_AUT2 WITH A42
REPLACE PARE_AUT2 WITH A43
REPLACE RG___AUT2 WITH A44
REPLACE EXP__AUT2 WITH A45
REPLACE DEPA_AUT2 WITH A46
REPLACE CIC__AUT2 WITH A47
ENDIF
COMMIT
UNLOCK
ELSE
RETURN .F.
ENDIF
RETURN .T.
FUNCTION GET_CLI
SELE 1
SET COLOR TO &FAIX_TRAB
@ 22,01 CLEAR TO 22,78
SET COLOR TO &TELA_TRAB
SET CONFIRM ON
@ 04,18 GET A02 PICT "99/99/99"
@ 05,18 GET A03
@ 06,18 GET A04 PICT "99/99/99"
@ 07,18 GET A05
@ 08,18 GET A06
@ 09,18 GET A07
@ 09,52 GET A08
@ 09,63 GET A09 PICT "99999-999"
@ 10,18 GET A10
@ 11,18 GET A11
@ 12,18 GET A12
@ 12,47 GET A13 PICT "99/99/99"
@ 12,63 GET A14
@ 13,18 GET A15
@ 14,18 GET A16
@ 14,43 GET A17
@ 15,18 GET A18
@ 16,18 GET A19
@ 17,18 GET A20
@ 18,18 GET A21
@ 19,18 GET A22
READ
IF NOVO
DO COMPLEMENTA
DO TIPODOCL
ENDIF
MOSTRA_CLI()
SET CONFIRM OFF
CONFIRMA=1
DO WHILE .T.
SET CURSOR OFF
SET COLOR TO &FAIX_TRAB
@ 22,01 CLEAR TO 22,78
@ 22,10 PROMPT " S-Confirma "
@ 22,25 PROMPT " N-Cancela "
@ 22,39 PROMPT " A-Altera "
MENU TO CONFIRMA
SET CURSOR ON
IF LASTKEY()=27
RETURN 2
ENDIF
SET COLOR TO &TELA_TRAB
DO CASE
CASE CONFIRMA=1
RETURN 1
CASE CONFIRMA=2
RETURN 2
CASE CONFIRMA=3
RETURN 3
OTHERWISE
LOOP
ENDCASE
ENDDO
FUNCTION MOSTRA_CLI
SET COLOR TO &CAMPO_DIGIT
@ 04,18 SAY A02
@ 05,18 SAY A03
@ 06,18 SAY A04
@ 07,18 SAY A05
@ 08,18 SAY A06
@ 09,18 SAY A07
@ 09,52 SAY A08
@ 09,63 SAY A09
@ 10,18 SAY A10
@ 11,18 SAY A11
@ 12,18 SAY A12
@ 12,47 SAY A13
@ 12,63 SAY A14
@ 13,18 SAY A15
@ 14,18 SAY A16
@ 14,43 SAY A17
@ 15,18 SAY A18
@ 16,18 SAY A19
@ 17,18 SAY A20
@ 18,18 SAY A21
@ 19,18 SAY A22
SET COLOR TO &TELA_TRAB
RETURN .T.
PROCEDURE IMPRIXA
SAVE SCREEN TO IMO
SET COLOR TO &FAIX_TRAB
@ 22,01 CLEAR TO 22,78
@ 22,05 SAY "Aguarde ... Imprimindo ficha do cliente "
SET COLOR TO &TELA_TRAB
SET PRINT ON
SET CONSOLE OFF
IF .NOT. IMPRESSORA()
RESTORE SCREEN FROM IMO
RETURN
ENDIF
CABECA("FICHA CADASTRAL")
? &LCOND+"DADOS DO CLIENTE_________________________________________________________________________________________________________________________"+&DCOND
?
? "CODIGO........: " + &LENFA + A01 + &DENFA +" DATA DO CADASTRO: " + &LENFA + DTOC(A02) + &DENFA
? "NOME..........: " + &LENFA + A03 + &DENFA
? "DATA/NASC.....: " + &LENFA + DTOC(A04) + &DENFA
? "ENDERECO......: " + &LENFA + A05 + &DENFA
? "BAIRRO........: " + &LENFA + A06 + &DENFA
? "CIDADE/UF/CEP.: " + &LENFA + RTRIM(A07)+" / " + A08 + " / " + A09 + &DENFA
? "TELEFONES.....: " + &LENFA + A10 + &DENFA
? "TELEFAX.......: " + &LENFA + A11 + &DENFA
? "IDENTIDADE....: " + &LENFA + A12 + &DENFA + " DATA/EXPED: " + &LENFA + DTOC(A13) + &DENFA + " DEPARTAMENTO: " + &LENFA + A14 + &DENFA
? "CIC (CPF).....: " + &LENFA + A15 + &DENFA
? "EST.CIVIL.....: " + &LENFA + A16 + &DENFA + " CONJUGE: " + &LENFA + A17 + &DENFA
? "NATURALIDADE..: " + &LENFA + A18 + &DENFA
? "FILIACAO......: " + &LENFA + A19 + &DENFA
? " " + &LENFA + A20 + &DENFA
? "LOCAL/TRABALHO: " + &LENFA + A21 + &DENFA
?
? &LCOND+"REFERENCIA COMERCIAL_____________________________________________________________________________________________________________________"+&DCOND
?
? "REFERENCIA 1..: " + &LENFA + A26 + &DENFA + " FONE: " + &LENFA + A27 + &DENFA
? "REFERENCIA 2..: " + &LENFA + A28 + &DENFA + " FONE: " + &LENFA + A29 + &DENFA
? "REFERENCIA 3..: " + &LENFA + A30 + &DENFA + " FONE: " + &LENFA + A31 + &DENFA
?
? &LCOND+"PESSOAS AUTORIZADAS A RETIRAR NA FICHA___________________________________________________________________________________________________"+&DCOND
?
? "1) " + &LENFA + A36 + &DENFA + " PARENTESCO: " + &LENFA + A37 + &DENFA
? "2) " + &LENFA + A42 + &DENFA + " PARENTESCO: " + &LENFA + A43 + &DENFA
?
? &LCOND+"OBSERVACOES______________________________________________________________________________________________________________________________"+&DCOND
?
? "OBSERVACAO: " + &LENFA + A22 + &DENFA
? "SITUACAO..: " + &LENFA + IF(A48,"CANCELADO","ATIVO") + &DENFA
?
? &LCOND+"_________________________________________________________________________________________________________________________________________"+&DCOND
EJECT
SET PRINT OFF
RESTORE SCREEN FROM IMO
RETURN
FUNCTION PECLI
SELE 1
A02=DATA_CAD
A03=NOMECLIE
A04=DATA_NASC
A05=ENDE_CLIE
A06=BAIR_CLIE
A07=CIDA_CLIE
A08=ESTA_CLIE
A09=CEP__CLIE
A10=FONE_CLIE
A11=TELE_FAX
A12=RG___CLIE
A13=DATA_EXPED
A14=DEPARTA
A15=CIC_CGC
A16=EST_CIVIL
A17=CONJUGE
A18=NATURAL
A19=PAI
A20=MAE
A21=LOCAL_TRAB
A22=OBSERVACAO
A26=NOME_REF1
A27=FONE_REF1
A28=NOME_REF2
A29=FONE_REF2
A30=NOME_REF3
A31=FONE_REF3
A36=NOME_AUT1
A37=PARE_AUT1
A38=RG___AUT1
A39=EXP__AUT1
A40=DEPA_AUT1
A41=CIC__AUT1
A42=NOME_AUT2
A43=PARE_AUT2
A44=RG___AUT2
A45=EXP__AUT2
A46=DEPA_AUT2
A47=CIC__AUT2
A48=CANCELADO
Q01=TIPO_PAG
PUBLIC TPAG:=TIPO_PAG
RETURN .T.
******************************
* Abertura do banco de dados *
******************************
Function Abre_arq(Dbf_file,Dbf_alias,Work_area,dbf_exclu)
*** Manter compatibilidade com os aplicativos ja desenvolvidos ***
If pcount()<4
dbf_exclu := Work_area
Work_area := Dbf_alias
Endif
If Valtype(Work_area) == "C"
Work_area := Val(Ltrim(Rtrim(Work_area)))
Endif
If Valtype(dbf_exclu) == "C"
dbf_exclu := If(UPPER(dbf_exclu)=".T.",.T.,.F.)
Endif
*****
Dbf_alias := "Sele"+Right(strzero(Work_area),2)
Nseconds := 0
Lret := .F.
Select ( Work_area )
If .Not. File(Dbf_file)
*Aviso("Arquivo nao encontrado",Dbf_file)
Alerta("Arquivo nao encontrado "+Dbf_file,{ " Ok " },{2})
Return .F.
Endif
Save Screen To Tela_net
Do While Lastkey()<>27
If dbf_exclu
Use ( Dbf_file ) Alias ( Dbf_alias ) Exclusive
Else
Use ( Dbf_file ) Alias ( Dbf_alias ) Shared
Endif
If !Neterr()
Lret := .T.
Exit
Endif
Inkey(.5)
Nseconds++
If Nseconds > 100
Restore screen from Tela_net
Inkey(.5)
Para_sempre()
Tone(900,2)
Loop
Elseif Nseconds > 150
Lret := .F.
Exit
Else
Para_sempre()
Endif
Enddo
Restore Screen From Tela_net
Return ( Lret )
*****************************************
* Adicionar registros no banco de dados *
*****************************************
Function Adi_reg( Area_work )
If Blo_arq( Area_work )
Lret := .F.
Nseconds := 1
Save Screen To Tela_net
Do While Lastkey()<>27
Append Blank
If !Neterr()
Lret := .T.
Exit
Endif
Inkey(.5)
Nseconds++
If Nseconds > 100
Restore screen from Tela_net
Inkey(.5)
Para_sempre()
Tone(900,2)
Loop
Elseif Nseconds > 150
Lret := .F.
Exit
Else
Para_sempre()
Endif
Enddo
Else
Lret := .F.
Endif
Restore Screen From Tela_net
Return ( Lret )
******************************
* Bloqueia um banco de dados *
******************************
Function Blo_arq( Work_area )
*** Manter a compatibilidade ***
If Valtype( Work_area ) == "C"
Work_area := Val(ltrim(rtrim(Work_area)))
Endif
*****
Select ( Work_area )
If Flock()
Return .T.
Endif
Lret := .F.
Nseconds := 1
Save Screen To Tela_net
Do While Lastkey()<>27
If Flock()
Lret := .T.
Exit
Endif
Inkey(.5)
Nseconds++
If Nseconds > 100
Restore screen from Tela_net
Inkey(.5)
Para_sempre()
Tone(900,2)
Loop
Elseif Nseconds > 150
Lret := .F.
Exit
Else
Para_sempre()
Endif
Enddo
Restore Screen From Tela_net
Return ( Lret )
******************************************
* Bloqueia um registro do banco de dados *
******************************************
Function Blo_reg()
If Rlock()
Return .T.
Endif
Lret := .F.
Nseconds := 1
Save Screen To Tela_net
Do While Lastkey()<>27
If Rlock()
Lret := .T.
Exit
Endif
Inkey(.5)
Nseconds++
If Nseconds > 100
Restore screen from Tela_net
Inkey(.5)
Para_sempre()
Tone(900,2)
Loop
Elseif Nseconds > 150
Lret := .F.
Exit
Else
Para_sempre()
Endif
Enddo
Restore Screen From Tela_net
Return ( Lret )
***********************************
* Menssagem de operacao bloqueada *
***********************************
Static Function Para_sempre()
Coris=Setcolor()
Sombra(08,09,14,73)
Setcolor("W+/R,N/W")
@ 08,09 Say "ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿"
@ 09,09 Say "³ ³"
@ 10,09 Say "³ Operacao bloqueada por outro terminal ! ³"
@ 11,09 Say "³ ³"
@ 12,09 Say "³ Aguarde liberacao do mesmo ou pressione <ESC> para abortar ! ³"
@ 13,09 Say "³ ³"
@ 14,09 Say "ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ"
Setcolor(Coris)
If Nseconds > 100
Inkey(.2)
Endif
Return .T.
003 public wcodpro, wpesmer, wnommer, wmarmer, wqtdest, registro, wobspro
004 public wvlrcus, wperdes, wvlrven, westmin, wlocpro, wunimer, wcodgrp, wrefpro
005 do abrearqs
006 do while .t.
007 tela (7, 10, 22, 70)
008 @ 7, 12 say 'Cadastro de Produtos'
009 @ 7, 42 prompt 'Inclusao'
010 @ 7, col () + 1 prompt 'Alteracao'
011 @ 7, col () + 1 prompt 'Exclusao'
012 menu to op
013 save screen to telacad
014 do case
015 case op = 0
016 close databases
017 release all like *
018 return
019 case op = 1
020 do inclui3
021 case op = 2
022 do altera3
023 case op = 3
024 do exclui3
025 endcase
026 restore screen from telacad
027 enddo
Código: Selecionar todos
Procedure cliente
Local oFormMain
public wcodpro, wpesmer, wnommer, wmarmer, wqtdest, registro, wobspro
public wvlrcus, wperdes, wvlrven, westmin, wlocpro, wunimer, wcodgrp, wrefpro
AbreArqs()
//Criamos um objeto oFormMain que é a janela principal.
//Não existe mais a preocupação de salvar telas e restaurar telas!
//Repare que eu estou trabalhando numa resolução de 800 x 600
//Caso eu precise pegar toda a area do monitor existem várias maneiras.
//Por exemplo:
PosX := GetDesktopWidth()
PosY := GetDesktopHeight()-30 //esse -30 é para não sobrepor a barra "Iniciar" do windows.
//Style DS_CENTER é para centralizar a janela.
INIT WINDOW oFormMain MAIN APPNAME "Exemplo" TITLE "Cadastro de Produtos" AT 0,0 SIZE 800,600 Style DS_CENTER
// Agora o menu o prompt !
MENU OF oMain
MENU TITLE "&Arquivos"
MENU TITLE "&Produtos"
MENUITEM "&Inclusão" ACTION {||Inclu3()}
MENUITEM "&Alteração" ACTION {||Altera3()}
MENUITEM "&Excluir" ACTION {||exclui3()}
MENUITEM "&Sair" ACTION {||EndWindow()}
ENDMENU
ENDMENU
ENDMENU
//Aqui seria o "READ" ou "MENU TO", porque aqui ele monta a tela; mostra a tela e espera uma ação.
ACTIVATE WINDOW oFormMain
Close Databases
Return
//Uma coisa muito importante, a Hwgui pega a fonte padrão do windows, e tem a fonte interna padrão para algumas coisas.
//Quanto as variaveis públicas não é necessário mas eu deixei para não afastar muito de seu código.
028 procedure inclui3
029 do zeracampos
030 do while .t.
031 @ 9, 29 say ' -0'
032 registro = 0
033 do getcampos1
034 read
035 if lastkey () = 27
036 return
037 endif
038 if confirma () = .f.
039 loop
040 endif
041 select controle
042 wcodpro = codpro + 9
043 select produtos
044 set order to 1
045 do while .t.
046 find (wcodpro)
047 if found ()
048 wcodpro = wcodpro + 9
049 else
050 exit
051 endif
052 enddo
053 select controle
054 if reglock ()
055 replace codpro with wcodpro
056 unlock
057 endif
058 select produtos
059 if adireg ()
060 do grava1
061 endif
062 @ 9, 29 say wcodpro picture '99999-9'
063 do TEC061a with wcodpro
064 mensagem ('Produto cadastrado...')
065 wvlrcus = 0.00
066 loop
067 enddo
068 return
Código: Selecionar todos
Procedure inclui3
Local oDlg,lOk
zeracampos()
//Não tem mais a necessidade do "Do while..." Na programação Visual seja ela no Windows/Linux/Palm procuramos evitar o "Do While"
//No windows temos alguns tipos de janelas neste caso a janela é um Dialog MODAL!
//Existe DIALOG MODAL, isto é fica esperando uma ação, não tem como minizar ela e fazer outra coisa, ela não deixa.
//E temos o DIALOG NOMODAL, isto é usamos ele quando estamos criando um relatório com a frase: "Aguarde...Processando..."
//Style DS_CENTER é entralizado, WS_VISIBLE é visivél lógico e WS_SYSMENU são aqueles três icones no canto superior direito.
//Minimizar, maximizar e fechar respectivamente.
//Eu não ficarei ajustando as coordenadas do @ say, get.
INIT DIALOG oDlg CLIPPER TITLE Titulo Font oFont AT 0,0 SIZE 500,300 STYLE DS_CENTER + WS_VISIBLE + WS_SYSMENU
//@ 9, 29 say ' -0'
//Olha só, esse @ 9,29 say ' -0' é dentro da DIALOG oDlg, oDlg é o Objeto.
//Como irei modificar/escrever nesta posição 9,29, posteriormente eu preciso criar um objeto para poder manipular.
//Então fica assim:
@ 9,29 say oSayCodPro CAPTION ' -0'
//Eu posso deixar da forma que está, mas como irei atualizalo depois ? oSayCodPro é o nume no objeto.
//032 registro = 0 -> Essa linha aqui não é mais necessário.
//033 do getcampos1 //Aqui o bixo pega!
GetCampos1(oDlg,"READ")
//Irei agora definir alguns botões
@ 100,250 Button oBtA Caption 'Confirmar' of oDlg Size 60,30 Style WS_TABSTOP ON CLICK {||ConfirmaProduto()}
@ 300,250 Button oBtB Caption 'Cancelar' of oDlg Size 60,30 Style WS_TABSTOP ON CLICK {||EndDialog()}
oDlg:Activate() //Aqui novamente o "READ" faz aparecer a DIALOG e aguardar uma ação!
Return Nil
Function ConfirmaProduto
select controle
wcodpro = codpro + 9
select produtos
set order to 1
do while .t.
find (wcodpro)
if found ()
wcodpro = wcodpro + 9
else
exit
endif
enddo
select controle
if reglock ()
replace codpro with wcodpro
unlock
endif
select produtos
if adireg ()
grava1()
endif
//@ 9, 29 say wcodpro picture '99999-9' //aqui não é mais preciso!
//Essa linha substitui a de cima.
oSayCodPro:SetText(wCodPro) //Espero que entenda isso. O objeto existe e está posicionado na tela eu só estou atualizando ele.
TEC061a(wcodpro)
MsgInfo('Produto cadastrado...')
wvlrcus := 0.00
return
Código: Selecionar todos
Procedure getcampos1(arg1,arg2)
@ 9, 12 say 'Codigo Produto:' size 200,20
@ 10, 12 say 'Desc.Produto..:' get wnommer picture '@!k' valid {||valmer()}
@ 11, 12 say 'Marca.........:' get wmarmer picture '@!k'
@ 12, 12 say 'Referencia....:' get wrefpro picture '@!k'
@ 13, 12 say 'Qtde Estoque..:' get wqtdest picture '999999.99'
@ 14, 12 say 'Unidade.......:' get wunimer picture '!!'
@ 15, 12 say 'Peso Liquido..:' get wpesmer picture '9999.999'
@ 16, 12 say 'Valor Custo...:' get wvlrcus picture '999999.99'
@ 17, 12 say 'Perc. Lucro...:' get wperdes picture '999.99' valid {||vvenda()}
@ 18, 12 say 'Valor Venda...:' get wvlrven picture '999,999.99' valid {||perluc()}
@ 19, 12 say 'Localizacao...:' get wlocpro picture '@!k'
@ 19, 45 say 'Grupo.:' get wcodgrp picture '999'
@ 20, 12 say 'Estoque Minimo:' get westmin picture '9999.99'
@ 21, 12 say 'Observ‡äes....:' get wobspro picture '@s40'
return
//Essa tela podemos deixar da forma que está penas melhorando o posicionamento.
//Ou podemos fazer assim:
@ 010,010 say 'Codigo Produto:' size 200,20
@ 010,030 say 'Desc.Produto..:' size 200,20
@ 230,030 get oGet01 Var wnommer picture '@!k' valid {||valmer()}
...
@ 010, 080 say 'Unidade.......:' size 200,20
@ 230,080 get oGet05 wunimer picture 'XX" STYLE ES_UPPERCASE //pode usar com "!!' também.
//Não irei aqui desenhar todas as telas, espero que tenha entendido o básico!
Código: Selecionar todos
#include "hwgui.ch"
#include "windows.ch"
clear
HB_CDPSELECT([PTISO])
hb_langselect([PT])
Func main
Local oFormMain
public wcodpro, wpesmer, wnommer, wmarmer, wqtdest, registro, wobspro
public wvlrcus, wperdes, wvlrven, westmin, wlocpro, wunimer, wcodgrp, wrefpro
AbreArqs()
PosX := GetDesktopWidth()
PosY := GetDesktopHeight()-30 //esse -30 é para não sobrepor a barra "Iniciar" do windows.
INIT WINDOW oFormMain MAIN TITLE "Cadastro de Produtos" AT 0,0 SIZE 800,600 Style DS_CENTER
MENU OF oFormMain
MENU TITLE "&Cadastro"
MENUITEM "&Produto" ACTION {||inclui3()}
MENUITEM "&Sair" ACTION {||EndWindow()}
ENDMENU
ENDMENU
ACTIVATE WINDOW oFormMain
Close Databases
Return nil
É parecido, mas no windows é por PIXEL.como eu vou saber qual sera a proxima linha e coluna pq no clipper era por linha e coluna na hwgui é diferente?
e outra duvida no final dos say vc colocou (size) o que quer dizer ?
Código: Selecionar todos
@ 10,10 say "Nome:" size 40,20 //A próxima será 40 ou 35 até 31 fica bem coladinho usando 31. por causa da largura que é 20.
@ 10,40 say "Endereço:" size 50,20