Pascal/Turbo Pascal - FICHERO BINARIO

   
Vista:

FICHERO BINARIO

Publicado por oscar (64 intervenciones) el 18/11/2012 15:37:19
Hola chicos, me urge bastante, como casi siempre pero es que ya acabe todas las practicas que tenia que hacer pero me han reportado una y es que no es exactamente como la tengo como habia que hacerla os paso enunciado y lo que yo hice, a ver si podeis mirarla y decirme como tengo q ponerlo, gracias mil como siempre!!

supongo q es pq no lo hice definiendo el fichero binario que seria del tipo “file of..” y las consiguientes modificaciones, a ver si me decis como quedaria entonces…GRACIAS

Defina un fichero binario en el que cada elemento del fichero sea de tipo Producto.

Codifique un procedimiento (guarda_cesta) que guarda todos los productos de una cesta de la compra, que se pasa como parámetro, en un fichero cuyo nombre también se pasa como parámetro.

Tenga en cuenta que salvo el producto que ocupa la posición cero (que como ya veremos tiene un significado especial) todos los demás están en la cesta sólo si el campo en_cesta=TRUE, si este campo es FALSE no necesitamos, por tanto, guardar ese producto en el fichero.

2.

Codifique un procedimiento (recupera_cesta) que lea de un fichero de elementos de tipo producto, cuyo nombre se pasa como parámetro JUNTO CON OTROS QUE CONSIDERE NECESARIO, todos los productos que tenga almacenados y los guarde en una variable del tipo cesta que también se pasa como parámetro. Asegúrese de que no se sobrepasarán los límites de la cesta intentando introducir más de TAMMAXCESTA.

3.

Codifique un módulo principal en el que reutilizando los resultados de cuestiones y actividades anteriores (procedimientos de lectura y escritura de ficheros, presentación, modificación de datos de una cesta…), se muestre al usuario el menú y se ejecuten las acciones pertinentes a cada opción.
Tenga en cuenta que si el usuario elige:
1. Abrir cesta de compra existente: se preguntará al usuario el nombre de la cesta (que será el nombre del fichero que la contiene).
2. Comenzar cesta de compra nueva: se creará una cesta desde cero.
5. Guardar cesta: se pedirá al usuario el nombre del fichero donde guardar la cesta.
6. Pedir cesta: se mostrará la cesta actual.
7. Salir del programa: se terminará la ejecución del programa

OS DEJO MI CODIGO

program registrocesta;

uses
crt;

const
tammaxcesta = 5;

type
regcesta = record
nombre : string;
numero : integer;
precio : real;
en_cesta : boolean;
end;
producto = array[0..tammaxcesta] of regcesta;

var
cesta : array[1..10] of producto;
nn:integer;
nu:integer;
cont : integer;
tec : char;

procedure lee_producto(ces, n : integer);
var
r : integer;
rd : char;
begin
repeat
clrscr;
writeln(‘ Entrada Cesta Numero : ‘,n);
writeln;
write(‘ Introduce Nombre Producto : ‘);
readln(cesta[ces][n].nombre);
write(‘ Introduce Cantidad : ‘);
readln(cesta[ces][n].numero);
write(‘ Introduce Precio Unidad : ‘);
readln(cesta[ces][n].precio);
cesta[ces][r].en_cesta := true;
writeln;
writeln(‘ Desea introducir mas Productos en La Cesta [S/N]‘);
repeat
rd := upcase(readkey);
until rd in['S','N'];
if rd = ‘S’ then
n := n + 1;
until (n > tammaxcesta) or (rd = ‘N’);
if n > tammaxcesta then
begin
clrscr;
writeln(‘**** Fin De Entradas Pulse una tecla ****’);
end;
end;

procedure inicializa_cestas(ces : integer);
var
i : integer;
begin
if ces > 10 then
begin
writeln(‘ Excedido Numero de Cestas. Pulsar [Enter]‘);
readln;
end
else
begin
for i := 0 to tammaxcesta do
begin
cesta[ces][i].en_cesta := false;
cesta[ces][i].nombre := ‘ ‘;
end;
clrscr;
writeln(‘Cesta Inicializada. Pulse una tecla’);
readln;
end;
end;

