*PROGRAMA: ABCD.PRG
*AUTOR: VICTOR
*FECHA: 10/10/02
*DESCRIPCION: SISTEMA DE ALTAS, BAJAS, CAMBIOS, CONSULTAS Y DESPLEGADO

*NOTA IMPORTANTE: ANTES DE EJECUTAR ESTE PROGRAMA, PRIMERO DEBES CREAR
*UNA BASE DE DATOS USANDO EL DBU, QUE TENGA LA ESTRUCTURA SIGUIENTE:
* CLAVE Caracter 4, NOMBRE Caracter 40, DIRECCION Caracter 20
* TELEFONO Caracter 15, FECHNAC Fecha 8
* DEBES GRABARLA CON EL NOMBRE: PERSONA

SET DATE TO FRENCH
PRESENTACION()
SET COLOR TO 14/1,14/4
USE PERSONA             //ABRIR UNA BASE DE DATOS YA CREADA CON DBU
INDEX ON CLAVE TO PERSONA       //INDEXAR UNA BASE DE DATOS
CLEAR
MARCO(0,0,24,79,2)      //MARCO LINEA DOBLE
MARCO(1,1,3,78,1)       //MARCO LINEA SENCILLA
MARCO(7,28,13,52,1)
MARCO(21,25,23,55,1)
TIT="SISTEMA ABCD"
CENTRA(TIT,2)           //CENTRA EL MENSAJE
SET MESSAGE TO 22 CENTER
SET WRAP ON
SEL=1
DO WHILE SEL<6
 *PADC() CENTRA UNA CADENA
 @8,30 PROMPT PADC("A L T A S",20) MESSAGE "CAPTURAR DATOS NUEVOS"
 @9,30 PROMPT PADC("B A J A S",20) MESSAGE "ELIMINAR UN REGISTRO"
 @10,30 PROMPT PADC("C A M B I O S",20) MESSAGE "MODIFICAR UN REGISTRO"
 @11,30 PROMPT PADC("C O N S U L T A S",20) MESSAGE "VER UN REGISTRO"
 @12,30 PROMPT PADC("D E S P L E G A R",20) MESSAGE "VER TODOS LOS REGISTROS"
 MENU TO SEL
 PANTA=SAVESCREEN(4,1,23,78)
 DO CASE
  CASE SEL=1
   ALTAS()
  CASE SEL=2
   BAJAS()
  CASE SEL=3
   CAMBIOS()
  CASE SEL=4
   CONSULTAS()
  CASE SEL=5
   DESPLEGAR()
  OTHERWISE     //EN CASO DE QUE NO SEA UN NUMERO DEL 1 AL 5
   IF READKEY()=12 .OR. READKEY()=268   //SI SE OPRIME LA TECLA ESCAPE
    SET COLOR TO        //REGRESAR EL COLOR A BLANCO SOBRE NEGRO
    CLEAR
    CLOSE ALL
    QUIT        //SALIDA DEL PROGRAMA
   ENDIF
 ENDCASE
 RESTSCREEN(4,1,23,78,PANTA)
ENDDO
RETURN          //FIN DEL PROGRAMA PRINCIPAL

PROCEDURE MARCO(RI,CI,RF,CF,L)
 IF L=1
  @RI,CI TO RF,CF
 ELSE
  @RI,CI TO RF,CF DOUBLE
 ENDIF
RETURN

PROCEDURE CENTRA(MSJE,REN)
 @REN,(80-LEN(MSJE))/2 SAY MSJE COLOR 10/1
RETURN

PROCEDURE ALTAS
 @4,1 CLEAR TO 23,78
 MAL="CAPTURA DE UN REGISTRO"
 CENTRA(MAL,4)
 LETREROS()
 OTRO="S"
 DO WHILE OTRO="S"
  MCLA=SPACE(4)
  MNOM=SPACE(40)
  MDIR=SPACE(20)
  MTEL=SPACE(15)
  MFNA=SPACE(8)
  @8,29 GET MCLA
  READ
  SEEK MCLA
  IF .NOT. FOUND()
   CAPTURA()
   APPEND BLANK
   REPLACE CLAVE WITH MCLA,NOMBRE WITH MNOM,DIRECCION WITH MDIR,;
           TELEFONO WITH MTEL,FECHNAC WITH CTOD(MFNA)
  ELSE
   CENTRA("CLAVE DUPLICADA",20)
   TONE(500,1)
   INKEY(0)
   @20,20 CLEAR TO 20,60
  ENDIF
  @18,20 SAY "QUIERES CAPTURAR OTRO <S/N>?"
  @18,49 GET OTRO PICT "!" VALID(OTRO$"SN")
  READ
  LIMPIA()
 ENDDO
RETURN

