FoxPro/Visual FoxPro - Sistema de con base de datos

   
Vista:

Sistema de con base de datos

Publicado por Micki mg7_94@hotmail.com (9 intervenciones) el 30/10/2013 17:57:53

Alguien me puede ayudar con esta codificafcion, me sale error en MODIFICAR DATOS y en ELIMINAR



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
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
SET EXACT ON
SET STAT OFF
SET ECHO OFF
SET CENTURY ON
SET DATE TO DMY
DO WHILE .T.
    CLEAR ALL
    CLEAR
TITMENU = "<<<<<MENU PRINCIPAL>>>>>"
@ 0,0 SAY TITMENU
@ 1,0 SAY REPLICATE ("=",LEN(TITMENU))
@ 3,0 PROMPT "(1)Ingresar Datos"
@ 4,0 PROMPT "(2)Consultar Datos"
@ 5,0 PROMPT "(3)Modificar Datos"
@ 6,0 PROMPT "(4)Eliminar Datos"
@ 7,0 PROMPT "(5)Imprimir Datos"
@ 8,0 PROMPT "(6)Salir del Programa"
	 MENU TO OPC
	 IF LASTKEY()=27
	       LOOP
	 ELSE
	     DO CASE
	 CASE OPC=1
	 DO INGDATOS
	 CASE OPC=2
	 DO CONSDATOS
	 CASE OPC=3
	 DO MODIFDATOS
	 CASE OPC=4
	 DO ELIMDATOS
	 CASE OPC=5
	 DO IMPRIDATOS
	 CASE OPC=6
	      CANCEL
    ENDCASE
  ENDIF
ENDDO
 
******************
PROCEDURE ingdatos
******************
 
CLEAR ALL
DO WHILE .T.
       CLEAR
       USE "C:\Program Files\Microsoft Visual Studio\Vfp98\datpers.dbf"
       SCATTER MEMVAR BLANK
       GO BOTTOM
       IDAUX = RECCOUNT()
       IF IDAUX=0
               IDAUX=1
               M.iddatos=IDAUX
               IDAUX=IDAUX+1
       ELSE
               GO RECNO()
               IDAUX=iddatos
               M.iddatos=IDAUX+1
               IDAUX=IDAUX+1
      ENDIF
      IF LASTKEY()=27
              RETURN
      ELSE
              TITING="<<<<<INGRESAR DATOS>>>>>"
              @ 0,0 SAY TITING
              @ 1,0 SAY REPLICATE("=",LEN(TITING))
              @ 3,0 SAY "Id Datos"
      	      @ 4,0 SAY "Nombre"
              @ 5,0 SAY "Apellido Paterno"
              @ 6,0 SAY "Apellido Materno"
              @ 7,0 SAY "Edad"
              @ 8,0 SAY "D.N.I."
              @ 9,0 SAY "Fecha de Nacimiento"
              @ 3,17 SAY ":"
              @ 4,17 SAY ":"
              @ 5,17 SAY ":"
              @ 6,17 SAY ":"
              @ 7,17 SAY ":"
              @ 8,17 SAY ":"
              @ 9,17 SAY ":"
              M.fec_nac=ctod('/')
              @ 3,19 SAY m.iddatos
              @ 4,19 GET m.nombre PICT "@!" VALID !EMPTY(m.nombre)
              @ 5,19 GET m.ap_pat PICT "@!" VALID !EMPTY(m.ap_pat)
              @ 6,19 GET m.ap_mat PICT "@!" VALID !EMPTY(m.ap_mat)
              @ 7,19 GET m.edad PICT "99" VALID !EMPTY(m.edad)
              @ 8,19 GET m.dni VALID !EMPTY(m.dni)
              @ 9,19 GET m.fec_nac VALID !EMPTY(m.fec_nac)
              READ
              IF LASTKEY()=27
          			  RETURN
              ENDIF
              RPTA1=SPACE(1)
              @ 11,5 SAY "¿Datos Correctos?(S/N):"get rpta1 PICT "!" valid rpta1 $ "SN"
       		  READ
              IF RPTA1=UPPER("S")
                      APPE BLANK
                      GATHER MEMVAR
                      RPTA2=SPACE(1)
                      @ 13,5 SAY "¿Ingresar otro Registro?(S/N):"GET RPTA2 PICT "!" VALID RPTA2 $ "SN"
                      READ
                      IF RPTA2=UPPER("s")
                 			  LOOP
                      ELSE
                              RETURN
                      ENDIF
               ELSE
                      LOOP
               ENDIF
       ENDIF