procedure mostrar_productos(pro : integer);
var
y:integer;
d : integer;
begin
clrscr;
if cont > 1 then
begin
y := 3;
writeln(‘Nombre de Producto , Numero de Productos y Precio’);

for d := 1 to tammaxcesta do
begin
if cesta[pro][d].nombre = ‘ ‘ then
begin
end
else
begin
writeln(cesta[pro][d].nombre);
writeln(cesta[pro][d].numero);
writeln(cesta[pro][d].precio:0:2);
y := y + 1;
end;
end;
end
else
writeln(‘ La Cesta esta Vacia. Pulsar [Enter] ‘);
readln;
end;

procedure mostrar_cesta(ces : integer);
var
p : integer;
begin
clrscr;
write(‘ Introduzca Posicion a Visualizar : ‘);
readln(p);
if (p ‘ ‘) then
begin
if cont > 1 then
begin
writeln(‘Nombre:’);
writeln(cesta[ces][p].nombre);
writeln(‘Numero De Productos:’);
writeln(cesta[ces][p].numero);
writeln(‘Precio’);
writeln(cesta[ces][p].precio:0:2);
writeln;
writeln(‘Pulse [Enter] ‘);
end
else
writeln(‘La Cesta Esta Vacia. Pulse una tecla ‘);
readln;
end;
end;

function cuenta_productos(ddd : integer) : integer;
var
b:integer;
c : integer;
begin
c := 0;
for b := 1 to tammaxcesta do
if cesta[ddd][b].en_cesta = true then
c := c + 1;
cuenta_productos := c;
end;

function busca_libre(lll : integer) : integer;
var
c:integer;
vv : integer;
begin
c := 0;
for vv := 1 to tammaxcesta do
if cesta[lll][vv].en_cesta = false then
begin
c := vv;
break;
end;
if c > 0 then
begin
busca_libre := c;
end
else
begin
busca_libre := 0;
end;
end;

procedure incluir_producto_en_cesta;
var
n, gg : integer;
begin
writeln(‘ Introduzca Numero Cesta : ‘);
readln(n);
gg := busca_libre(n);
lee_producto(n,gg);

end;

begin
cont := 1;
repeat
clrscr;
writeln(‘ ***** Menu ***** ‘);
writeln;
writeln(‘ 1 : Iniciar una Cestas’);
writeln(‘ 2 : Rellenar Una Cesta ‘);
writeln(‘ 3 : Mostrar Todos los Productos de Una Cesta’);
writeln(‘ 4 : Mostrar Un Productos de la Cesta’);
writeln(‘ 5 : Nuevo Producto En Cesta’);
writeln(‘ 6 : Salir’);
writeln;
writeln(‘ <<>>’);
repeat
tec := readkey;
until tec in['1','2','3','4','5','6'];
case tec of
’1&#8242; : begin write(‘ Cesta Numero : ‘); readln(nn); inicializa_cestas(nn); end;
’2&#8242; : begin lee_producto(cont,1); cont := cont + 1; end;
’3&#8242; : begin write(‘ Cesta Numero : ‘); readln(nn); mostrar_productos(nn); end;
’4&#8242; : begin
clrscr;
write(‘ Introduce el Numero de Cesta : ‘);
readln(nu);
if (nu > tammaxcesta) or (cont < 1) then
begin
clrscr;
writeln('Error de Numero o Cesta Vacia. Pulse una tecla');
readln;
exit;
end
else
mostrar_cesta(nu);
end;
'5' : incluir_producto_en_cesta;
end;
until tec = '6';
end.
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
información
Otras secciones de LWP con contenido de Pascal/Turbo Pascal
- Código fuente de Pascal/Turbo Pascal
- Cursos de Pascal/Turbo Pascal
- Temas de Pascal/Turbo Pascal
- Chat de Pascal/Turbo Pascal
información
Códigos de Pascal/Turbo Pascal
- Simular windows95
- Bingo
- Music Maker

FICHERO BINARIO

Publicado por romon (2072 intervenciones) el 18/11/2012 16:54:00
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
{Es tu programa con los arreglos necesarios revisarlo y ponlo a tu manera}
 
program registrocesta;
 
uses
crt;
 
const
tammaxcesta = 5;
tamreg = 10;
 
type
regcesta = record
nombre : string;
numero : integer;
precio : real;
en_cesta : boolean;
end;
producto = array[0..tammaxcesta] of regcesta;
 
