Aprendizaje en la red.

martes, 6 de julio de 2021

Base de datos en Visual Foxpro solo código

Con los diferentes lenguajes de programación en la actualidad es más sencillo programar grandes base de datos, haciendo uso de msql. En la vieja escuela se aprendia diseñando la estructura de una base de datos enlazandos diferentes tablas dentro de un mismo programa. Ahora les dejamos el siguiente código fuente de una base de datos diseñado en Visual Foxpro de un almacen.

 




INGRESO


CLEAR
do while .t.
use productoS
cod=space(5)
OTRO=SPACE(1)
@02,08 to 25,125
@03,10 SAY 'PRODUCTOS [NUEVOS]'
@05,10 Say 'CODIGO' get COD
read
if COD = space(5) then
    clear all
    return
endif
locate for COD = CODIGO
if COD = CODIGO
    wait wind 'EL PRODUCTO YA EXISTE'
ELSE
    append blank
    @09,20 say 'DESCRIPCION.......' get PRODUCTO
    @10,20 say 'PRECIO............' get PRECIO
    @11,20 say 'CANTIDAD..........' get CANTIDAD
    @12,20 say 'FECHA VENCIMIENTO.' get FECHA_VEN
    @13,20 say 'MARCA.........' get MARCA
    @14,40 say date()
    read
    v=fecha_ven-date()
    @15,20 say 'dias de vencimiento'
    @15,50 say v pict '#####'
    x=v/30
    @16,20 say 'meses de vencimiento'
    @16,50 say x pict '#####'
    @20,20 say 'PROVEEDOR.........' get PROVEEDOR
    @21,20 SAY 'OBSERVACIONES.....' get OBSER
    replace CODIGO with COD
    READ
ENDIF
@22,18 SAY 'DESEA OTRO INGRESO [S/N]' GET OTRO PICT '!'
READ
IF (UPPER(OTRO))='S' THEN
    LOOP
ELSE
    RETURN
    clear all
CLOSE DATABASE
endif
endDO


MODIFICACION

CLEAR
do while .t.
use productos
cod=space(5)
OTRO=SPACE(1)
@02,08 to 25,125
@03,10 SAY 'PRODUCTOS [NUEVOS]'
@05,10 Say 'CODIGO' get COD
read
if COD = space(5) then
    clear all
    return
endif
locate for COD = CODIGO
if COD <> CODIGO
    wait wind 'EL PRODUCTO NO EXISTE'
ELSE
    @09,20 say 'DESCRIPCION.......' get PRODUCTO
    @10,20 say 'PRECIO............' get PRECIO
    @11,20 say 'CANTIDAD..........' get CANTIDAD
    @12,20 say 'FECHA VENCIMIENTO.' get FECHA_VEN
    @13,20 say 'MARCA.............' get MARCA
    @14,40 say date()
    read
    v=fecha_ven-date()
    @15,20 say 'dias de vencimiento'
    @15,50 say v pict '#####'
    x=v/30
    @16,20 say 'meses de vencimiento'
    @16,50 say x pict '#####'
    @20,20 say 'PROVEEDOR.........' get PROVEEDOR
    @21,20 SAY 'OBSERVACIONES.....' get OBSER
    replace CODIGO with COD
    READ
ENDIF
@22,18 SAY 'DESEA OTRA MODIFICACION [S/N]' GET OTRO PICT '!'
READ
IF (UPPER(OTRO))='S' THEN
    LOOP
ELSE
    RETURN
    clear all
CLOSE DATABASE
endif
endDO

VENTAS