ENDDO
CLOSE DATABASES
CLOSE ALL
 
*******************
procedure consdatos
*******************
 
use "C:\Program Files\Microsoft Visual Studio\Vfp98\datpers.dbf"
index on ap_mat tag apmat
       clear
            do while .t.
            apellido=SPACE(40)
            @ 3,0 say "Id Datos"
            @ 4,0 say "Nombre"
            @ 5,0 say "Apellido Paterno"
            @ 6,0 say "Apellido Materno" GET apellido
            @ 7,0 say "Edad"
            @ 8,0 say "D.N.I."
            @ 9,0 say "Fecha Nacimiento"
            @ 3,17 say ":"
            @ 4,17 say ":"
            @ 5,17 say ":"
            @ 6,17 say ":"
            @ 7,17 say ":"
            @ 8,17 say ":"
            @ 9,17 say ":"
            READ
            GO TOP
            locate for ALLTRIM(ap_mat)=ALLTRIM(apellido)
            brow
            =inkey(0)
            if apellido=SPACE(40) or lastkey()=27
            		RETURN
            ENDIF
         	apellido=UPPER(apellido)
         	locate for UPPER(ap_mat)=UPPER(apellido)
         	browse noedit fields ap_mat: H="Nombre",ap_pat: H="Apellido Paterno", edad: H="Edad", dni: H="DNI", fec_nac: H="Fecha Nacimiento";
         	IF.NOT.FOUND()
         		 =MESSAGEBOX("El apellido no se encuentra.")
         		 LOOP
         	ENDIF
         	@ 3,19 GET iddatos font "arial" style "B"
         	@ 4,19 GET nombre
         	@ 5,19 GET ap_pat
         	@ 7,19 GET Edad
 
         	@ 8,19 GET dni
         	@ 9,19 GET fec_nac
         	READ
         	STORE 1 TO OP
         	@ 16,33 PROMPT "SI"
         	@ 16,36 PROMPT "NO"
         	menu to op
         	if op=1
         	      * LOOP
         	      ?"stop"
         	else
         	      return
         	endif
      enddo
endproc
 
********************
procedure modifdatos
********************
 
clear all
use "C:\Program Files\Microsoft Visual Studio\Vfp98\datpers.dbf"
do while .t.
	  clear
	  titmodif="<<<<<<<<MODIFICAR DATOS>>>>>>>>"
	  @ 0,0 say titmodif
	  brow noedit fields
iddatos:H="Numero",nombre:H="Nombre",ap_pat:H="Apellido paterno",ap_mat:H="Apellido materno",edad:H="Edad",dni:H="DNI",fec_nac:H="Fecha Nacimiento",
       title "Modificar datos(ESC para seleccionar registro a modicar)"
       if lastkey()=27
                @ 3,0 say "Id Datos"
                @ 4,0 say "Nombre"
                @ 5,0 say "Apellido paterno"
                @ 6,0 say "Apellido materno" get ap_mat
                @ 7,0 say "Edad"
                @ 8,0 say "D.N.I."
                @ 9,0 say "Fecha nacimiento"
                @ 3,17 say ":"
                @ 4,17 say ":"
                @ 5,17 say ":"
                @ 6,17 say ":"
                @ 7,17 say ":"
                @ 8,17 say ":"
                @ 9,17 say ":"
                @ 3,19 get iddatos
                clear gets
                @ 4,19 get nombre
                @ 5,19 get ap_pat
                @ 6,19 get ap_mat
                @ 7,19 get edad
                @ 8,19 get dni
                @ 9,19 get fec_nac
                read
         endif
         rptamod=space(1)
         @ 11,5 say "Deseaa modificar otro registro (S/N):" get rptamod pict "!" valid rptamod$ "SN"
         read
         if rptamod=upper("s")
         		 loop
         else
         		 close all
         		 close databases
         		 return
         endif
