FoxPro/Visual FoxPro - FUNCION DO foxpro 2.6

   
Vista:

FUNCION DO foxpro 2.6

Publicado por cc_arlos cc_arlos@yahoo.es (8 intervenciones) el 06/04/2016 00:48:58
Hola buenas tardes quisiera saber si alguien me puede ayudar mi problema es el siguiente.

estoy trabajando en un programa hecho en foxpro 2.6 y tengo el siguiente problema que no hay modo que arregle.

bueno este es un ejemplo de lo que quiero hacer abajo dejare el codigo real por si tiene algun problema mi codigo.

1ro. TENGO UN PROGRAMA base.prg que hace consulta en otros 2 programas base1.prg y base2.prg

2do el principal es base.prg

En este mando a llamar al base1.prg de la siguiente manera.

DO base1 WITH '21', 'valor' &&LO HACE SIN PROBLEMAS

3ro en base1.prg

ahora mando a llamar al tercer programa de la siguiente manera

DO base2.prg &&AQUI YA NO PUEDE ACCEDER MI PROGRAMA base1.prg

4to si llamo desde el principal al base2.prg SI funciona.


si alguien me puede ayudar muchas gracias!!!

CODIGO REAL!!
base.prg
1
DO IngreChe WITH '21',2,filas2,cheque 

IngreChe.prg

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
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

llista.prg
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
**-- 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
Valora esta pregunta
Me gusta: Está pregunta es útil y esta claraNo me gusta: Está pregunta no esta clara o no es útil
0
Responder
Imágen de perfil de Mauricio Antonio

FUNCION DO foxpro 2.6

Publicado por Mauricio Antonio (1367 intervenciones) el 08/04/2016 16:02:16
ya lo puedes usar......
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar

FUNCION DO foxpro 2.6

Publicado por cc_arlos (8 intervenciones) el 08/04/2016 20:20:57
Gracias por la respuesta...

Cual fue mi error?
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar

FUNCION DO foxpro 2.6

Publicado por cc_arlos (8 intervenciones) el 08/04/2016 21:05:28
bueno comento porque la pregunta de cual es mi error en este caso.

Logre solucionar el problema de la siguiente manera.

en la base.prg

el codigo es muy largo la cosa es que en una linea donde guarda la informacion a un dbf esta de estructura de la siguiente manera.

1
2
3
4
SELECT 22 &&credito
USE
SELECT 22
USE ChVista INDEX ChVista1,ChVista2,ChVista3,ChVista4&&,ChVista5,ChVista6

esto devido a que segun lei solo se puede declarar 26 dbf al inicio y de esa manera poder utilizar otra en este caso ChVista.dbf

el error del DO me lo daba luego del USE ChVista y ello por utilizar 6 INDICES.. es algo que no me explico para nada ya que hay otras dbf que utilizo y utiliza hasta 8 indices y no da error.

El problema que tendre ahora es que los indices Chvista5 y chvista6 no se me actualizaran =( lo deje asi por el momento.

pero quiero agradecer de nuevo la ayuda!!
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar
Imágen de perfil de Mauricio Antonio

FUNCION DO foxpro 2.6

Publicado por Mauricio Antonio (1367 intervenciones) el 08/04/2016 21:17:35
Pero en base.prg no tienes esto:
SELECT 22 &&credito
USE
SELECT 22
USE ChVista INDEX ChVista1,ChVista2,ChVista3,ChVista4&&,ChVista5,ChVista6
*
el posible error no es por indices.
una buena forma de abrir tablas es asi:
USE chVista IN 0 ORDER chVista4
usando IN 0 te permite abrir tablas sin cerrar ninguna, que creo era el error que te daba, pero por no dar el codigo completo no me dio ningun error.
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
1
Comentar

FUNCION DO foxpro 2.6

Publicado por cc_arlos (8 intervenciones) el 09/04/2016 00:03:45
entiendo. Gracias!!
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar