FoxPro/Visual FoxPro - Controlar grid

close data

CLEAR

set help off

set refre to 1,5

SET SAFE OFF

set dele on

****set message to "Presione F3: Borrar Linea-F10: Confirmar facturas-ESC: Volver al Menu"

**** Apertura de Tablas e Indices

sele 1

use articulos order codart

clear

* Creacion del Cursor facturas (Tabla temporal) para la carga de la facturas

Create CURSOR facturas (CODART C(6),descrip c(40),importe n(8,2),cantid n(3),;

subtot n(8,2),ESTADO C(2))

* Agrega un Reg. en blanco al cursor para empezar a cargar los datos

appen blank

* Se establece la relacion entre el Codigo de Articulo cargado en el cursor

* y la tabla de Articulos

set relation to CODART into ARTICULOS

* Definicion de las funcionalidades de las teclas especiales F1 a F12,

* ESC, PGDN y DNARROW

on key label f1 do AYUDINSUMO

on key label f2 keyb ""

on key label f3 do borrali

on key label f4 keyb ""

on key label f5 keyb ""

on key label f6 keyb ""

on key label f7 keyb ""

on key label f8 keyb ""

on key label f9 keyb ""

ON KEY LABEL F10 DO CONFIRMA

ON KEY LABEL F11 keyb ""

ON KEY LABEL F12 keyb ""

ON KEY LABEL ESC DO SALE

ON KEY LABEL PGDN DO PAGABAJO

ON KEY LABEL DNARROW DO BAJALI

DEFINE POPUP AYUINS FROM 10.5,11 TO 25,89 PROMPT FIELD CODINS+SPACE(5)+DESCRIP TITLE "Ayuda de Articulos" SCROLL MESSA "Seleccione un Articulo" IN SCREEN

ON SELECTION POPUP AYUART DEAC POPUP AYUART

ON KEY LABEL F1 DO AYUDART

@ 38,1 SAY "Presione <F1>: Ayuda Articulos - <F3>: Borrar Linea - <F10>: Confirma Factura - <ESC>: Vuelve Menu"

DEFI WIND FABIO AT 0,0 TO 20,99 title "Carga de Articulos de la Factura" COLOR b+/w*

MOVE WIND FABIO CENTER

acti wind fabio

XTOTAL=0

SALI='NO'   && Usada para permanencia en el browse

XULTREG = 1  && Variable que indica el ultimo reg. de la facturas(cursor)

XBORRADO = 'NO'  && Indica si algun registro de facturas fue eliminado

XCONFIRMA='NO'  && En SI indica la confirmacion de la facturas

DO WHILE SALI='NO'

   BROW FIELD CODINS :h='Código' :v=VCODART() :f,DESCRIP :h='Descripción' :w=.f.,;

              IMPORTE :h=' $ ' :v=vimpor() :f,;

              CANTID :h='Kg-Lts' :v=vcantid() :f,;

              SUBTOT :h='Subtotal ' :w=.F.,;

              ESTADO :h='Estado' :w=.F. IN WIND FABIO

   IF XBORRADO='SI'

      =CAMBIO()

   ENDIF

   IF XCONFIRMA='SI'

      EXIT

   ENDIF

ENDDO

IF XCONFIRMA='SI'

   DO CARGA

ENDIF

set help on

on key

rele wind fabio

CLEAR

return

PROCEDURE AYUART

 IF VARREAD()="CODART"

	ON KEY

    SELE ARTICULOS

    SET ORDER TO DESCRIP

    SELECT * FROM ARTICULOS INTO CURSOR TABLART ORDER BY DESCRIP

    IF _TALLY>0

      ACTI POPUP AYUART

      CODART=LEFT(PROMPT(),6)

      IF EMPTY(CODART)

         repla FACTURAS.CODART="     0"

      ENDIF

      REPLA FACTURAS.CODART WITH CODART

    ELSE

      set escape off

      WAIT WIND "Archivo Vacio" TIMEOUT 2

    ENDIF

 ENDIF

 SELE FACTURAS

 SET ORDER TO CODART

 on key label f1 do AYUDART

 on key label f2 keyb ""

 on key label f3 do borrali

 on key label f4 keyb ""

 on key label f5 keyb ""

 on key label f6 keyb ""

 on key label f7 keyb ""

 on key label f8 keyb ""

 on key label f9 keyb ""

 ON KEY LABEL F10 DO CONFIRMA

 ON KEY LABEL F11 keyb ""

 ON KEY LABEL F12 keyb ""

 ON KEY LABEL ESC DO SALE

 ON KEY LABEL PGDN DO PAGABAJO

 ON KEY LABEL DNARROW DO BAJALI

 SELE FACTURAS

 SET ESCAPE ON

RETURN

