FoxPro/Visual FoxPro - FUNCION DO foxpro 2.6

DO IngreChe WITH '21',2,filas2,cheque 

PARAMETERS qbanco,qorder,qfilas,qmonto

	libre=' '

	SAVE SCREEN TO pantal

		clear

		DO llista WITH libre

		READ

	RESTORE SCREEN FROM pantal

SAVE SCREEN TO p_previa

SET DELIMITER OFF

SET COLOR TO w/n

@09,01 clear to 23,78

@09,01 to 23,78 color bg+/n

@10,02 to 10,77 color bg/bg

@10,02 say '#Cheque' color w+/bg

@10,15 say 'Valor'color w+/bg

@10,27 say 'Banco'color w+/bg

@10,48 say 'Fecha Cheque'color w+/bg

@10,63 say 'Fecha Dep¢sito'color w+/bg

@11,02 to 11,77 color bg+/n

@10,14 to 22,14 color bg/n &&valor

@10,26 to 22,26 color bg/n &&banco

@10,47 to 22,47 color bg/n &&fecha cheque

@10,62 to 22,62 color bg/n &&fecha depo.

*********************************************************************

FOR i=1 TO qfilas

	arregloche(i,1)=0

	arregloche(i,2)=0

	arregloche(i,3)=0

	arregloche(i,4)=DATE()

	arregloche(i,5)=DATE()

endfor

*********************************************************************

pos=1

lxx=12

procesox=1

finaliza=10

SET color TO gr+/b

DO WHILE procesox<finaliza

	DO case

		CASE procesox=1

			DO procesox1

		CASE procesox=2

			DO procesox2

		CASE procesox=3

			DO procesox3

		CASE procesox=4

			DO procesox4

		CASE procesox=5

			DO procesox5

		CASE procesox=6

			DO procesox6

	endcase

ENDDO

SET COLOR to gr+/b

*!*	RESTORE SCREEN from p_previa

*!*	SET DELIMITER OFF

*!*	SET INTENSITY OFF

SET DELIMITER OFF

RESTORE SCREEN from p_previa

*? SYS(2002,1)

SET INTENSITY ON

FOR i=1 TO qfilas

	abonoche=abonoche+arregloche(i,2)

ENDFOR

RETURN

PROCEDURE procesox1&&numero de cheque

DO WHILE .t.

	@lxx,02 get arregloche(pos,1) pict '9999999999' 

	READ

	IF readkey()=12 .or. readkey()=268 && ESC

		WAIT WINDOWS 'presino tecla ESC'

		procesox=finaliza

		return

	ENDIF

	IF readkey()=4 .or. readkey()=260 && ARRIBA

		IF pos>1

			pos=pos-1

			lxx=lxx-1

			loop

		endif

	ENDIF

	IF readkey()=5 .or. readkey()=261 && FLECHA ABAJO

		procesox=2

		return

	ENDIF

	IF arregloche(pos,1)<=0

		loop

	endif

	procesox=2

	exit

ENDDO

PROCEDURE procesox2&&valor del cheque

DO WHILE .t.

	arregloche(pos,2)=qmonto

	@lxx,15 get arregloche(pos,2) pict '999,999.99'

	READ

	IF readkey()=4 .or. readkey()=260 && FLECHA ARRIBA

		procesox=1

		return

	ENDIF

	IF readkey()=5 .or. readkey()=261 && FLECHA ABAJO

		procesox=3

		return

	ENDIF

	IF readkey()=12 .or. readkey()=268 && ESC

		procesox=1

		return

	ENDIF

	IF arregloche(pos,2)<=0

		loop

	endif

	procesox=3

	exit

ENDDO

PROCEDURE procesox3&&banco