var
cesta : array[1..tamreg] of producto;
nn:integer;
n, nu:integer;
cont : integer;
tec : char;
fich : file of producto;
prese : producto;
nombe : string;
 
procedure lee_producto(ces, n : integer);
var
r : integer;
rd : char;
begin
repeat
clrscr;
writeln(' Entrada Cesta Numero : ',n);
writeln;
write(' Introduce Nombre Producto : ');
readln(cesta[ces][n].nombre);
write(' Introduce Cantidad : ');
readln(cesta[ces][n].numero);
write(' Introduce Precio Unidad : ');
readln(cesta[ces][n].precio);
cesta[ces][r].en_cesta := true;
writeln;
writeln(' Desea introducir mas Productos en La Cesta [S/N]');
repeat
rd := upcase(readkey);
until rd in['S','N'];
if rd = 'S' then
n := n + 1;
until (n > tammaxcesta) or (rd = 'N');
if n > tammaxcesta then
begin
clrscr;
writeln('**** Fin De Entradas Pulse una tecla ****');
end;
end;
 
procedure inicializa_cestas(ces : integer);
var
i : integer;
begin
if ces > tamreg then
begin
writeln(' Excedido Numero de Cestas. Pulsar [Enter]');
readln;
end
else
begin
for i := 0 to tammaxcesta do
begin
cesta[ces][i].en_cesta := false;
cesta[ces][i].nombre := ' ';
end;
clrscr;
writeln('Cesta Inicializada. Pulse una tecla');
readln;
end;
end;
 
procedure mostrar_productos(pro : integer);
var
y:integer;
d : integer;
begin
clrscr;
if cont > 1 then
begin
y := 3;
writeln('Nombre de Producto , Numero de Productos y Precio');
 
for d := 1 to tammaxcesta do
begin
if cesta[pro][d].nombre = ' ' then
begin
end
else
begin
writeln(cesta[pro][d].nombre);
writeln(cesta[pro][d].numero);
writeln(cesta[pro][d].precio:0:2);
y := y + 1;
end;
end;
end
else
writeln(' La Cesta esta Vacia. Pulsar [Enter] ');
readln;
end;
 
procedure mostrar_cesta(ces : integer);
var
p : integer;
begin
clrscr;
write(' Introduzca Posicion a Visualizar : ');
readln(p);
if (p = 0) or (p > tamreg) then
begin
if cont > 1 then
begin
writeln('Nombre:');
writeln(cesta[ces][p].nombre);
writeln('Numero De Productos:');
writeln(cesta[ces][p].numero);
writeln('Precio');
writeln(cesta[ces][p].precio:0:2);
writeln;
writeln('Pulse [Enter] ');
end
else
writeln('La Cesta Esta Vacia. Pulse una tecla ');
readln;
end;
end;
 
function cuenta_productos(ddd : integer) : integer;
var
b:integer;
c : integer;
begin
c := 0;
for b := 1 to tammaxcesta do
if cesta[ddd][b].en_cesta = true then
c := c + 1;
cuenta_productos := c;
end;
 
function busca_libre(lll : integer) : integer;
var
c:integer;
vv : integer;
begin
c := 0;
for vv := 1 to tammaxcesta do
if cesta[lll][vv].en_cesta = false then
begin
c := vv;
break;
end;
if c > 0 then
begin
busca_libre := c;
end
else
begin
busca_libre := 0;
end;
end;
 
procedure incluir_producto_en_cesta;
var
n, gg : integer;
begin
writeln(' Introduzca Numero Cesta : ');
readln(n);
gg := busca_libre(n);
lee_producto(n,gg);
end;
 
 procedure guarda_cesta(nomb : string; ct : producto);
 var
    gua : integer;
 begin
     assign(fich,nomb);
  {$I-} reset(fich); {$I+}
    if ioresult <> 0 then
    begin
       rewrite(fich);
       seek(fich,0);
       write(fich, ct);
       close(fich);
    end
 else
     begin
        seek(fich,filesize(fich));
        write(fich, ct);
        close(fich);
     end;
  end;
 
  procedure recupera_cesta(nomb : string);
  var
    nom : string;
    i : integer;
    bus : longint;
    encont : boolean;
   begin
       assign(fich,nomb);
   {$I-} reset(fich); {$I+}
      if ioresult <> 0 then
      begin
 
      end
    else
       begin
          write('  Entre nombre Producto : ');
          readln(nom);
          bus := 0;
          encont := false;
        repeat
           seek(fich,bus);
           read(fich,prese);
           for i := 1 to tammaxcesta do
           begin
           if prese[i].nombre = nom then
           begin
               encont := true;
           end;
          end;
            if encont = false then
            bus := bus + 1;
        until (bus > filesize(fich) - 1) or (encont = true);
        close(fich);
       end;
   end;
 
 