Procedure borrali

   DELETE

   XBORRADO='SI'

   KEYB '{CTRL+Q}'  && Envia al buffer del teclado las pulsaciones CTRL+Q

return

procedure agregali

append blank

XULTREG = RECNO()

return .T.

PROCE VCODINS

* Si la funcion EXISTE() devuelve 'NO' es que el codigo ingresado no existe 

* en el cursor.

IF EXISTE()='NO' 

   IF eof('ARTCULOS')  && Si ARTICULO esta en Eof, es porque el codigo ing. no existe

      IF !empty(CODART)

         wait wind 'Codigo no existe '

         RETURN .F.

      ELSE

         IF RECNO()=XULTREG AND INLIST(LAST(),4,19,9,13)

               RETURN .F.

         ENDIF

      ENDIF

   ELSE

         repla descrip with ARTICULOS.descrip, subtot with cantid*importe

         RETUR .T.

   ENDIF

ELSE

   ********  CUANDO YA EXISTE EL ARTICULO CARGADO NO BORRA ***

   WAIT WIND 'Ya Existe'

   RETURN .f.

ENDIF

proce Vimpor

PUSH KEY CLEAR  && Desactiva los valores ON KEY LABEL

IF !EOF('ARTICULOS')

   IF EMPTY(IMPORTE)

      set escape off

      WAIT WIND 'Debe especificar Importe'

      POP KEY   && Restaura los valores ON KEY LABEL

      RETURN .F.

   ELSE

 	  IF IMPORTE<=0

 	     WAIT WIND 'No se permiten Valores Negativos'

 	     POP KEY

 	     RETURN .F.

 	  ENDIF

   ENDIF

ELSE

ENDIF

set escape on

pop key

proce Vcantid

PUSH KEY CLEAR  && Desactiva los valores ON KEY LABEL

IF !EOF('ARTICULOS')

   IF EMPTY(CANTID)

      set escape off

      WAIT WIND 'Debe especificar Cantidad '

      POP KEY   && Restaura los valores ON KEY LABEL

      RETURN .F.

   ELSE

      IF CANTID <=0

      	WAIT WIND 'NO se permiten Valores Negativos'

      	POP KEY

      	RETURN .F.

      ENDIF

         repla subtot with cantid*importe,ESTADO WITH 'OK'

         =SUMAR()

         POP KEY

         RETURN ACCION()

   ENDIF

ELSE

ENDIF

set escape on

pop key

PROCE EXISTE

* Subrutina que permite verificar si algun codigo de articulo ya se encuentra

* cargado en la facturas

XCOD=CODART

SELE CODART,COUNT(*) AS CANCOD FROM facturas WHERE CODART=XCOD INTO CURSOR PP

IF PP.CANCOD > 1

   WAIT WIND 'Codigo ya cargado, se sugiere modificar Cantidad'

   KEYB '{CTRL+Q}'

   XX='SI'

ELSE

   XX='NO'   

ENDIF

SELE  facturas

RETURN XX

PROCE SALE

SALI = 'SI'

XCONFIMRA="NO"

KEYB '{CTRL+Q}'

rele wind fabio

rele wind carga

on key

RETURN

PROCE SALE2

SALI = 'SI'

XCONFIMRA="NO"

KEYB '{CTRL+Q}'

rele wind cargafac

on key

RETURN

PROCE ACCION

IF RECNO()<XULTREG and estado='OK'

   SKIP

   RETURN .T.

ELSE

   IF RECNO()=XULTREG

      APPEND BLANK

      XULTREG=RECNO()

      KEYB '{DNARROW}'

      RETURN .T.

   ENDIF

ENDIF

RETURN

PROCE BAJALI

IF RECNO()=XULTREG-1 AND ESTADO='OK'

   IF UPPE(VARR())='CANTID'

      KEYB '{TAB}'

   ENDIF

   SKIP

   RETURN .T.

ELSE

   IF RECNO()=XULTREG

       RETURN .F.

   ELSE

       =ACCION()

   ENDIF

ENDIF

RETURN

PROCE PAGABAJO

IF UPPE(VARR())='CANTID' 

   KEYB '{TAB}'

ENDIF

GO BOTT

RETURN .T.

PROCE CAMBIO

SELE * FROM facturas INTO CURSOR AUXI

SELE facturas

ZAP

IF _TALLY > 0

   SELE AUXI

   SCAN

      SCATTER MEMVAR

      INSER INTO facturas FROM MEMVAR

   ENDSCAN

   SELE facturas

else

   SELE facturas

   APPEND BLANK

ENDIF

=SUMAR()

GO BOTT

XULTREG=RECNO()

RETURN

PROCE CONFIRMA

XCONFIRMA='SI'

IF XTOTAL>0

   KEYB '{CTRL+Q}'

ELSE

   WAIT WIND "No se cargan facturas sin valor..."

   CONFIRMA='NO'   

ENDIF

RETURN