Sistema de con base de datos
Publicado por Micki (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=1DO INGDATOS
CASE OPC=2DO CONSDATOS
CASE OPC=3DO MODIFDATOS
CASE OPC=4DO ELIMDATOS
CASE OPC=5DO IMPRIDATOS
CASE OPC=6CANCEL
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=1M.iddatos=IDAUX
IDAUX=IDAUX+1
ELSE
GO RECNO()
IDAUX=iddatosM.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_nacREAD
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 titmodifbrow 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 iddatosclear 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_nacread
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 titelimbrowse 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_nacclear 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=1deactivate windows printing
do porpantalla
case salida=2deactivate 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=4go 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=5go 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 "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
@ 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=5eject
exit
endif
loop
enddo
if linea>33loop
endif
enddo
set printer to
set device to screen
Valora esta pregunta
0