PROCEDURE BAJAS
 @4,1 CLEAR TO 23,78
 MBAJ="ELIMINA UN REGISTRO"
 CENTRA(MBAJ,4)
 LETREROS()
 OTRO="S"
 DO WHILE OTRO="S"
  MCLA=SPACE(4)
  @8,29 GET MCLA
  READ
  SEEK MCLA
  IF FOUND()
   VER()
   BAJA="N"
   @20,20 SAY "QUIERES DARLO DE BAJA <S/N>? "
   @20,49 GET BAJA PICT "!" VALID(BAJA$"SN")
   READ
   IF BAJA="S"
    DELETE
   ENDIF
  ELSE
   CENTRA("CLAVE INEXISTENTE",20)
   TONE(500,1)
   INKEY(0)
  ENDIF
  @20,20 CLEAR TO 20,60
  @18,20 SAY "QUIERES DAR DE BAJA OTRO <S/N>?"
  @18,53 GET OTRO PICT "!" VALID(OTRO$"SN")
  READ
  LIMPIA()
 ENDDO
 IF DELETED()
  PACK
 ENDIF
RETURN

PROCEDURE CAMBIOS
 @4,1 CLEAR TO 23,78
 MCAM="MODIFICAR UN REGISTRO"
 CENTRA(MCAM,4)
 LETREROS()
 OTRO="S"
 DO WHILE OTRO="S"
  MCLA=SPACE(4)
  @8,29 GET MCLA
  READ
  SEEK MCLA
  IF FOUND()
   MODIFICA()
  ELSE
   CENTRA("CLAVE INEXISTENTE",20)
   TONE(500,1)
   INKEY(0)
  ENDIF
  @20,20 CLEAR TO 20,60
  @18,20 SAY "QUIERES MODIFICAR OTRO <S/N>?"
  @18,53 GET OTRO PICT "!" VALID(OTRO$"SN")
  READ
  LIMPIA()
 ENDDO
RETURN

PROCEDURE CONSULTAS
 @4,1 CLEAR TO 23,78
 MCON="CONSULTAR UN REGISTRO"
 CENTRA(MCON,4)
 LETREROS()
 OTRO="S"
 DO WHILE OTRO="S"
  MCLA=SPACE(4)
  @8,29 GET MCLA
  READ
  SEEK MCLA
  IF FOUND()
   VER()
  ELSE
   CENTRA("CLAVE INEXISTENTE",20)
   TONE(500,1)
   INKEY(0)
  ENDIF
  @20,20 CLEAR TO 20,60
  @18,20 SAY "QUIERES CONSULTAR OTRO <S/N>?"
  @18,53 GET OTRO PICT "!" VALID(OTRO$"SN")
  READ
  LIMPIA()
 ENDDO
RETURN

PROCEDURE DESPLEGAR
 @4,1 CLEAR TO 23,78
 MDES="CONSULTAR UN REGISTRO"
 CENTRA(MDES,4)
 DBEDIT(4,1,23,78)
RETURN

PROCEDURE LETREROS
 @8,20 SAY "CLAVE => "
 @9,20 SAY "NOMBRE => "
 @10,20 SAY "DIRECCION => "
 @11,20 SAY "TELEFONO => "
 @12,20 SAY "FECHA DE NACIMIENTO => "
RETURN

PROCEDURE LIMPIA
 @8,29 CLEAR TO 8,60
 @9,30 CLEAR TO 9,70
 @10,33 CLEAR TO 10,60
 @11,32 CLEAR TO 11,60
 @12,44 CLEAR TO 12,60
RETURN

PROCEDURE VER
 @9,30 SAY NOMBRE
 @10,33 SAY DIRECCION
 @11,32 SAY TELEFONO
 @12,44 SAY FECHNAC
RETURN

PROCEDURE CAPTURA
 @9,30 GET MNOM
 @10,33 GET MDIR
 @11,32 GET MTEL
 @12,44 GET MFNA PICTURE "99/99/99"
 READ
RETURN

PROCEDURE MODIFICA
 @9,30 GET NOMBRE
 @10,33 GET DIRECCION
 @11,32 GET TELEFONO
 @12,44 GET FECHNAC PICTURE "99/99/99"
 READ
RETURN

PROCEDURE PRESENTACION
 CLEAR
 SET CURSOR OFF
 SET COLOR TO 10
 CENTRA("S I S T E M A    A B C D",12)
 DO WHILE LASTKEY()!=13
  SET COLOR TO 14
  FOR A=0 TO 11
   @A,A TO 24-A,79-A 
   INKEY(0.05)
   IF LASTKEY()=13
    SET CURSOR ON
    RETURN
   ENDIF
  NEXT
  SET COLOR TO 0
  FOR A=11 TO 0 STEP -1
   @A,A TO 24-A,79-A 
   INKEY(0.05)
   IF LASTKEY()=13
    SET CURSOR ON
    RETURN
   ENDIF
  NEXT
 ENDDO
 SET CURSOR ON
RETURN