begin
cont := 1;
repeat
clrscr;
writeln(' ***** Menu ***** ');
writeln;
writeln(' 1 : Iniciar una Cestas');
writeln(' 2 : Rellenar Una Cesta ');
writeln(' 3 : Mostrar Todos los Productos de Una Cesta');
writeln(' 4 : Mostrar Un Productos de la Cesta');
writeln(' 5 : Nuevo Producto En Cesta');
writeln(' 6 : Guardar Cesta');
writeln(' 7 : Recupera Cesta');
writeln(' 8 : Salir');
writeln;
writeln(' << Elija Opcion >>');
repeat
tec := readkey;
until tec in['1','2','3','4','5','6','7','8'];
case tec of
'1' : begin write(' Cesta Numero : ');
      readln(nn);
      inicializa_cestas(nn);
     end;
'2': begin lee_producto(cont,1);
           cont := cont + 1;
         end;
'3' : begin write(' Cesta Numero : ');
            readln(nn);
            mostrar_productos(nn);
          end;
'4' : begin
      clrscr;
       write(' Introduce el Numero de Cesta : ');
       readln(nu);
      if (nu > tammaxcesta) or (cont < 1) then
      begin
         clrscr;
          writeln('Error de Numero o Cesta Vacia. Pulse una tecla');
          readln;
          exit;
      end
   else
      mostrar_cesta(nu);
  end;
 '5' : incluir_producto_en_cesta;
 '6' : begin
       write('  Entre Nombre Archivo y Extension : ');
       readln(nombe);
       write(' Entre Num. Posicion : ');
       readln(n);
       if n > tamreg then
       n := tamreg;
       guarda_cesta(nombe,cesta[n]);
       end;
 '7' : begin
       write('  Entre Nombre Archivo y Extension : ');
       readln(nombe);
       recupera_cesta(nombe);
       end;
     end;
    until tec = '8';
   end.
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

FICHERO BINARIO

Publicado por oscar (64 intervenciones) el 19/11/2012 20:51:49
gracias por la respuesta
el mostar Un producto no me funciona del todo bien, lo demas perfecto, 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

FICHERO BINARIO

Publicado por ramon (2072 intervenciones) el 19/11/2012 23:16:10
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
{Mira este punto creo debería de iniciar en 0  for d := 1 to tammaxcesta do  ya que  producto = array[0..tammaxcesta] of regcesta; empieza por 0}
 
procedure mostrar_productos(pro : integer);
var
y:integer;
d : integer;
begin
clrscr;
if cont > 1 then
begin
y := 3;
writeln('Nombre de Producto , Numero de Productos y Precio');
 
for d := 1 to tammaxcesta do
begin
if cesta[pro][d].nombre = ' ' then
begin
end
else
begin
writeln(cesta[pro][d].nombre);
writeln(cesta[pro][d].numero);
writeln(cesta[pro][d].precio:0:2);
y := y + 1;
end;
end;
end
else
writeln(' La Cesta esta Vacia. Pulsar [Enter] ');
readln;
end;
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

FICHERO BINARIO

Publicado por oscar (64 intervenciones) el 19/11/2012 23:48:35
Si, eso lo revise y asi lo cambie pero nada
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

FICHERO BINARIO

Publicado por oscar (64 intervenciones) el 20/11/2012 21:23:12
Me puedes corregir lo que tengo mal por favor?gracias..
ademas en abrir compra de cesta existente tiene q ser : se preguntará al usuario el nombre de la cesta (que será el nombre del fichero que la contiene).
el codigo

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
program registrocesta;
 
uses crt;
 
const
tammaxcesta = 5;
tamreg = 10;
 
type regcesta = record
	nombre : string;
	numero : integer;
	precio : real;
	en_cesta : boolean;
end;
 
