Pascal/Turbo Pascal - problema con ficheros

 
Vista:
sin imagen de perfil
Val: 4
Ha aumentado su posición en 4 puestos en Pascal/Turbo Pascal (en relación al último mes)
Gráfica de Pascal/Turbo Pascal

problema con ficheros

Publicado por Cristina (3 intervenciones) el 05/03/2019 22:01:16
Hola a todos:
Mi duda es la siguiente:
Después de realizar un programa durante varias actividades, he llegado a un punto que me he quedado bloqueada. Os pongo el programa completo y luego os cuento donde tengo el problema.


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
Program Compra_2;
Const
	TAMMAXCESTA = 4;
 
Type
	Producto = record
		Nombre : string;
		Unidades : integer;
		Precio : real;
		En_cesta : boolean;
	End;
 
	Cesta = array [0..TAMMAXCESTA] of producto;
	Tfichero = file of producto;
 
Var
	micesta : cesta;
	opcion: char;
	nombre: string;
 
Procedure lee_producto (var Compra:producto);
Begin
	compra.en_cesta:= true;
	Write ('Producto: ');
	readln (compra.nombre);
	write ('Precio por unidad: ');
	readln (compra.precio);
	write ('Cuantas unidades desea?: ');
	readln (compra.unidades);
	writeln;
End;
 
Procedure Escribe_Producto (var Compra: producto);
Begin
	writeln;
	writeln ('El producto seleccionado es: ', compra.nombre);
	writeln ('Cada unidad tiene un precio de; ', compra.precio:0:2);
	writeln ('Unidades solicitadas; ', compra.unidades);
	writeln ('El subtotal es: ', compra.unidades * compra.precio:0:2);
End;
 
Procedure inicializa_cesta (var micesta:cesta);
var
	i: integer;
Begin
	For i:= 0 to TAMMAXCESTA do
		micesta[i].en_cesta:= false;
End;
 
Procedure Mostrar_producto (micesta: cesta);
Var
	i: integer;
	contador: integer;
	articulo: string;
Begin
	contador := 0;
	write ('Indique el producto que desea consultar: ');
	readln (articulo);
	for i:= 1 to TAMMAXCESTA do
	Begin
		if articulo = micesta[i].nombre then
		Begin
			Escribe_Producto (micesta[i]);
			contador := contador + 1;
		End;
	end;
	if contador = 0 then
		writeln ('No existe ningun producto que coincida con su eleccion');
 
end;
 
Procedure mostrar_cesta (micesta: cesta);
Var
	i: integer;
Begin
	for i:= 1 to TAMMAXCESTA do
	begin
		writeln ('Campo  ', i, ':');
		If micesta[i].en_cesta = true then
		begin
			Escribe_Producto (micesta[i]);
			writeln;
		end
		else
		begin
			writeln ('Campo vacio');
			writeln;
		end;
	end;
	If micesta[i].en_cesta = false then
	begin
		write ('LA CESTA ESTA VACIA');
		writeln;
	end;
 
End;
 
Procedure cuenta_productos (micesta: cesta);
var
	i:integer;
	Num_productos: integer;
	contador : integer;
Begin
	contador:= 0;
	Num_productos := 0;
	For i:= 1 to TAMMAXCESTA do
	Begin
		If micesta[i].en_cesta = true then
		Begin
			contador := contador + 1
		End;
	End;
	Num_productos := contador;
	writeln ('El numero de productos en su cesta es: ', Num_productos);
	writeln;
End;
 
Procedure busca_libre (micesta: cesta ;var pos: integer);
var
	i : integer;
	contador :integer;
Begin
	contador:= 0;
	pos := 1;
	for i:= TAMMAXCESTA downto 1 do
	Begin
		If micesta[i].en_cesta = false then
		Begin
			pos := i;
			contador := contador + 1;
		End;
	End;
End;
 
Procedure incluir_producto_en_cesta (var micesta:cesta);
var
	pos : integer;
