fichero binario
Publicado por Sara (6 intervenciones) el 11/03/2015 22:52:00
En un programa que tengo hecho (lo adjunto al final) tengo que hacer lo siguiente:
1) Definir un fichero binario en el que cada elemento del fichero sea de tipo Producto.
2) Codificar un procedimiento (guarda_cesta) que guarde todos los productos de una cesta de la compra, que se pasa como parámetro, en un fichero cuyo nombre también se pasa por parámetro. Los productos están en la cesta sólo si el campo en_cesta=true.
3) Codificar un procedimiento (recupera_cesta) que lea de un fichero de elementos de tipo producto, todos los productos que tenga almacenados y los guarde en una variable de tipo cesta..
Program EJERCICIO29;
Const
Tammaxcesta=3;
Type
Tproducto=record
nombre:string;
num_unidades:integer;
precio_unidad:real;
en_cesta:boolean;
end;
Tcesta = array [0..Tammaxcesta] of Tproducto;
Tfichero = file of Tcesta;
Var
unacesta:Tcesta; (* variable del tipo cesta*)
opcion:integer;
pos:integer;
fichero:Tfichero;
Procedure lee_producto (VAR producto:Tproducto);
Begin
producto.en_cesta:=true;
writeln('Escriba los datos del producto: ');
write('Nombre: ');
readln(producto.nombre);
write('Numero de unidades: ');
readln(producto.num_unidades);
write('Precio: ');
readln(producto.precio_unidad);
End;
Procedure inicializa_cesta;
var
i:integer;
Begin
for i:= 1 to TAMMAXCESTA do
begin
unacesta [i]. nombre := '';
unacesta [i]. num_unidades:= 0;
unacesta [i]. precio_unidad:= 0.0;
unacesta [i]. en_cesta := false;
end;
end;
Procedure mostrar_producto (var productocesta:Tproducto);
Begin
writeln;
writeln('El producto de la cesta es: ');
writeln;
writeln('Nombre: ',productocesta.nombre);
writeln('Unidades: ',productocesta.num_unidades);
writeln('Precio por unidad: ',productocesta.precio_unidad:0:2);
writeln('Precio total: ',(productocesta.num_unidades*productocesta.precio_unidad):0:2);
writeln;
End;
Procedure llenar_cesta (VAR unacesta:Tcesta);
Var
i:integer;
Begin
For i:= 1 to Tammaxcesta do
begin
lee_producto(unacesta[i]);
end;
End;
Procedure Mostrar_cesta (unacesta:Tcesta);
var
i:integer;
begin
For i:= 1 to Tammaxcesta do
mostrar_producto(unacesta[i]);
end;
Function busca_libre (unacesta:Tcesta):integer;
Var
i:integer;
Begin
for i:= 1 to Tammaxcesta do
if (unacesta[i].en_cesta = false) then
begin
busca_libre:=i;
writeln('La primera posicion libre de la cesta es la: ',i);
end
else
begin
busca_libre:= 0;
writeln('No hay ninguna posición libre en la cesta');
end;
end;
Procedure incluir_producto_en_cesta (Var unacesta:Tcesta);
Var
i:integer;
begin
i:=busca_libre(unacesta);
if (i <>0) then
lee_producto(unacesta[i])
else
begin
writeln;
writeln('La cesta esta llena');
end;
end;
Function buscar_producto (UnaCesta:Tcesta; nombre:string): integer;
Var
i:integer;
begin
for i:= 1 to tammaxcesta do
begin
if (unacesta[i].nombre = nombre) then
buscar_producto:=i
else
buscar_producto:=0;
end;
end;
Procedure Eliminar_producto (var UnaCesta:TCesta);
var
unproduc : string;
numaux: integer;
begin
Writeln;
Write ('Escriba el nombre del producto a eliminar: ');
Readln(unproduc);
numaux:= Buscar_producto (UnaCesta,unproduc);
If (numaux = 0) then
writeln ('Producto no encontrado')
else
begin
UnaCesta[numaux].en_cesta := false;
Writeln ('Producto numero: ',numaux,'encontrado y eliminado');
end;
End;
Procedure menu;
begin
repeat
writeln(' *** M E N U *** ');
writeln();
writeln('1. Abrir la cesta de la compra exixtente.');
writeln('2. Comenzar cesta de compra nueva.');
writeln('3. Anadir 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('Introduzca una opcion: ');
readln(opcion);
writeln();
if (opcion=1) then
begin
writeln('Abrir cesta de la compra');
readln;
end
else
if (opcion=2) then
llenar_cesta(unacesta)
else
if (opcion=3) then
begin
pos:=busca_libre(unacesta);
incluir_producto_en_cesta(unacesta);
end
else
if (opcion=4) then
eliminar_producto(unacesta)
else
if (opcion=5) then
begin
writeln('Guardar cesta');
readln;
end
else
if (opcion=6) then
else
if (opcion=7) then
write('Salir');
until (opcion < 1) or (opcion >=7);
end;
Begin
inicializa_cesta;
opcion:=0;
menu;
readln;
End.
Gracias
1) Definir un fichero binario en el que cada elemento del fichero sea de tipo Producto.
2) Codificar un procedimiento (guarda_cesta) que guarde todos los productos de una cesta de la compra, que se pasa como parámetro, en un fichero cuyo nombre también se pasa por parámetro. Los productos están en la cesta sólo si el campo en_cesta=true.
3) Codificar un procedimiento (recupera_cesta) que lea de un fichero de elementos de tipo producto, todos los productos que tenga almacenados y los guarde en una variable de tipo cesta..
Program EJERCICIO29;
Const
Tammaxcesta=3;
Type
Tproducto=record
nombre:string;
num_unidades:integer;
precio_unidad:real;
en_cesta:boolean;
end;
Tcesta = array [0..Tammaxcesta] of Tproducto;
Tfichero = file of Tcesta;
Var
unacesta:Tcesta; (* variable del tipo cesta*)
opcion:integer;
pos:integer;
fichero:Tfichero;
Procedure lee_producto (VAR producto:Tproducto);
Begin
producto.en_cesta:=true;
writeln('Escriba los datos del producto: ');
write('Nombre: ');
readln(producto.nombre);
write('Numero de unidades: ');
readln(producto.num_unidades);
write('Precio: ');
readln(producto.precio_unidad);
End;
Procedure inicializa_cesta;
var
i:integer;
Begin
for i:= 1 to TAMMAXCESTA do
begin
unacesta [i]. nombre := '';
unacesta [i]. num_unidades:= 0;
unacesta [i]. precio_unidad:= 0.0;
unacesta [i]. en_cesta := false;
end;
end;
Procedure mostrar_producto (var productocesta:Tproducto);
Begin
writeln;
writeln('El producto de la cesta es: ');
writeln;
writeln('Nombre: ',productocesta.nombre);
writeln('Unidades: ',productocesta.num_unidades);
writeln('Precio por unidad: ',productocesta.precio_unidad:0:2);
writeln('Precio total: ',(productocesta.num_unidades*productocesta.precio_unidad):0:2);
writeln;
End;
Procedure llenar_cesta (VAR unacesta:Tcesta);
Var
i:integer;
Begin
For i:= 1 to Tammaxcesta do
begin
lee_producto(unacesta[i]);
end;
End;
Procedure Mostrar_cesta (unacesta:Tcesta);
var
i:integer;
begin
For i:= 1 to Tammaxcesta do
mostrar_producto(unacesta[i]);
end;
Function busca_libre (unacesta:Tcesta):integer;
Var
i:integer;
Begin
for i:= 1 to Tammaxcesta do
if (unacesta[i].en_cesta = false) then
begin
busca_libre:=i;
writeln('La primera posicion libre de la cesta es la: ',i);
end
else
begin
busca_libre:= 0;
writeln('No hay ninguna posición libre en la cesta');
end;
end;
Procedure incluir_producto_en_cesta (Var unacesta:Tcesta);
Var
i:integer;
begin
i:=busca_libre(unacesta);
if (i <>0) then
lee_producto(unacesta[i])
else
begin
writeln;
writeln('La cesta esta llena');
end;
end;
Function buscar_producto (UnaCesta:Tcesta; nombre:string): integer;
Var
i:integer;
begin
for i:= 1 to tammaxcesta do
begin
if (unacesta[i].nombre = nombre) then
buscar_producto:=i
else
buscar_producto:=0;
end;
end;
Procedure Eliminar_producto (var UnaCesta:TCesta);
var
unproduc : string;
numaux: integer;
begin
Writeln;
Write ('Escriba el nombre del producto a eliminar: ');
Readln(unproduc);
numaux:= Buscar_producto (UnaCesta,unproduc);
If (numaux = 0) then
writeln ('Producto no encontrado')
else
begin
UnaCesta[numaux].en_cesta := false;
Writeln ('Producto numero: ',numaux,'encontrado y eliminado');
end;
End;
Procedure menu;
begin
repeat
writeln(' *** M E N U *** ');
writeln();
writeln('1. Abrir la cesta de la compra exixtente.');
writeln('2. Comenzar cesta de compra nueva.');
writeln('3. Anadir 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('Introduzca una opcion: ');
readln(opcion);
writeln();
if (opcion=1) then
begin
writeln('Abrir cesta de la compra');
readln;
end
else
if (opcion=2) then
llenar_cesta(unacesta)
else
if (opcion=3) then
begin
pos:=busca_libre(unacesta);
incluir_producto_en_cesta(unacesta);
end
else
if (opcion=4) then
eliminar_producto(unacesta)
else
if (opcion=5) then
begin
writeln('Guardar cesta');
readln;
end
else
if (opcion=6) then
else
if (opcion=7) then
write('Salir');
until (opcion < 1) or (opcion >=7);
end;
Begin
inicializa_cesta;
opcion:=0;
menu;
readln;
End.
Gracias
Valora esta pregunta


0