producto = array[0..tammaxcesta] of regcesta;
 
var
cesta : array[1..tamreg] of producto;
nn:integer;
n, nu:integer;
cont : integer;
tec : char;
fich : file of producto;
prese : producto;
nombe : string;
 
 
procedure lee_producto(ces, n : integer);
var
r : integer;
rd : char;
begin
 repeat
	clrscr;
	writeln(' Introduzca Entrada Cesta Numero : ',n);
	writeln; write(' Introduzca Nombre Producto : ');
	readln(cesta[ces][n].nombre);
	write(' Introduzca Cantidad : ');
	readln(cesta[ces][n].numero);
	write(' Introduzca Precio Unidad : ');
	readln(cesta[ces][n].precio);
	cesta[ces][r].en_cesta := true;
	writeln;
	writeln(' Desea introducir mas Productos en La Cesta [S/N]');
 repeat
    rd := upcase(readkey);
until rd in['S','N'];
  if rd = 'S' then
    n := n + 1;
until (n > tammaxcesta) or (rd = 'N');
  if n > tammaxcesta then begin clrscr;
	writeln('**** Fin De Entradas Pulse una tecla ****');
	end;
end;
 
procedure inicializa_cestas(ces : integer);
var
i : integer;
begin
  if ces > tamreg then
begin
	writeln(' Excedido Numero de Cestas. Pulsar [Enter]');
	readln;
end
	else
begin
  for i := 0 to tammaxcesta do
begin
	cesta[ces][i].en_cesta := false;
	cesta[ces][i].nombre := ' ';
  end;
	clrscr;
	writeln('Cesta Inicializada. Pulse una tecla');
	readln;
	end;
end;
 
procedure mostrar_productos(pro : integer);
var
y:integer;
d : integer;
begin
	clrscr;
	if cont > 1 then
begin
	y := 3;
	writeln('Nombre de Producto , Numero de Productos y Precio');
  for d := 0 to tammaxcesta do
begin
  if cesta[pro][d].nombre = ' ' then
begin
	end
else
begin
	writeln(cesta[pro][d].nombre);
	writeln(cesta[pro][d].numero);
	writeln(cesta[pro][d].precio:0:2);
	y := y + 1;
	end;
	end;
end
else
	writeln(' La Cesta esta Vacia. Pulsar [Enter] ');
	readln;
	end;
 
procedure mostrar_cesta(ces : integer);
var
p : integer;
begin
	clrscr;
	write(' Introduzca Posicion a Visualizar : ');
	readln(p);
   if (p = 0) or (p > tamreg) then
begin
   if cont > 1 then
begin
	writeln('Nombre:');
	writeln(cesta[ces][p].nombre);
	writeln('Numero De Productos:');
	writeln(cesta[ces][p].numero);
	writeln('Precio');
	writeln(cesta[ces][p].precio:0:2);
	writeln;
	writeln('Pulse [Enter] ');
end
else
	writeln('La Cesta Esta Vacia. Pulse una tecla ');
	readln;
	end;
	end;
 
function cuenta_productos(ddd : integer) : integer;
var
b:integer;
c : integer;
begin
   c := 0;
  for b := 1 to tammaxcesta do
  if cesta[ddd][b].en_cesta = true then
   c := c + 1;
	cuenta_productos := c;
	end;
 
function busca_libre(lll : integer) : integer;
var
c:integer;
vv : integer;
begin
   c := 0;
  for vv := 1 to tammaxcesta do
  if cesta[lll][vv].en_cesta = false then
begin
   c := vv;
   break;
end;
   if c > 0 then
begin
	busca_libre := c;
end
else
begin
	busca_libre := 0;
	end;
	end;
 
procedure incluir_producto_en_cesta;
var
n, gg : integer;
begin
	writeln(' Introduzca Numero Cesta : ');
	readln(n);
	gg := busca_libre(n);
	lee_producto(n,gg);
end;
 
procedure guarda_cesta(nomb : string; ct : producto);
var
gua : integer;
begin
	assign(fich,nomb);
	{$I-} reset(fich);
	{$I+} if ioresult <> 0 then
begin
	rewrite(fich);
	seek(fich,0);
	write(fich, ct);
	close(fich);
end
else
begin
	seek(fich,filesize(fich));
	write(fich, ct);
	close(fich);
	end;
end;
 