enddo
*******************
PROCEDURE elimdatos
*******************
 
clear all
use "C:\Program Files\Microsoft Visual Studio\Vfp98\datpers.dbf"
do while .t.
      clear
      titelim="<<<<<<<<ELIMINAR REGISTROS>>>>>>>>"
      @ 0,0 say titelim
      browse noedit fields
iddatos:H="número",nombre:H="Nombre",ap_pat:H="Apellido paterno",;ap_mat:H="Apellido materno";edad:H="Edad",dni:H="DNI",fec_nac:H="Fecha Nacimiento";
       title "Eliminar registros (ESC para seleccionar registro a eliminar)"
       if lastkey()=27
      		    @ 3,0 say "ID Datos"
                @ 4,0 say "Nombre"
                @ 5,0 say "Apellido paterno"
                @ 6,0 say "Apellido materno"
                @ 7,0 say "Edad"
                @ 8,0 say "D.N.I."
                @ 9,0 say "Fecha nacimiento"
                @ 3,17 say ":"
                @ 4,17 say ":"
                @ 5,17 say ":"
                @ 6,17 say ":"
                @ 7,17 say ":"
                @ 8,17 say ":"
                @ 9,17 say ":"
                @ 3,19 get iddatos
                @ 4,19 get nombre
                @ 5,19 get ap_pat
                @ 6,19 get ap_mat
                @ 7,19 get edad
                @ 8,19 get dni
                @ 9,19 get fec_nac
                clear gets
         endif
         store space(1) to rptax,rptaelim
         @ 11,5 say "¿Eliminar registro? (S/N):" get rptax pict "!" valid rptax$ "SN"
         read
         if lastkey()=27
                 return
         else
                 delete
                 pack
                 @ 11,5 say "Registro fue eliminado de la base de datos... Pulse cualquier tecla para continuar..."
                 =inkey(0)
                 @ 11,5 clear to 12, wcols()-5
                 @ 11,5 say "Desea eliminar otro registro (S/N):" get rptaelim pict "!" valid rptaelim$ "SN"
                 read
                 if rptaelim=upper("s")
                         loop
                 else
                         close all
                         close databases
                         return
                 endif
        endif
enddo
 
********************
procedure impridatos
********************
 
clear all
use "C:\Program Files\Microsoft Visual Studio\Vfp98\datpers.dbf"
clear
define windows printing from 5,5 to 12,57 title "IMPRIMIR REGISTROS"
activate windows printing
		@ 1,1 say "Alerta:VERIFIQUE QUE LA IMPRESORA ESTE ENCENDIDA"
		@ 3,4 prompt "Salida por pantalla"
		@ 3,25 prompt "Salida por impresora"
		menu to salida
		if lastkey()=27
		        return
		endif
		do case case
		       case salida=1
		               deactivate windows printing
		               do porpantalla
		       case salida=2
		               deactivate windows printing
		               do porimpresora
		end case
deactivate windows printing
 
******************
procedure cabezera
******************
 