DO WHILE .t.

	@lxx,27 get arregloche(pos,3) pict '999'

	READ

	IF readkey()=4 .or. readkey()=260 && FLECHA ARRIBA

		procesox=2

		return

	ENDIF

	IF readkey()=5 .or. readkey()=261 && FLECHA ABAJO

		procesox=4

		return

	ENDIF

	IF readkey()=12 .or. readkey()=268 && ESC

		procesox=1

		return

	ENDIF

	IF readkey()=36 .or. readkey()=292

		nombanc=' '

		codiban=0

		DO BuscaCheq

        *DO conban WITH dbBanco,codiban,nombanc

        arregloche(pos,3)=codiban

        loop

        SET COLOR TO gr+/b

	ENDIF

	IF arregloche(pos,3)=0

		WAIT WINDOW 'Debe ingresar codigo de banco'

		loop

	ENDIF

	SELECT &qbanco&&Banco

	SET ORDER TO 1

	SEEK '1'+gempre+STR(arregloche(pos,3),3)

	IF !found()

		WAIT WINDOW 'Codigo de banco no existe'

		loop

	ELSE

		nombanc=nomban_b

		@lxx,32 say SUBSTR(nombanc,1,15) color gr+/n

	ENDIF

	procesox=4

	exit

ENDDO

PROCEDURE procesox4 &&fecha cheque

DO WHILE .t.

	@lxx,48 SAY arregloche(pos,4) color gr+/b+&&

*	READ

	IF readkey()=4 .or. readkey()=260 && FLECHA ARRIBA

		procesox=3

		return

	ENDIF

	IF readkey()=5 .or. readkey()=261 && FLECHA ABAJO

		procesox=5

		return

	ENDIF

	IF readkey()=12 .or. readkey()=268 && ESC

		procesox=1

		return

	ENDIF

	procesox=5

	exit

ENDDO

PROCEDURE procesox5

DO WHILE .t.

	@lxx,63 get arregloche(pos,5)

	READ

	IF readkey()=4 .or. readkey()=260 && FLECHA ARRIBA

		procesox=3

		return

	ENDIF

	IF readkey()=5 .or. readkey()=261 && FLECHA ABAJO

		procesox=6

		return

	ENDIF

	IF readkey()=12 .or. readkey()=268 && ESC

		procesox=1

		return

	ENDIF

	procesox=6

	exit

ENDDO

PROCEDURE procesox6

DO WHILE .t.

	IF pos<qfilas

		pos=pos+1

		lxx=lxx+1

	ELSE

		pos=1

		lxx=12

	endif

	procesox=1

	exit

ENDDO

PROCEDURE BuscaCheq

*PARAMETERS PCODIGO,PDESCRI,PSELE

SET DELIMITER OFF

SAVE SCREEN TO conunid

SET COLOR TO W

@ 07,23,19,53 BOX REPLICATE(CHR(219),9)  && Û  CUADRO

SET COLOR TO W+/BG

@ 08,24 CLEAR TO 18,52

SET COLOR TO GR+/W

@ 07,27 SAY 'CONSULTA DE BANCOS'

@ 19,28 SAY '<ESC>=Seleccionar'

@ 08,30 TO 18,30 COLOR W/BG &&BG

px=8

SELECT  &qbanco &&&PSELE  &&  dbf bancos

SET ORDER TO qorder

SEEK '1'+GEMPRE