Begin
	busca_libre (micesta, pos);
	if micesta[pos].en_cesta = false then
		lee_producto (micesta[pos])
	else
		writeln ('LA CESTA ESTA LLENA');
		writeln;
 
end;
 
Procedure buscar_producto (micesta: cesta;VAR pos: integer);
var
	nombre: string;
	contador,i: integer;
Begin
	contador := 0;
	write ('Introduzca producto a buscar: ');
	readln (nombre);
	For i:= 1 to TAMMAXCESTA do
	Begin
		if nombre = micesta[i].nombre  then
			begin
				pos := i;
				contador := contador + 1;
			end;
	End;
	If contador = 0 then
		pos := 0;
End;
 
Procedure eliminar_producto_de_cesta (var micesta: cesta);
var
	pos: integer;
Begin
	writeln ('<<<<< ELIMINAR PRODUCTO >>>>>');
	buscar_producto (micesta,pos);
	if pos = 0 then
	begin
		writeln ('No se encuentra el producto');
		writeln;
	end
	else
	begin
		micesta[pos].en_cesta := false;
		writeln ('El campo ', pos, ' ha sido borrado');
		writeln;
	end;
End;
 
Procedure modificar_producto (var micesta:cesta);
var
	pos: integer;
	opcion : integer;
Begin
	writeln ('<<<<< MODIFICAR PRODUCTO >>>>>');
	writeln;
	buscar_producto (micesta, pos);
	If pos = 0 then
		writeln ('No se encuentra el producto')
	else
	begin
		writeln ('<<<< MENU DE OPCIONES >>>>');
		writeln;
		writeln ('1: Nombre del producto');
		writeln ('2: Precio por unidad');
		writeln ('3: Numero de unidades solicitadas');
		writeln ('4: Todos los campos');
		writeln;
		write ('Introduzca la opcion deseada: ');
		readln (opcion);
		Case (opcion) of
			1: begin write ('Producto: ');readln (micesta[pos].nombre); writeln; end;
			2: begin write ('Precio por unidad: '); readln (micesta[pos].precio); writeln; end;
			3: begin write ('Cuantas unidades desea?: '); readln (micesta[pos].unidades); writeln; end;
			4: begin micesta[pos].en_cesta:= false; incluir_producto_en_cesta (micesta); end;
			else
				writeln ('Opcion incorrecta');
		end;
	end;
end;
 
Procedure Guardar_Cesta (var micesta:cesta; nombre:string);
var
	fichero: Tfichero;
	i: integer;
Begin
	Assign (Fichero, nombre);
	rewrite (fichero);
	For i:= 0 to TAMMAXCESTA do
	Begin
		if micesta[i].en_cesta = true then
			write (Fichero, micesta[i]);
	End;
	Close (fichero);
End;
 
Procedure Recupera_Cesta (var micesta:cesta; nombre: string);
var
	i: integer;
	fichero: Tfichero;
Begin
	i:=0;
	Assign (fichero, nombre);
	Reset (fichero);
	while (not eof (fichero)) and (i< TAMMAXCESTA) do
	begin
		i:= i+1;
		read (fichero, micesta[i]);
	end;
	close (fichero);
end;[/b]
 
Procedure Calcula_Pedido (Var micesta: cesta);
var
	i: integer;
	Suma_unidades: integer;
	Suma_cesta : real;
	fecha: string;