procedure recupera_cesta(nomb : string);
var
nom : string;
i : integer;
bus : longint;
encont : boolean;
begin
	assign(fich,nomb);
	{$I-} reset(fich);
	{$I+} if ioresult <> 0 then
begin
end
else
begin
	write(' Introduzca nombre Producto : ');
	readln(nom);
	bus := 0;
	encont := false;
repeat
	seek(fich,bus);
	read(fich,prese);
   for i := 1 to tammaxcesta do
begin
   if prese[i].nombre = nom then
begin
	encont := true;
end;
end;
   if encont = false then bus := bus + 1;
   until (bus > filesize(fich) - 1) or (encont = true);
	close(fich);
end;
end;
 
function busca_producto(lacesta:producto; nombre:string):integer;
var i:integer;
begin
	 for i:=1 to TAMMAXCESTA do
     begin
        if (lacesta[i].nombre = nombre) then
            busca_producto:= i
        else
            busca_producto:= 0;
     end;
end;
 
procedure eliminar_producto_de_cesta(var lacesta:producto);
var
aproduct:string;
posaux:integer;
begin
	{leemos el nombre del producto}
	write('Por favor, indique el nombre del producto a eliminar: ');
	readln(aproduct);
	{pos := 0; {inicializamos pos (aunque no hace falta aquí)}}
	posaux:= busca_producto(lacesta,aproduct); {buscamos el producto}
	{pos := 0; {inicializamos pos (aunque no hace falta aquí)}
	if posaux = 0 then {si lo encontramos}
		writeln ('Producto no encontrado.');{c[pos].en_cesta := false {lo eliminamos}
	else
		begin
		lacesta[posaux].en_cesta:= false;
		writeln('Producto numero: ',posaux,'encontrado y eliminado');
end;
end;
 
 
var
lacesta: producto;
opcion: integer;
begin
cont := 1;
repeat
writeln;
		{Presentación del menú}
		writeln('1. Comenzar cesta de compra nueva.');
		writeln('2. Abrir cesta de compra existente.');
		writeln('3. Añadir producto a la cesta.');
		writeln('4. Eliminar producto de la cesta.');
		writeln('5. Guardar cesta.');
		writeln('6. Pedir cesta.');
		writeln('7. Salir del programa.');
		writeln;
		write('Por favor, introduzca una opcion: ');
		readln(opcion);
		writeln;
repeat
	tec := readkey;
until
	tec in['1','2','3','4','5','6','7'];
case tec of
 
'1' : begin write(' Cesta Numero : ');
	readln(nn);
	inicializa_cestas(nn);
end;
 
'2': begin lee_producto(cont,1);
	cont := cont + 1;
end;
 
 
'4' : begin eliminar_producto (lacesta);
end;
 
'3' : begin incluir_producto_en_cesta;
end;
 
'5' : begin write(' Introduzca Nombre Archivo y Extension : ');
	readln(nombe);
	write(' Introduzca Num. Posicion : ');
	readln(n);
   if n > tamreg then n := tamreg;
	guarda_cesta(nombe,cesta[n]);
end;
 
'6' : begin write(' Introduzca Nombre Archivo y Extension : ');
	readln(nombe);
	recupera_cesta(nombe);
	end;
  end;
 until tec = '7';
end.
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

FICHERO BINARIO

Publicado por Jose (5 intervenciones) el 23/03/2013 12:37:39
Hola urgente necesito hacer el siguiente ejercicio tal y como lo pide el enunciado (dejarlo claro porfavor y no copiar de otros temas) poner un asterisco donde empieza el ejercicio que necesito
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
Program Galeria;
(*-- Constantes globales al programa -- *)
Const
    tamacoleccion = 4;
(*-- Tipos globales al programa -- *)
Type
   coleccion = array[1..tamacoleccion] of real;
   (*-- Variables del módulo principal -- *)
 Var
  precios : Coleccion;
  t : integer;
  datos : boolean;
(*-- Funciones y procedimientos -- *)
  procedure leertabla(var precios : coleccion);
  var
    pre : coleccion;
  begin
     for t := 1 to tamacoleccion do
     begin
     write('   Introduza los precios Cuadro.',t,' : ');
     readln(pre[t]);
     end;
      precios := pre;
      datos := true;
   end;
  procedure imprimetabla(pre : Coleccion);
  begin
     if datos = true then
     begin
         for t := 1 to tamacoleccion do
         writeln('Precio cuadro  : ',t,pre[t]:8:2);
         writeln;
         writeln('**** Pulse Enter ****');
         readln;
     end
   else
       begin
          writeln('.... La Tabla Esta Vacia Pulse Enter ....');
          readln;
       end;
  end;
(*-- Programa Principal -- *)
Begin
    datos := false;
    leertabla(precios);
    writeln;
    imprimetabla(precios);
End




Partiendo del programa anterior, sin modificar los procedimientos y funciones ya codificados, introduzca un procedimiento de nombre limites que devolverá como parámetros por referencia el máximo y el mínimo de la colección.

RECORDATORIO:
A la hora de buscar el mínimo (o el máximo) dentro de una tabla se procede:

Se le da como valor inicial al mínimo, el primer valor de la tabla.
Se recorre el resto de la tabla y en cada iteración:
a) Se comprueba si el valor de la tabla es menor que mínimo. a.1) Si lo es al mínimo se le da el valor de dicho elemento.
a.2) Si es mayor no se hace nada y se pasa al siguiente elemento.

