Página 1 de 1

alterar e deletar?

Enviado: 29 Abr 2008 13:41
por apo

Código: Selecionar todos

Como faço para criar um programa para alterar e deletar esse programa abaixo?
 Pessoal me ajudem eu sou iniciante em  clipper !!


* CADASTRO DE PRODUTORES******************************
CLEAR
SET COLOR TO Y/g
RETBOX=CHR (201) +CHR (205)  + CHR (187) + CHR(186) + ;
      CHR  (188) +CHR(205)  + CHR (200) + CHR (186)
@0,0,21,78 BOX RETBOX

USE CADPROD
VCODIGO=0;VNOME=SPACE(35)
VRG=SPACE(13);VCPF=SPACE(13);VEND=SPACE(35);VN=0;VCID=SPACE(25);VES=SPACE(2);VTEL=SPACE(14);VSX=SPACE(1);VEMAIL=SPACE(25);

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)
GOTO BOTTOM    
COD=CODIGO
@7,50 SAY "ULTIMO CàDIGO..."
@7,66 SAY COD PICTURE "99999"
@7,10 SAY "CODIGO.....:" GET VCODIGO PICT "99999"
READ
 IF VCODIGO=0
  RESTSCREEN(0,0,36,78,telaprinc)

  RETURN
 ENDIF
 LOCATE FOR CODIGO=VCODIGO
  IF FOUND()
   SET COLOR TO R/B
   @22,60 SAY  "Jµ CADASTRADO..."
     INKEY(2)
        @22,60 SAY SPACE(17)
     LOOP
ENDIF

 @ 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
          APPEND BLANK
          REPLACE CODIGO WITH VCODIGO
          REPLACE NOME WITH VNOME
          REPLACE RG WITH VRG
          REPLACE CPF WITH VCPF
          REPLACE END WITH VEND
          REPLACE CID WITH VCID
          REPLACE ES    WITH VES
          REPLACE TEL WITH VTEL
          REPLACE SX WITH VSX
          REPLACE 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)
          IF PO=1

VCODIGO=0;VNOME=SPACE(35)
VRG=SPACE(13);VCPF=SPACE(13);VEND=SPACE(35);VN=0;VCID=SPACE(25);VES=SPACE(2);VTEL=SPACE(14);VSX=SPACE(1);VEMAIL=SPACE(25);




         RESTSCREEN(0,0,36,78,telaprinc)
              LOOP
              ELSEIF PO=2
              @22,15 SAY SPACE(60)
                CLOSE DATABASE
               RESTSCREEN(0,0,36,78,telaprinc)
               RESTSCREEN(0,0,36,78,telaprinc)
               RETURN
          ENDIF
       ENDIF
  ENDDO
                                                  

**********************
CLEAR
SET COLOR TO Y/g
RETBOX=CHR (201) +CHR (205)  + CHR (187) + CHR(186) + ;
      CHR  (188) +CHR(205)  + CHR (200) + CHR (186)
@0,0,21,78 BOX RETBOX
INKEY(0)









Enviado: 29 Abr 2008 14:30
por gvc
Não entendi que vc esta querendo. Poderia explicar melhor?
Seria permitir ao usuário alterar e excluir dados do seu cadastro de produtos?

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.

Enviado: 29 Abr 2008 16:50
por gvc
Eu uso o dbedit e funciona.
Vejamos o que o APO quer realmente.

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!

Re: alterar e deletar?

Enviado: 15 Jun 2008 15:12
por gilsonpaulo
Eu faço assim:

Código: Selecionar todos

#include  "Acesso.ch"
#include  "SetCurs.ch"
#include  "Inkey.ch"

#define   nomeREL         "Relacao de Grupos"

IF psenha = "F"
	RETURN
ENDIF

SELECT 1
USE CADGRU SHARED ALIAS GRU

IF NETERR()
	Mensagem("Erro na abertura do arquivo, tente novamente")
	INKEY(0)
	TONE(1000,2)
	RETURN