Begin
	suma_unidades := 0;
	suma_cesta := 0;
	for i:=1 to TAMMAXCESTA do
	begin
		if micesta[i].en_cesta = true then
		begin
			Suma_unidades:= Suma_unidades + micesta[i].unidades;
			micesta[0].unidades:= suma_unidades;
			suma_cesta:= suma_cesta + (micesta[i].unidades * micesta[i].precio);
			micesta[0].precio := suma_cesta;
		end;
	end;
	write('Introduzca la fecha (dd/mm/aaaa): ');
	readln (fecha);
	writeln;
	micesta[0].nombre:= fecha;
	writeln ('<<<<< RESUMEN DE SU COMPRA >>>>>');
	writeln ('La fecha de realizacion del pedido es: ', micesta[0].nombre);
	writeln ('La cesta contiene un total de  ', micesta[0].unidades, ' productos');
	writeln ('El importe total de la cesta es: ', micesta[0].precio:0:2);
	writeln;
	micesta[0].en_cesta := true;			(*Cesta cerrada*)
end;
 
 
 
Begin
	write ('<<<<< BIENVENIDO A SU TIENDA >>>>>');
	writeln;
	repeat
		writeln ('Estas son las opciones disponibles');			writeln ('>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<');
		writeln ('A: Abrir Cesta de la Compra Existente');
		writeln ('B: Comenzar cesta nueva');
		writeln ('C: Nuevo producto');
		writeln ('D: Eliminar producto');
		writeln ('E: Guardar cesta');
		writeln ('F: Pedir cesta');
		writeln ('G: Finalizar pedido');
		writeln ('H: Modificar cesta');
		writeln ('I: Salir del programa');
		writeln;
			write ('Seleccione una opcion: ');
			readln (opcion);
			case (opcion) of
				'a','A': Begin write ('Introduzca el nombre de la cesta: '); readln (nombre); Recupera_Cesta(micesta,nombre); end;
				'b','B': inicializa_cesta (micesta);
				'c','C': Begin
							if micesta[0].en_cesta = false then
								incluir_producto_en_cesta (micesta)
							else
							begin
								writeln ('EL PEDIDO YA HA SIDO FINALIZADO. CESTA CERRADA');
								writeln;
							end;
						 End;
				'd','D': Begin
							if micesta[0].en_cesta = false then
								eliminar_producto_de_cesta (micesta)
							else
							Begin
								writeln ('EL PEDIDO YA HA SIDO FINALIZADO. CESTA CERRADA');							writeln;
							End;
						 end;
				'e','E': Begin write ('Introduzca el nombre de la cesta: '); readln(nombre); Guardar_Cesta(micesta,nombre); end;
				'f','F': mostrar_cesta (micesta);
				'g','G': Calcula_Pedido(micesta);
				'h','H': Begin
							If micesta[0].en_cesta= false then
								modificar_producto (micesta)
							else
							Begin
								writeln ('EL PEDIDO YA HA SIDO FINALIZADO. CESTA CERRADA');
								writeln;
							end;
						 end;
				'i','I': writeln ('Salir')
				Else
					writeln ('Opcion incorrecta');
			end;
 
	until (opcion = 'i') or (opcion = 'I');
End.


Mi problema está en el PROCEDURE RECUPERA_CESTA. Veréis, durante todo el programa la posición '0' del array 'micesta' ha permanecido vacío. En una de las actividades pedían que esa posición fuese ocupada con ciertos datos (Ver procedure Calcula_Pedido), tras ese ejercicio pedían modificar los procedimientos de 'Guardar_cesta' y 'Recupera_cesta', para que guardaran, también, los datos en esta posición '0'. Con el procedimiento 'guardar_cesta' no he tenido problema (creo), pero no sé como modificar el procedimiento 'recuperar_cesta' para que almacene también esa posición. Muchas gracias de antemano.
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
sin imagen de perfil
Val: 4
Ha aumentado su posición en 4 puestos en Pascal/Turbo Pascal (en relación al último mes)
Gráfica de Pascal/Turbo Pascal

problema con ficheros

Publicado por Cristina (3 intervenciones) el 07/03/2019 22:27:54
Ok, ya lo he resuelto, En realidad tenía mal los dos procedimientos.
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

problema con ficheros

Publicado por Angela (2 intervenciones) el 19/03/2019 11:04:20
Hola, Cristina!
¿como has resulto problema? Puedes enseñarlo?
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