clear
titimprimir="<<<<<<<<REPORTE>>>>>>>>"
@ 0,(wcols()-len(titimprimir)/2 say titimprimir
@ 1,0 say replicate ("=",wcols())
@ 2,2 say "N°" font "Arial narrow",9
@ 2,6 say "Nombre" font "Arial narrow",9
@ 2,28 say "Apellido paterno" font "Arial narrow",9
@ 2,62 say "Apellido materno" font "Arial narrow",9
@ 2,96 say "Edad" font "Arial narrow",9
@ 2,102 say "DNI" font "Arial narrow",9
@ 2,110 say "Fecha nacimiento" font "Arial narrow",9
@ 3,0 say replicate ("=",wcols())
 
*********************
procedure porpantalla
*********************
 
do cabecera
use "C:\Program Files\Microsoft Visual Studio\Vfp98\datpers.dbf"
linea=4
go top
set device to screen
do while !eof()
       @ linea,0 say iddatos font "Arial narrow", 9
       @ linea,6 say nombre font "Arial narrow", 9
       @ linea,28 say ap_pat font "Arial narrow", 9
       @ linea,62 say ap_mat font "Arial narrow", 9
       @ linea,97 say edad font "Arial narrow", 9
       @ linea,101 say dni font "Arial narrow", 9
       @ linea,112 say fec_nac font "Arial narrow", 9
       skip
       linea=linea+1
       if linea=20
               @ 2,15 say "Pulse una tecla para continuar"
               =inkey(0)
               linea=4
               @ linea,0 clear to 22, wcols()
               loop
       endif
enddo
=inkey(0)
 
**********************
procedure porimpresora
**********************
 
clear
linea=5
go top
do while !eof()
       set device to printer
       titimprimir="<<<<<<<<REPORTE>>>>>>>>"
       @ 0,(wcols()-len(titimprimir)/2 say titimprimir font "Arial", 9
       @ 1,0 say replicate("=",wcols())
       @ 2,2 say "say "" font "Arial narrow",9
       @ 2,6 say "Nombre" font "Arial narrow",9
       @ 2,28 say "Apellido paterno" font "Arial narrow",9
       @ 2,62 say "Apellido materno" font "Arial narrow",9
       @ 3,62 say "Edad" font "Arial narrow",9
       @ 3,67 say "DNI" font "Arial narrow",9
       @ 3,76 say "Fecha nacimiento" font "Arial narrow",9
       @ 4,0 say replicate ("=",wcols())
       do while !eof()
              * @ 0,0 say chr(15) Para borrado de bufer en impresora antiguas
              @ linea,0 say iddatos font "Arial narrow", 9
              @ linea,6 say nombre font "Arial narrow", 9
       		  @ linea,28 say ap_pat font "Arial narrow", 9
              @ linea,62 say ap_mat font "Arial narrow", 9
              linea=linea+1
              @ linea,62 say edad pict "999" font "Arial narrow", 9
              @ linea,67 say dni font "Arial narrow", 9
              @ linea,76 say fec_nac font "Arial narrow", 9
              linea=linea+1
              @ linea,0 say replicate("=",wcols())
              skip
              linea=linea+1
              if linea>33
                      linea=5
                      eject
                      exit
              endif        
              loop
       enddo  
       if linea>33
               loop
       endif
enddo
set printer to 
set device to screen     
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

Sistema de con base de datos

Publicado por Fidel José (558 intervenciones) el 30/10/2013 22:11:54
Por lo que puede verse, estás haciendo un programa en Visual Fox 6.0 utilizando una codificación de Fox 2.0 (o anterior). Eso lo deduzco de la ruta "C:\Program Files\Microsoft Visual Studio\Vfp98\".
Digo lo siguiente:
1) Si necesitas ayuda, empieza por consignar cuáles son los mensajes de error.
2) No has oido hablar de formularios y controles, de programación orientada a objetos?.
3) Dices "Base de Datos" pero te estás refiriendo a una tabla dbf.
4) Haz colocado la tabla en una carpeta en la que no deberías guardar nada, excepto lo que el mismo generador de Fox coloca ahí. Debes crear tu propia carpeta para las aplicaciones, con sus subcarpetas. Y mejor comenzar por confiar en que Visual Fox genere un proyecto con las carpetas necesarias. Luego le agregas las carpetas que necesites.
5) @ say es una codificación obsoleta (ya lo era en la versión 6.0), aunque aún se utiliza para impresoras matriciales con secuencia de escape. Para las pantallas, se utilizan formularios. Para los impresos, se utilizan los reportes (aunque en la versión 6.0 son bastante malos). En los listados para impresoras laser o deskjet, si no quieres utilizar report, se usan los ? / ?? porque permiten asignar los tipos y tamaño de letra de manera bastante eficiente.
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