Enviado: 29 Abr 2008 15:02
por Alcir
//EXEMPLO PARA MONOUSUARIO
USE CADPROD
GO TOP
XPRODU=SPACE(10)
@01,01 SAY "QUAL PRODUTO A ALTERAR: " GET XPRODU
READ
IF LASTKEY()==27
RETURN NIL
ENDIF
LOCATE FOR VCODIGO=XVCODIGO
IF !FOUND()
SET COLOR TO R/B
@22,60 SAY "PRODUTO NAO EXISTE..."
INKEY(0)
@22,60 SAY SPACE(17)
LOOP
ENDIF
VCODIGO=CODIGO
VNOME=NOME
VRG=RG
VCPF=CPF
VEND=VEND
VN=VN
VCID=CID
VES=ES
VTEL=TEL
VSX=SX
VEMAIL=EMAIL
DO WHILE .T.
@ 0,0,02,78 BOX RETBOX
SET COLOR TO B+/W
CLEAR
@ 00,05,02,78 BOX REPLICATE (CHR(219),9)
SET COLOR TO R
@ 20,48,05,78 BOX REPLICATE (CHR(219),9)
@ 8,10 SAY "NOME.........."GET VNOME PICTURE "@!"
@ 9,10 SAY "RG:..........."GET VRG PICTURE "@!"
@ 10,10 SAY "CPF/CNPJ......"GET VCPF PICTURE "@!"
@ 11,10 SAY "ENDERECO......"GET VEND PICTURE "@!"
@ 12,10 SAY "NUMERO........"GET VN
@ 13,10 SAY "ESTADO........"GET VES PICTURE "@!"
@ 14,10 SAY "FONE.........."GET VTEL PICTURE "@!"
@ 15,10 SAY "SEXO.........."GET VSX PICTURE "@!"
@ 16,10 SAY "EMAIL........."GET VEMAIL PICTURE "@!"
READ
@22,15 SAY SPACE (60)
@22,16 SAY "CONFIRMAR OS DADOS ACIMA?"
@22,42 PROMPT "SIM"
@22,48 PROMPT "NÇO"
MENU TO OP
@22,15 SAY SPACE (60)
IF OP=2
LOOP
ELSEIF OP=1
REPLACE CODIGO WITH VCODIGO,NOME WITH VNOME
REPLACE RG WITH VRG, CPF WITH VCPF
REPLACE END WITH VEND,CID WITH VCID
REPLACE ES WITH VES,TEL WITH VTEL
REPLACE SX WITH VSX, EMAIL WITH VEMAIL
@22,15 SAY "QUER CONTINUAR?"
@22,42 PROMPT "SIM"
@22,48 PROMPT "NÇO"
MENU TO PO
@22,15 SAY SPACE(50)
.
.
.
.
.
Espero ter colaborado
Fiz rapido, talves tenha algum erro de variavel.
Abraços
Enviado: 29 Abr 2008 15:35
por Pablo César
Apo, como você disse: o seu conhecimento em programação é de iniciante. Você deve conhecer o DBU.EXE que vem do Clipper. Através dele você poderá exibir, aletrar, deletar e até adicionar uma função de impressão. Não com isto quero dizer que o DBU seja a sua solução. Mas o que eu quero salientar é que nessa é mais uma forma de programar (POO - Programação Orienta a Objeto). Aqui no fórum tem vários exemplo (utilize o "Busca" com a palavra TBROWSE), inclusive na tela Inicial áera de dowloads tem exemplos para baixar.
Eu aconselhei a fazer uso de TBROWSE, embora não seja fácil entender de primeira vez, isto é, porque é uma nova forma de programar em Clipper mas que reduze muito a quantidade de tela. O que você iria enfrentar caso tenha que fazer:
- INCLUSÃO
- CONSULTA
- ALTERAÇÃO
- DELEÇÃO
Tudo isso poderá ser conciliado com a criação de rotina em TBROWSE.
Re: alterar e deletar?
Enviado: 13 Jun 2008 14:34
por Othelo
Amigos, da pra perceber que o codigo que o amigo APO colocou é retirado dos livros do Ramalho (meu professor e de muitos aqui suponho) rrsrsrs.
É um codigo antigo e usado em aprendizagem. Pelo que entendi ele gostaria de aprender como melhorar esse codigo colocando recursos de exclusao, alteracao, me corrijam se estiver enganado.
Se for isso, a sugestao realmente é partir para um DEBIT (mais facil e simples pra iniciante) ou um TBrowse (para programadores mais experientes)
Um codigo parecido com esse seria algo assim:
*-------------------------------------------------------------------------------
rotina para consultar, incluir, alterar e excluir, num unico codigo
*-------------------------------------------------------------------------------
LOCAL GetList := {}
LOCAL Tel_001 := SaveScreen( 04,00,23,79 )
LOCAL CorAnt := SetColor()
LOCAL aaCampo[02], aaMasca[02], aaPictu[02]
aaCampo[01] := "COD_CFOP"
aaCampo[02] := "DES_CFOP"
aaMasca[01] := "CFOP"
aaMasca[02] := "Natureza"
aaPictu[01] := "!!!!!"
aaPictu[02] := "XXXXXXXXXXXXXXXXXXXX"
SELE CFOP
SET ORDER TO 1
GO TOP
Modulo( 'CFOP' )
Modelo( 'Manutencao Tabela' )
Moldura( 04,00,23,79,3,1,1,'Manutencao CFOP','B+/BG+','BG+/B+' )
DBEDIT( 05,01,22,78,aaCampo,'J_ManCFOP1',aaPictu,aaMasca )
SELE CFOP
SET ORDER TO 1
GO TOP
RestScreen( 04,00,23,79,Tel_001 )
SetColor( CorAnt )
RETURN
*-------------------------------------------------------------------------------
Function J_ManCFOP1( Modo )
*-------------------------------------------------------------------------------
* Funcao....:
* Parametros:
* Retorna...:
*
LOCAL GetList := {}
LOCAL Tel_001 := SaveScreen( 00,00,24,79 )
LOCAL CorAnt := SetColor()
LOCAL xRecord := Recno()
LOCAL nTecla_ := LastKey()
DO CASE
CASE nTecla_ == -1
IF ValAcesso( M->sUsuario,05,90 )
DO Man_CFOP1 WITH "I"
ENDIF
//
RestScreen( 00,00,24,79,Tel_001 )
RETURN(1)
CASE nTecla_ == -2
IF ValAcesso( M->sUsuario,05,91 )
DO Man_CFOP1 WITH "A"
ENDIF
//
RestScreen( 00,00,24,79,Tel_001 )
RETURN(2)
CASE nTecla_ == -3
IF ValAcesso( M->sUsuario,05,92 )
DO Man_CFOP1 WITH "E"
GO TOP
ENDIF
//
RestScreen( 00,00,24,79,Tel_001 )
RETURN(2)
CASE nTecla_ == -4
DO Man_CFOP1 WITH "D"
//
RestScreen( 00,00,24,79,Tel_001 )
RETURN(1)
CASE nTecla_ == -5
CASE nTecla_ == 27
RETURN(0)
ENDCASE
IF Modo >= 1 .AND. Modo <= 4
MDbedit( Modo )
ENDIF
RETURN(1)
*-------------------------------------------------------------------------------
Procedure Man_CFOP1( PFUNC )
*-------------------------------------------------------------------------------
* Funcao....:
* Parametros:
* Retorna...:
*
LOCAL GetList := {}
LOCAL Tel_001 := SaveScreen( 00,00,24,79 )
LOCAL Tel_002 := SaveScreen( 00,00,24,79 )
LOCAL CorAnt := SetColor()
LOCAL Cursor := SetCursor(1)
LOCAL xDate := date()
LOCAL xRecord := recno()
LOCAL XCOD_CFOP := SPACE(5)
LOCAL XDES_CFOP := SPACE(20)
IF PFUNC$( 'DEA' )
XCOD_CFOP := CFOP->COD_CFOP
XDES_CFOP := CFOP->DES_CFOP
ENDIF
SELE CFOP
SET ORDER TO 1
GO xRecord
Modelo( PFUNC )
Moldura( 04,00,23,79,3,1,1,'Manutencao do Centros de Custos','B+/BG+','BG+/B+' )
@ 06,08 SAY 'Controle ..: '
@ 09,08 SAY 'Conta......: '
@ 09,30 SAY '==> '
@ 11,08 SAY 'Aplicacao..: '
@ 11,30 SAY '==> '
@ 13,08 SAY 'Descricao..: '
@ 13,30 SAY '==> '
SetColor( CorAnt )
Tel_002 := SaveScreen( 00,00,24,79 )
DO WHILE .T.
//
RestScreen( 00,00,24,79,Tel_002 )
//
Centra( 24,'Digite [1 Conta] [2 Aplicacao] [3 Descricao] ou <ESC> para Retornar.','W+/N+',1 )
@ 06,21 GET XCONTROLE PICT '9' VALID XCONTROLE$( '123' )
IF PFUNC == 'I'
READ
IF LastKey() == 27
EXIT
ENDIF
ENDIF
//
IF XCONTROLE$( '23' ) .AND. PFUNC$( 'IA' )
aDBF := { 'CD_CEN01','DE_CEN01' }
XCD_CEN01 := Ver_DBF( 05,50,22,78,'CENT',aDBF,'CD_CEN01',{ || CENT->CONTROLE == '1' })
IF LastKey() == 27
LOOP
ENDIF
//
SELE CENT
SEEK XCD_CEN01
XDE_CEN01 := CENT->DE_CEN01
//
SetColor( 'GR+/B+' )
@ 09,21 SAY XCD_CEN01 PICT '999'
SetColor( CorAnt )
ELSE
Centra( 24,'Digite a Classificacao da Conta ou <ESC> para Retornar.','W+/N+',1 )
@ 09,21 GET XCD_CEN01 PICT '999'
IF PFUNC == 'I'
READ
IF LastKey() == 27
EXIT
ENDIF
//
SEEK XCD_CEN01
IF FOUND()
DO CASE
CASE XCONTROLE == '1' .AND. CENT->CONTROLE # '1'
CASE XCONTROLE == '2' .AND. CENT->CONTROLE # '2'
CASE XCONTROLE == '3' .AND. CENT->CONTROLE # '3'
OTHERWISE
Mensagem( 24,'<<<ATENCAO>>> Este codigo de Conta ja existe !!! Tente Outro !!!','W+/R+',60 )
LOOP
ENDCASE
ENDIF
ELSE
CLEAR GETS
ENDIF
ENDIF
//
Centra( 24,'Digite a Descricao da Conta ou <ESC> para Retornar.','W+/N+',1 )
@ 09,34 GET XDE_CEN01 PICT '@!@X20'
IF PFUNC$( 'IA' ) .AND. XCONTROLE == '1'
READ
IF LastKey() == 27
EXIT
ENDIF
ELSE
CLEAR GETS
ENDIF
//
IF XCONTROLE$( '23' )
IF XCONTROLE$( '3' ) .AND. PFUNC$( 'IA' )
aDBF := { 'CD_CEN02','DE_CEN02' }
XCD_CEN02 := Ver_DBF( 05,50,22,78,'CENT',aDBF,'CD_CEN02',{ || CENT->CONTROLE == '2' .AND. CENT->CD_CEN01 == XCD_CEN01 })
IF LastKey() == 27
LOOP
ENDIF
//
SELE CENT
SEEK XCD_CEN01+XCD_CEN02
XDE_CEN02 := CENT->DE_CEN02
//
SetColor( 'GR+/B+' )
@ 11,21 SAY XCD_CEN02 PICT '999'
SetColor( CorAnt )
ELSE
Centra( 24,'Digite a Aplicacao da Conta ou <ESC> para Retornar.','W+/N+',1 )
@ 11,21 GET XCD_CEN02 PICT '999'
IF PFUNC == 'I'
READ
IF LastKey() == 27
EXIT
ENDIF
//
SEEK XCD_CEN01+XCD_CEN02
IF FOUND()
Mensagem( 24,'<<<ATENCAO>>> Este codigo de Conta e aplicacao ja existem !!! Tente Outro !!!','W+/R+',60 )
LOOP
ENDIF
ELSE
CLEAR GETS
ENDIF
ENDIF
//
Centra( 24,'Digite a Descricao da Aplicao ou <ESC> para Retornar.','W+/N+',1 )
@ 11,34 GET XDE_CEN02 PICT '@!@X20'
IF PFUNC$( 'IA' ) .AND. XCONTROLE == '2'
READ
IF LastKey() == 27
EXIT
ENDIF
ELSE
CLEAR GETS
ENDIF
//
IF XCONTROLE == '3'
Centra( 24,'Digite a Descricao ou <ESC> para Retornar.','W+/N+',1 )
@ 13,21 GET XCD_CEN03 PICT '99999'
@ 13,34 GET XDE_CEN03 PICT '@!@X20'
IF PFUNC$( 'IA' )
READ
IF LastKey() == 27
EXIT
ENDIF
ELSE
CLEAR GETS
ENDIF
ENDIF
ENDIF
//
IF PFUNC == 'D'
Mensagem( 24,'<<<Pressione qquer tecla para voltar !!!>>>','W+/GR+',60 )
EXIT
ENDIF
//
IF Confirma( 15,'<<<ATENCAO>>> Confirma a Operacao ['+PFUNC+'] Solicitada ?' )
//
SELE CENT
IF PFUNC == 'I' .AND. AdiReg( 20)
REPLACE CENT->SITUACAO WITH '1' ,;
CENT->CONTROLE WITH XCONTROLE ,;
CENT->CD_CEN01 WITH XCD_CEN01 ,;
CENT->CD_CEN02 WITH XCD_CEN02 ,;
CENT->CD_CEN03 WITH XCD_CEN03 ,;
CENT->SITUACAO WITH 'C'
ENDIF
IF RegLock( 20)
IF PFUNC$( 'IA' )
REPLACE CENT->SITUACAO WITH '1' ,;
CENT->DE_CEN01 WITH XDE_CEN01 ,;
CENT->DE_CEN02 WITH XDE_CEN02 ,;
CENT->DE_CEN03 WITH XDE_CEN03 ,;
CENT->SITUACAO WITH 'C'
ELSE
REPLACE CENT->SITUACAO WITH 'E'
DELE
ENDIF
ENDIF
REPLACE CENT->USU WITH M->sUsuario ,;
CENT->OPE WITH PFUNC ,;
CENT->EST WITH Cript( M->ESTACAO) ,;
CENT->MAQ WITH Cript( M->MAQUINA) ,;
CENT->DTA WITH F_DT()
//
// Controle Transferencia
//
DO CASE
CASE PARAM->TRANSFER == '1'
REPLACE CENT->FLAGTR1 WITH 'T'
CASE PARAM->TRANSFER == '2'
REPLACE CENT->FLAGTR2 WITH 'T'
CASE PARAM->TRANSFER == '3'
REPLACE CENT->FLAGTR3 WITH 'T'
ENDCASE
//
COMMIT
UNLOCK
ENDIF
//
IF PFUNC == 'I' .AND. Confirma( 15,'Deseja incluir outro docto ?' )
XCONTROLE := SPACE(1)
XCD_CEN01 := SPACE(3)
XCD_CEN02 := SPACE(3)
XCD_CEN03 := SPACE(5)
XDE_CEN01 := SPACE(20)
XDE_CEN02 := SPACE(20)
XDE_CEN03 := SPACE(20)
LOOP
ENDIF
EXIT
//
ENDDO
RestScreen( 00,00,24,79,Tel_001 )
SetColor( CorAnt )
RETURN
*-------------------------------------------------------------------------------
por exemplo
:d espero ter ajudado um pouco!