ENDIF

SET INDEX TO INDGRU
GO TOP


PRIVATE ecodaux:=0,cod:=SPACE(2)


DO WHILE .T.

	SET CURSOR OFF
	CALL TGRU

	SETCOLOR("W/B,W/B")

	@ 04,11 SAY CODGRU
	@ 04,33 SAY DESGRU

	ik = 0
	ik = INKEY(0)

	IF ik=27
		EXIT
	ELSEIF ik=5
		SKIP -1
		ik = 0
	 ELSEIF ik=24 
		SKIP
		ik = 0
	ELSEIF ik = 6
		GO BOTTOM
	ELSEIF ik = 1
		GO TOP
	ELSEIF ik = 105 .OR. ik = 73
		SETCOLOR("R*/W,R/W")
		Inc121()
	ELSEIF ik = 69 .OR. ik = 101
		IF !EMPTY(DESGRU)
		   IF Confirma( "S03D" )
				SELECT GRU
				IF RLOCK()
					DELETE
				ELSE	
					Mensagem("Erro na exclusao tente novamente")
					INKEY(0)
				ENDIF	
				UNLOCK
				SKIP 
			ENDIF
		ENDIF
	ELSEIF ik = 65 .OR. ik = 97
		IF !EMPTY(DESGRU)
			Alt121()
		ENDIF
	ELSEIF ik = 67 .OR. ik = 99
		IF !EMPTY(DESGRU)
			Con121()
		ENDIF
	ELSEIF ik = 76 .OR. ik = 108
		IF !EMPTY(DESGRU)
			Tel121()
		ENDIF
	ELSEIF ik = 80 .OR. ik = 112
		IF !EMPTY(DESGRU)
			Pap121()
		ENDIF
	ELSE
		TONE(300)
	ENDIF

	IF EOF()
		SKIP -1
	ENDIF

	IF BOF()
		GO TOP
	ENDIF


ENDDO
SET RELATION TO

SELECT 1
USE
SELECT 2
USE
RETURN
*==============================
STATIC PROCEDURE Inc121()

LOCAL nom:=SPACE(40)
		

DO WHILE .T.

	CALL TGRU
	SETCOLOR("W/B,W/B")
	@ 04,11 GET cod PICTURE "@!K AA"  VALID !CGRU(cod)
	@ 04,33 GET nom PICTURE "@K!X" VALID !EMPTY(nom)
	SET CURSOR ON
	READ	
	SET CURSOR OFF
	IF LASTKEY() == 27
		RETURN
	ENDIF
		

// GRAVAR O REGISTRO

	SELECT GRU

   IF Confirma( "S01D" )
		GRU->(dbAppend())
		IF !NETERR()
			GRU->CODGRU:=        cod
			GRU->DESGRU:= 		   nom
		ELSE
			Mensagem("Nao consegui gravar tente novamente")
			INKEY(0)
		ENDIF
		UNLOCK
		COMMIT

	ENDIF


ENDDO
*==================================================
STATIC PROCEDURE Alt121()

LOCAL nom:=SPACE(40)
nom = DESGRU
DO WHILE .T.

	SETCOLOR("W/B,W/B")
	@ 04,33 GET nom PICTURE "@K!X" VALID !EMPTY(nom)
	SET CURSOR ON
	READ	
	SET CURSOR OFF
	IF LASTKEY() == 27
		RETURN
	ENDIF
		
// GRAVAR O REGISTRO

	SELECT GRU

   IF Confirma( "S02D" )
		IF RLOCK()
			GRU->DESGRU:= 		   nom
		ELSE
			Mensagem("Nao consegui gravar o registro tente novamente")
			INKEY(0)
		ENDIF
		UNLOCK
		COMMIT

	ENDIF

	EXIT

ENDDO
RETURN
*==================================================
PROCEDURE CGRU(cod)

SELECT GRU
GO TOP
SEEK cod
RETURN(FOUND())