CLEAR ALL
SET PROCEDURE TO VENTAS
CLEAR
SELECT 1
use productos
SELECT 2
USE REGISTROS
COD=SPACE(40)
OTRO=SPACE(1)
CA=SPACE(10)
a=space(15)
STORE 0 TO TL
store 0 to tp
store 0 to a
store 0 to B
store 0 to d
@01,03 SAY 'codigo'
@04,01 TO 25,125
@08,05 SAY 'CANTIDAD'
@08,18 SAY 'PRODUCTO'
@08,58 SAY 'PRECIO'
@08,100 SAY 'EXISTENCIAS'
X=09
DO WHILE .T.
SELECT 1
COD=space(5)
    X=X+1
    @05,03 SAY 'CODIGO [PRODUCTO ] ' GET COD  
    READ
        LOCATE FOR COD = codigo
        IF COD = codigo THEN    
          if cantidad <= 0 then
               WAIT WIND 'NO HAY EXISTENCIA'
          ELSE
               STORE 10 TO CA   
               @X,03 GET CA PICT '#########'
               READ       
               @x,15 say producto
               @X,55 SAY precio
               @X,100 SAY CANTIDAD
               IF CA > CANTIDAD THEN
                     CA=SPACE(10)
                     WAIT WIND 'VALOR MAYOR A LA EXISTENCIA'
               ELSE
                     A=PRECIO
                     b=producto
                     d=ca
                     TL=CA*A
                     @X,80 SAY TL PICT '##,###.##'
                      TP=TP+TL
                      c=tp
                     @23,40 say ' Total'
                     @23,80 SAY c PICT '##,###.##'
                         REPLACE CANTIDAD   WITH CANTIDAD-CA
                         SELECT 2
                         APPEND BLANK
                            REPLACE CODIGO     WITH COD
                         REPLACE PRODUCTO   WITH b
                         REPLACE VENTADIN   WITH c
                         replace precio     with a
                         replace cantidad   with d
                         REPLACE FECHA      WITH DATE()
          ENDIF
        ENDIF
        ELSE
            WAIT WIND 'CODIGO NO ASIGNADO'
endif
@23,10 SAY 'OTRO VENTA [S/N]' GET OTRO PICT '!'
READ
IF OTRO = 'S' THEN
    LOOP
ELSE
   return
   SET PROCEDURE TO
   CLEAR ALL
ENDIF
ENDDO


COMPRAS

clear all
clear
DO WHILE .T.
use PRODUCTOS
COD = SPACE(5)
OTRO= SPACE(1)
SN  = SPACE(1)
CA  = SPACE(10)
CLEAR
@02,05 TO 25,125
@03,07 SAY '[COMPRA] DE MEDICAMENTOS'
@05,12 SAY 'CODIGO' GET COD
READ
if cod=space(5) then
    clear
    return
endif
LOCATE FOR COD = CODIGO
IF COD <> CODIGO THEN
    wait wind 'EL PRODUCTO NO EXISTE '
ELSE
    @09,20 say 'PRODUCTO..........'
    @09,45 say  PRODUCTO
    @10,20 say 'EXISTENCIAS.......'
    @10,45 say CANTIDAD
    CA='          '
    @11,20 say 'NUEVA CANTIDAD....' GET CA
    @12,20 say 'PRECIO ...........'
    @12,45 say PRECIO
    @13,20 say 'fecha actual'
    @13,45 say date()
    read
    v=fecha_ven-date()
    @14,20 say 'dias de vencimiento'
    @14,50 say v pict '#####'
    x=v/30
    @15,20 say 'meses de vencimiento'
    @15,50 say x pict '#####'
    @16,20 say 'DISTRIBUIDOR......'
    @16,45 say PROVEEDOR
    @17,20 SAY 'OBSERVACIONES.....'
    @17,45 say OBSER
    replace CODIGO with COD
        T=CA*PRECIO
        @21,20 say 'TOTAL DE LA COMPRA'
        @21,45 SAY T PICT '##,###.##'
        REPLACE CANTIDAD   WITH CANTIDAD+CA
        REPLACE CA         WITH 00000
        REPLACE COMPRA     WITH COMPRA+T
ENDIF
@25,40 SAY ' DESEA RELIZAR OTRA COMPRA [S/N]' GET OTRO PICT '!'
READ
IF OTRO = 'S' THEN
    LOOP
ELSE
    RETURN
ENDIF
CLOSE DATABASE
ENDDO

CONSULTA
CLEAR
do while .t.
use productos
cod=space(5)
OTRO=SPACE(1)
@02,08 to 25,125
@03,10 SAY 'PRODUCTOS [NUEVOS]'
@05,10 Say 'CODIGO' get COD
read
if COD = space(5) then
    clear all
    return
endif
locate for COD = CODIGO
if COD <> CODIGO
    wait wind 'EL PRODUCTO NO EXISTE'