En el programa principal, la invocación deberá ser de la forma:

(*-- Variables -- *)
Var
precios1 : Coleccion;
min1, max1: real;

(*-- Programa Principal -- *)
Begin
lee_tabla(precios1, TAMCOLECCION);
imprime_tabla(precios1, TAMCOLECCION);

(* Aquí iría la invocación a limites *)

(* Presentación de resultados *)
Writeln('El maximo es ', max1:0:1, ' y el mínimo ' , min1:0:1);
End.

Y el resultado deberá ser:


Símbolo de MS - DOS

C:\cursopro>ppc386 usuario_t7_4.pas
Free Pascal Compiler version 1.0.4 [2000/12/30] for i386
Copyright (c) 1993-2000 by Florian Klaempfl
Target OS: Win32 for i386
Compiling usuario_t7_4.pas
Linking usuario_t7_4.exe
158 Lines compiled, 2.2 sec

C:\cursopro>usuario_t7_4.exe
Introduza los precios
Cuadro 1: 400
Cuadro 2: 275
Cuadro 3: 225
Cuadro 4: 350
> Precio cuadro 1: 400.00
> Precio cuadro 2: 275.00
> Precio cuadro 3: 225.00
> Precio cuadro 4: 350.00
El maximo es 400.0 y el minimo 225.0

C:\cursopro>
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

FICHERO BINARIO

Publicado por ramon (2072 intervenciones) el 23/03/2013 21:39:12
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
{A qui tienes lo que pides}
 
Program Galeria;
 uses
    crt;
 Const
    tamacoleccion = 4;
 Type
    coleccion = array[1..tamacoleccion] of real;
  Var
    precios : Coleccion;
     t : integer;
    datos : boolean;
    min1, max1: real;
 
   procedure leertabla(var precios : coleccion);
   var
     pre : coleccion;
    begin
      for t := 1 to tamacoleccion do
      begin
         write(' Introduza los precios Cuadro.',t,' : ');
         readln(pre[t]);
      end;
       precios := pre;
       datos := true;
   end;
 
    procedure imprimetabla(pre : Coleccion);
    begin
     if datos = true then
     begin
        for t := 1 to tamacoleccion do
         writeln('Precio cuadro : ',t,pre[t]:8:2);
      end
   else
      begin
         writeln('.... La Tabla Esta Vacia Pulse Enter ....');
         readln;
      end;
   end;
 
   procedure elmaxyelminimo(pre : Coleccion);
   var
     ct : integer;
   begin
       max1 := 0;
       min1 := pre[1];
       for ct := 1 to tamacoleccion do
       begin
       if pre[ct] < min1 then
       min1 := pre[ct];
       if pre[ct] > max1 then
       max1 := pre[ct];
      end;
   end;
 
  Begin
     clrscr;
     writeln;
     datos := false;
     leertabla(precios);
     writeln;
     imprimetabla(precios);
     writeln;
     elmaxyelminimo(precios);
     Writeln('El maximo es ', max1:0:1, ' y el minimo ' , min1:0:1);
     writeln;
     writeln('**** Pulse Espacio ****');
     readkey;
    End.
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