IF FOUND()

    ? SYS(2002)

    SET INTENSITY OFF

    akuanto=0

    sale=0

    DO WHILE .NOT. EOF() .AND. empresa_e=GEMPRE .AND. sale=0

		SET COLOR TO W+/BG

        @ px,26 SAY codigo_b PICT '999'

        @ px,33 SAY nomban_b

        SKIP

        akuanto=akuanto+1

        px=px+1

        IF px>17 .OR. EOF() .OR. empresa_e#GEMPRE

            entra=.F.

            IF EOF() .OR. empresa_e#GEMPRE

                entra=.T.

            ENDIF

            SKIP -1

            fin=RECNO()

            SKIP -(akuanto-1)

            regis=RECNO()

            x=1

            px=8

            DO WHILE .T.

                SET COLOR TO GR+/B+

		        @ px,26 SAY codigo_b PICT '999'

		        @ px,33 SAY nomban_b

                SET COLOR TO W/BG

                copcion=' '

                SET COLOR TO N/N

                @ 18,64 GET copcion PICT '!'

                READ

                SET COLOR TO W+/BG

                tecla=READKEY()

                DO CASE

                    CASE tecla=4 .OR. tecla=260 && flecha arriba

                		SET COLOR TO W+/BG

				        @ px,26 SAY codigo_b PICT '999'

				        @ px,33 SAY nomban_b

                        px=px-1

                        x=x-1

                        SKIP -1

                        IF x<=0

                            x=1

                            px=8

                            GO regis

                        ENDIF

                    CASE tecla=5 .OR. tecla=261  && flecha abajo

                		SET COLOR TO W+/BG

				        @ px,26 SAY codigo_b PICT '999'

				        @ px,33 SAY nomban_b

                        px=px+1

                        x=x+1

                        SKIP

                        IF x>akuanto

                            x=akuanto

                            px=7+akuanto

                            GO fin

                        ENDIF

                    CASE tecla=12 .OR. tecla=268  &&  ESC

                        &&pcodigo=codigo_b

                        &&pdescri=nomban_b

						nombanc=nomban_b

						codiban=codigo_b

                        sale=1

                        EXIT

                    CASE tecla=270   &&  CTRL-W

                        sale=1

                        EXIT

                	CASE tecla=6 .OR. tecla=262  && PAGINA ARRIBA

						@ 08,24 CLEAR TO 18,52

						@ 08,30 TO 18,30 COLOR W/BG

    	                px=8

        	            akuanto=0

            	        SKIP -9

                	    IF BOF() .OR. empresa_e#GEMPRE

   	                        SEEK '1'+GEMPRE

            	        ENDIF

	                    EXIT

    	            CASE tecla=7 .OR. tecla=263  && PAGE DOWN

						@ 08,24 CLEAR TO 18,52

						@ 08,30 TO 18,30 COLOR W/BG

                        px=8

                        akuanto=0

                        IF entra

                            SEEK '1'+GEMPRE

                        ELSE

                            GO fin

                        ENDIF

                        EXIT

                ENDCASE

            ENDDO

        ENDIF

    ENDDO

ELSE

    @ 13,19 SAY 'No Existe Informacion...Presione [ENTER]'

    READ

ENDIF

SET DELIMITER OFF

RESTORE SCREEN FROM conunid

? SYS(2002,1)

SET INTENSITY ON

**-- Pregunta esta lista la impresora -**

@ 06,01 TO 06,78

@ 19,01 TO 19,78

@ 07,06 TO 18,72

@ 09,10 TO 16,68

SET COLOR TO W/BG

horiz=SPACE(59)

verti=' '

@ 08,10 SAY horiz

@ 17,10 SAY horiz

x=9

DO WHILE x<17

    @ x,8 SAY verti

    x=x+1

ENDDO

x=9

DO WHILE x<17

   @ x,70 SAY verti

   x=x+1

ENDDO

SET COLOR TO W/N

*libre=' '

DO WHILE libre#'S' .AND. libre#'N'

    @ 06,01 TO 06,78

    @ 19,01 TO 19,78

    @ 10,15 TO 14,63

    @ 11,17 SAY 'Antes de Proceder con la Impresion ,Verifique'

    @ 12,17 SAY 'que la impresora este  debidamente conectada,'

    @ 13,17 SAY 'que la alimentacion del Papel Sea Correcta ..'

    @ 15,19 SAY 'Esta Lista la Impresora  (S/N) .. ' GET libre PICT '!'

    READ

ENDDO

SELECT 22 &&credito

USE

SELECT 22

USE ChVista INDEX ChVista1,ChVista2,ChVista3,ChVista4&&,ChVista5,ChVista6