ELSE
    @09,20 say 'DESCRIPCION.......'
    @09,50 say PRODUCTO
    @10,20 say 'PRECIO............'
    @10,50 say PRECIO
    @11,20 say 'CANTIDAD..........'
    @11,50 say CANTIDAD
    @12,20 say 'FECHA VENCIMIENTO.'
    @12,50 say FECHA_VEN
    @13,20 say 'MARCA.............'
    @13,50 say MARCA
    @14,40 say date()
    v=fecha_ven-date()
    @15,20 say 'dias de vencimiento'
    @15,50 say v pict '#####'
    x=v/30
    @16,20 say 'meses de vencimiento'
    @16,50 say x pict '#####'
    @20,20 say 'PROVEEDOR.........'
    @20,50 SAY PROVEEDOR
    @21,20 SAY 'OBSERVACIONES.....'
    @21,50 SAY  OBSER
ENDIF
@22,18 SAY 'DESEA OTRA CONSULTA [S/N]' GET OTRO PICT '!'
READ
IF (UPPER(OTRO))='S' THEN
    LOOP
ELSE
    RETURN
    clear all
CLOSE DATABASE
endif
endDO

EXISTENCIA

CLEAR ALL
DO WHILE .T.
CLEAR
STORE 0 TO TP
    @4,38 TO 21,100
    SVAR001=SPACE(40)
    @08,45 SAY 'IMPRESIONES DE MEDICAMENTOS'
    @11,45 SAY 'A) REFERENCIA INICILES'
    @13,45 SAY 'B) CONTINUAR <ENTER>'
    @16,45 SAY 'OPCION' GET SVAR001
    READ
    CONO=LEN(TRIM(SVAR001))
*        @10,40 TO 13,85
        @5,40 CLEAR TO 20,99
        @6,45 TO 18,90
        @7,51 SAY 'REPORTE DE MEDICAMENTOS'
        @9,50 SAY 'INGRESE LA FORMA DE LISTADO'
*        @17,54 SAY 'USE ESCAPE PARA SALIR'
        @12,58 PROMPT '1-> PANTALLA '
        @14,58 PROMPT '2-> IMPRESORA'
        MENU TO A
    IF A =0
        @6,49 CLEAR TO 18,79
        LOOP
    ENDIF
    IF A= 1
        CLEAR
        USE productos INDEX LISTA3
        @0,00 SAY 'MEDICAMENTO'
        @0,40 SAY 'EXISTENCIA'
        @0,60 say 'proveedor'     
        @1,0 TO 1,79
        POS=2
        TOTAL1=.00
        TOTAL2=.00
        DO WHILE .NOT.EOF()
              IF SUBSTR(PRODUCTO,1,CONO)=TRIM(SVAR001)
                      @POS,00 SAY PRODUCTO
                      @POS,40 SAY cantidad
                      @POS,60 SAY proveedor
                      POS=POS+1
                      TP=TP+CANTIDAD
              ENDIF
        SKIP
       IF POS=22
       N='S'
*       @37,00 SAY 'PRECIO COSTO ASCIENDE A...'
*       @37,35 SAY TOTAL2 PICT '##,###,###.##'
        @39,00 SAY '0=MENU PRINCIPAL CUALQUIER TECLA PARA CONTINUAR..' GET N
        SET COLOR TO
        READ
         IF N='0'
           RETURN
         ENDIF
         POS=2
         LOOP
       ENDIF
    IF EOF()
 *       @37,00 SAY 'PRECIO COSTO ASCIOENDE A...'
 *       @37,35 SAY TOTAL2 PICT '##,###,###,##'
         @38,45 SAY TP PICT '##,###'
        @39,00 SAY '                                           '
        @39,00 SAY 'PRESIONE CUALQUIER TECLA PARA CONTINUAR..'
        SET COLOR TO
        WAIT''
        CLEAR
        CLOSE DATABASE
        CLOSE INDEX
        RETURN
    endif
   ENDDO
  CLEAR
  RETURN
  LOOP
 ENDIF
IF A=2
    clear
    USE AGENDA INDEX LISTA3
    @11,53 SAY 'PREPARE LA IMPRESIONA'
    @12,53 SAY 'PRESIONE CUALQUIER TECLA'
    WAIT''
    clear
    @11,53 SAY 'IMPRIMIENDO....'
    @12,53 SAY '       '
    SET PRINT ON
    SET CONSOLE OFF
    ?CHR(27)+CHR(15)
    POS=0
    HOJA=0
    STORE.00 TO SVAR004
    STORE.00 TO TOTAL1
    STORE 0 TO SVAR004,SVAR005,SVAR006,SVAR007,SVAR008
    DO WHILE.NOT.EOF()
        IF TRIM(SVAR001)=SUBSTR(producto,1,CONO)
    IF POS = 0
    HOJA = HOJA+1
    ?'COLEGIO'
    ?STR(HOJA,4,0)
    ?'FECHA DEL REPORTE'
    ??DATE()
    ?'PRODUCTO                              CANTIDAD    '
*   OCTD         ?
  ENDIF
  ??' '
  ?PRODUCTO
  ??' '
  ?CANTIDAD
  ??' '
  ?
  POS=POS+1
  SKIP
  ELSE
  SKIP
  LOOP
 ENDIF
 IF POS>27
    EJECT
    pos=0
  endif
enddo
*   ?
*   ?'<<<total de precio coste de:>>>'+space(69)
*   ??str(svar004,12,2)
*   ??''
*   ??str(svar005,9,2)
*   ??''
*   ??str(svar006,5,0)
*   ??''
*   ??str(svar007,5,0)
*   ??''
*   ??str(svar008,5,0)
    ?
    ?
    ?chr(27)+'@'
    set print off
    set console on
    close database
    close index
    release all
    clear
   return
  endif
ENDDO

REPORTE DE VENTAS

DO WHILE .T.
CLEAR
STORE 0 TO A
STORE 0 TO B
STORE 0 TO C
STORE 0 TO P
STORE 0 TO E
STORE 0 TO F
STORE 0 TO G
STORE 0 TO H
    @4,38 TO 21,100
    SVAR001=SPACE(40)
    @08,52 SAY 'IMPRESION DE MEDICAMENTOS'
    @11,45 SAY 'A) REFERENCIA INICILES'
    @13,45 SAY 'B) CONTINUAR <ENTER>'
    @16,45 SAY 'OPCION' GET SVAR001
    READ
    CONO=LEN(TRIM(SVAR001))
*        @10,40 TO 13,85
        @5,40 CLEAR TO 20,99
        @6,45 TO 18,90
        @7,51 SAY 'REPORTE DE MEDICAMENTOS'
        @9,50 SAY 'INGRESE LA FORMA DE LISTADO'
*        @17,54 SAY 'USE ESCAPE PARA SALIR'
        @12,58 PROMPT '1-> PANTALLA '
        @14,58 PROMPT '2-> IMPRESORA'
        MENU TO A
    IF A =0
        @6,49 CLEAR TO 18,79
        LOOP
    ENDIF
    IF A= 1
        CLEAR
        USE REGISTROS INDEX LISTA4
        @0,00 SAY 'producto'
        @0,40 SAY 'CANTIDAD'
        @0,63 SAY 'VENTA'
        @0,82 SAY 'X UNIDAD'
        @0,125SAY 'FECHA'
        @1,0 TO 1,150
        POS=2
        TOTAL1=.00
        TOTAL2=.00
        DO WHILE .NOT.EOF()
              IF SUBSTR(PRODUCTO,1,CONO)=TRIM(SVAR001)
                      @POS,00 SAY PRODUCTO
                      @POS,40 SAY cantidad
                      @POS,60 SAY ventadin
                      @POS,80 SAY PRECIO
                      @POS,125SAY FECHA
                      POS=POS+1
                      a=0
                      A=A+cantidad
                      B=B+VENTADIN
                      C=C+PRECIO
              ENDIF
        SKIP
       IF POS=22
       N='S'
*       @37,00 SAY 'PRECIO COSTO ASCIENDE A...'
*       @37,35 SAY TOTAL2 PICT '##,###,###.##'
        @39,00 SAY '0=MENU PRINCIPAL CUALQUIER TECLA PARA CONTINUAR..' GET N
        SET COLOR TO
        READ
         IF N='0'
           RETURN
         ENDIF
         POS=2
         LOOP
       ENDIF
    IF EOF()
 *       @37,00 SAY 'PRECIO COSTO ASCIOENDE A...'
 *       @37,35 SAY TOTAL2 PICT '##,###,###,##'
         @38,40 SAY A PICT '##,###'
         @38,60 SAY B PICT '##,###.##'
         @38,80 SAY C PICT '##,###.##'
        @39,00 SAY 'PRESIONE CUALQUIER TECLA PARA CONTINUAR..'
        SET COLOR TO
        WAIT''
        CLEAR
        CLOSE DATABASE
        CLOSE INDEX
        RETURN
    endif
   ENDDO
  CLEAR
  RETURN
  LOOP
 ENDIF
IF A=2
    clear
    USE registros INDEX LISTA3
    @11,53 SAY 'PREPARE LA IMPRESIONA'
    @12,53 SAY 'PRESIONE CUALQUIER TECLA'
    WAIT''
    clear
    @11,53 SAY 'IMPRIMIENDO....'
    @12,53 SAY '       '
    SET PRINT ON
    SET CONSOLE OFF
    ?CHR(27)+CHR(15)
    POS=0
    HOJA=0
    STORE.00 TO SVAR004
    STORE.00 TO TOTAL1
    STORE 0 TO SVAR004,SVAR005,SVAR006,SVAR007,SVAR008
    DO WHILE.NOT.EOF()
        IF TRIM(SVAR001)=SUBSTR(producto,1,CONO)
    IF POS = 0
    HOJA = HOJA+1
    ?'COLEGIO'
    ?STR(HOJA,4,0)
    ?'FECHA DEL REPORTE'
    ??DATE()
    ?'PRODUCTO                         MERCADERIA         VENTA    P/U     P/M     GANA   FECHA   P/P     D'
*   OCTD         ?
  ENDIF
  ??' '
  ?PRODUCTO
  ??' '
  ?MERCADERIA
   ??' '
  ?VENTADIN
   ??' '
  ?PRECIOUNI
   ??' '
  ?PRECIOMAY
   ??' '
  ?GANA
   ??' '
  ?FECHA
   ??' '
  ?PRECIOPUB
   ??' '
  ?D
  ??' '
  ?
  POS=POS+1
  SKIP
  ELSE
  SKIP
  LOOP
 ENDIF
 IF POS>27
    EJECT
    pos=0
  endif
enddo
*   ?
*   ?'<<<total de precio coste de:>>>'+space(69)
*   ??str(svar004,12,2)
*   ??''
*   ??str(svar005,9,2)
*   ??''
*   ??str(svar006,5,0)
*   ??''
*   ??str(svar007,5,0)
*   ??''
*   ??str(svar008,5,0)
    ?
    ?
    ?chr(27)+'@'
    set print off
    set console on
    close database
    close index
    release all
    clear
   return
  endif
ENDDO

INDEXAR

CLEAR ALL
do while .t.
CLEAR
@03,05 say 'ACTUALIZAR DATOS'FONT'',12
@05,10 PROMPT 'ACTUALIZAR COMPRAS'
@05,32 PROMPT 'ACTUALIZAR VENTAS '
@05,53 prompt 'REGRESAR'
menu to x
do case
    case x=1
        do index
    case x=2
        do index1
    case x=3
        return
endcase
enddo


INDEX

CLEAR ALL
CLEAR
set talk off
SET SAFETY OFF
@11,38 to 17,70
@13,44 say 'Espere unos Minutos'
@14,44 say ' Estamos Indexando'
use productos
INDEX ON PRODUCTO TO LISTA1
REINDEX
use productos
INDEX ON FECHA_VEN TO LISTA2
REINDEX
use productos
INDEX ON cantidad TO LISTA3
REINDEX
do menu


INDEX1

CLEAR ALL
CLEAR
set talk off
SET SAFETY OFF
@10,37 CLEAR TO 18,71
@11,38 to 17,70 double
@13,44 say 'Espere unos Minutos'
@14,44 say ' Estamos Indexando'
use REGISTROS
INDEX ON PRODUCTO TO LISTA4
REINDEX
do menu


VENCE
DO WHILE .T.
CLEAR
    @4,38 TO 21,100
    SVAR001=SPACE(40)
    @08,45 SAY 'IMPRESIONES DE MEDICAMENTOS'
    @11,45 SAY 'A) REFERENCIA INICILES'
    @13,45 SAY 'B) CONTINUAR <ENTER>'
    @16,45 SAY 'OPCION' GET SVAR001
    READ
    CONO=LEN(TRIM(SVAR001))
*        @10,40 TO 13,85
        @5,40 CLEAR TO 20,99
        @6,45 TO 18,90
        @7,55 SAY 'FECHAS < DE 3 MESE'
        @9,50 SAY 'INGRESE LA FORMA DE LISTADO'
*        @17,54 SAY 'USE ESCAPE PARA SALIR'
        @12,58 PROMPT '1-> PANTALLA '
        @14,58 PROMPT '2-> IMPRESORA'
        MENU TO A
    IF A =0
        @6,49 CLEAR TO 18,79
        LOOP
    ENDIF
    IF A= 1
        CLEAR
        USE productos INDEX LISTA1       
        @0,00 SAY 'MEDICAMENTO'
        @0,40 SAY 'VENCIMIENTO'
        @0,60 SAY 'EXISTENCIA'
        @1,0 TO 1,79
        POS=2
        TOTAL1=.00
        TOTAL2=.00
        DO WHILE .NOT.EOF()
              IF SUBSTR(PRODUCTO,1,CONO)=TRIM(SVAR001)
                      A=FECHA_VEN-DATE()
                       IF A<90 THEN
                      @POS,00 SAY PRODUCTO
                      @POS,40 SAY FECHA_VEN
                      @POS,60 SAY cantidad
                      POS=POS+1
                    ENDIF
            ENDIF
        SKIP
       IF POS=22
       N='S'
*       @37,00 SAY 'PRECIO COSTO ASCIENDE A...'
*       @37,35 SAY TOTAL2 PICT '##,###,###.##'
        @39,00 SAY '0=MENU PRINCIPAL CUALQUIER TECLA PARA CONTINUAR..' GET N
        READ
         IF N='0'
           RETURN
         ENDIF
         POS=2
         LOOP
       ENDIF
    IF EOF()
 *       @37,00 SAY 'PRECIO COSTO ASCIOENDE A...'
 *       @37,35 SAY TOTAL2 PICT '##,###,###,##'
        @39,00 SAY '                                           '
        @39,00 SAY 'PRESIONE CUALQUIER TECLA PARA CONTINUAR..'
        SET COLOR TO
        WAIT''
        CLEAR
        CLOSE DATABASE
        CLOSE INDEX
        RETURN
    endif
   ENDDO
  CLEAR
  RETURN
  LOOP
 ENDIF
IF A=2
    CLEAR
    USE AGENDA INDEX LISTA2
    @11,53 SAY 'PREPARE LA IMPRESIONA'
    @12,53 SAY 'PRESIONE CUALQUIER TECLA'
    WAIT''
    CLEAR
    @11,53 SAY 'IMPRIMIENDO....'
    @12,53 SAY '       '
    SET PRINT ON
    SET CONSOLE OFF
    ?CHR(27)+CHR(15)
    POS=0
    HOJA=0
    STORE.00 TO SVAR004
    STORE.00 TO TOTAL1
    STORE 0 TO SVAR004,SVAR005,SVAR006,SVAR007,SVAR008
    DO WHILE.NOT.EOF()
        IF TRIM(SVAR001)=SUBSTR(PRODUCTO,1,CONO)
    IF POS = 0
    HOJA = HOJA+1
    ?'FARMACIA JIREH'
    ?STR(HOJA,4,0)
    ?'FECHA DEL REPORTE'
    ??DATE()
    ?'MEDICAMENTO               FECHA DE VENCIMIENTO'
*   OCTD         ?
  ENDIF
  ?producto
  ??' '
  ?fechaven
  ??' '
  ?
  POS=POS+1
  SKIP
  ELSE
  SKIP
  LOOP
 ENDIF
 IF POS>27
    EJECT
    pos=0
  endif
enddo
*   ?
*   ?'<<<total de precio coste de:>>>'+space(69)
*   ??str(svar004,12,2)
*   ??''
*   ??str(svar005,9,2)
*   ??''
*   ??str(svar006,5,0)
*   ??''
*   ??str(svar007,5,0)
*   ??''
*   ??str(svar008,5,0)
    ?
    ?
    ?chr(27)+'@'
    set print off
    set console on
    close database
    close index
    release all
    clear
   return
  endif
ENDDO




No hay comentarios:

Publicar un comentario