Pascal/Turbo Pascal - programa en pascal

program binario;

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.

program Productos;

const

	tamnombre=30;

	tammaxcesta=4;

type

	Tproducto=record	(*tipo que representa un producto dentro de la cesta de la compra*)

		nombre: string[tamnombre];	(*nombre del producto*)

		numero_uni:integer;		(*numero de unidades solicitadas*)

		precio_uni:real;		(*precio por unidad*)

		en_cesta:boolean;	(*si en cesta=true el producto está en la cesta, si en cesta=false el producto se eliminó*)

	end;

	Tcesta= array [0..tammaxcesta]of Tproducto; (*creo una tabla para agrupar los datos y tratarlos homogéneamente*)

	Tfichero= file of Tproducto;	(*fichero binario en el que cada elemento es de tipo producto*)

procedure lee_producto (VAR produc:Tproducto); (*procedimiento que rellena los campos de una variable del tipo producto*)

	begin

		produc.en_cesta:=true;

		write('Producto: ');

		readln(produc.nombre);

		write('Numero unidades: ');

		readln(produc.numero_uni);

		write('Precio unidad: ');

		readln(produc.precio_uni);

	end;

procedure escribe_producto (produc:Tproducto);(*procedimiento que muestra por pantalla el valor de una variable del tipo producto*)

	begin

		writeln('Nombre: ', produc.nombre);

		writeln('Numero unidades: ', produc.numero_uni);

		writeln('Precio unidad: ', produc.precio_uni:0:2);

	end;

procedure inicializa_cesta (VAR cesta_compra:Tcesta;tammaxcesta:integer); (*procedimiento que inicializa la cesta*)

	var

		i:integer;

	begin

		for i:= 1 to tammaxcesta do

			begin

				cesta_compra[i].en_cesta:=false;

			end;

		writeln('Cesta inicializada');

	end;

procedure lee_cesta (VAR cesta_compra:Tcesta;tammaxcesta:integer); (*procedimiento que lee la cesta de la compra*)

	var

		i:integer;

	begin

		for i:= 1 to tammaxcesta do

			begin

				lee_producto(cesta_compra[i]);

			end;

	end;

procedure mostrar_cesta (cesta_compra:Tcesta;tammaxcesta:integer); (*procedimiento que muestra los productos que hay en la cesta*)

	var

		i:integer;

	begin

		for i:= 1 to tammaxcesta do

			if (cesta_compra[i].en_cesta=true) then

			begin

				writeln('El producto ', i, ' es: ');

				escribe_producto(cesta_compra[i]);

			end;

	end;

procedure cuenta_productos (cesta_compra:Tcesta;tamaxcesta:integer;VAR contador:integer);

	var

		i:integer;

	begin

		contador:=0;

		for i:= 1 to tammaxcesta do

			begin

				if (cesta_compra[i].en_cesta=true) then

				begin

					contador:=contador+1;

				end;

			end;

		writeln('Los productos que hay en la cesta son: ', contador);

	end;

procedure busca_libre(cesta_compra:Tcesta;tammaxcesta:integer; VAR posicion_libre:integer);

	var

		i:integer;

	begin

		posicion_libre:=0;

		for i:= 1 to tammaxcesta do

			begin

				if (cesta_compra[i].en_cesta=false) then

				begin

					posicion_libre:=i;

				end;

			end;

		writeln('No se encuentra ninguna posicion libre en la cesta');

		writeln('Posicion libre en: ', posicion_libre);

	end;

procedure incluir_producto_en_cesta(VAR cesta_compra:Tcesta;tammaxcesta:integer);

	var

		posicion_libre:integer;

	begin

		posicion_libre:=0;

		busca_libre (cesta_compra,tammaxcesta,posicion_libre);

		if (posicion_libre>0) then

		begin

			writeln ('Entrada de un producto nuevo en la cesta');

			lee_producto(cesta_compra[posicion_libre]);

		end

		else

			writeln('Cesta llena');

	end;

procedure buscar_producto(cesta_compra:Tcesta;tamamaxcesta:integer;nombre_producto:string;VAR posicion_buscado:integer);

	var

		i:integer;

	begin

		posicion_buscado:=0;

		for i:=1 to tammaxcesta do

			if (nombre_producto=cesta_compra[i].nombre) and (cesta_compra[i].en_cesta=true) then

			begin

				posicion_buscado:=i;

			end;

			if (posicion_buscado=0) then

			begin

				writeln ('No se encuentra el producto en la cesta');

			end;

	end;

procedure eliminar_producto_de_cesta(VAR cesta_compra:Tcesta;tammaxcesta:integer);

	var

		posicion:integer;

		nombre_producto:string;

	begin

		write('Escribe el nombre del producto que desea eliminar: ');

		readln(nombre_producto);

		buscar_producto(cesta_compra,tammaxcesta,nombre_producto,posicion);

		if (posicion<>0) then

		begin

			cesta_compra[posicion].en_cesta:=false;

			writeln('Producto eliminado');

		end;

	end;

procedure modificar_producto(VAR cesta_compra:Tcesta;tammaxcesta:integer);

	var

		posicion:integer;

		opcion:char;

		nombre_producto:string;

	begin

		write('Escriba el nombre del producto a modificar: ');

		readln(nombre_producto);

		buscar_producto(cesta_compra,tammaxcesta,nombre_producto,posicion);

		if (posicion<>0) then

		begin

			write ('Elija el campo que quiere cambiar: 1:nombre; 2:numero unidades; 3:precio unidad: ');

			readln (opcion);

			if (opcion='1') then

			begin

				write('Introduzca nombre: ');

				readln(cesta_compra[posicion].nombre);

			end;

			if (opcion='2') then

			begin

				write('Introduzca numero de unidades: ');

				readln(cesta_compra[posicion].numero_uni);

			end;

			if (opcion='3') then

			begin

				write('Introduzca precio unidad: ');

				readln(cesta_compra[posicion].precio_uni);

			end;

		end;

	end;

procedure guarda_cesta (cesta_compra:Tcesta;tammaxcesta:integer;nombre_fichero:string); (*procedimiento que guarda los productos de la cesta en un fichero*)

	var

		fichero:Tfichero;

		i:integer;

	begin

		assign(fichero,nombre_fichero);

		rewrite(fichero);

		for i:= 1 to tammaxcesta do

			begin

				if (cesta_compra[i].en_cesta=true) then

				begin

					write (fichero,cesta_compra[i]);

				end;

			end;

		close(fichero);

	end;

procedure recupera_cesta(VAR cesta_compra:Tcesta;tammaxcesta:integer;nombre_fichero:string);

	var

		i:integer;

		fichero:Tfichero;

	begin

		i:=0;

		assign(fichero,nombre_fichero);

		reset(fichero);

		while(not(eof(fichero))and (i<tammaxcesta)) do

			begin

				i:=i+1;

				read(fichero,cesta_compra[i]);

			end;

		close(fichero);

	end;

(*variables globales del programa*)

var

	cesta_compra:Tcesta;

	opcion:char;

	nombre_fichero:string;

(*Modulo principal*)

begin

	inicializa_cesta(cesta_compra,tammaxcesta);

	writeln('Escriba el nombre del fichero donde desea guardar la cesta');

	readln(nombre_fichero);

	guarda_cesta(cesta_compra,tammaxcesta,nombre_fichero);

	writeln('Escriba el nombre del fichero que desea recuperar: ');

	readln(nombre_fichero);

	recupera_cesta(cesta_compra,tammaxcesta,nombre_fichero);

	repeat

		writeln('''''''MENU''''''');

		writeln ('Elige la opcion que deseas realizar');

		writeln('1. Abrir cesta de compra existente');

		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');

		write  ('Introduzca una opcion: ');

		readln (opcion);

		case (opcion)of

			'1':

				begin

					writeln ('Ha elegido abrir cesta de compra existente');

					writeln ('Escriba el nombre de la cesta a buscar: ');

					readln(nombre_fichero);

					recupera_cesta(cesta_compra,tammaxcesta,nombre_fichero);

					mostrar_cesta(cesta_compra,tammaxcesta);

				end;

			'2':

				begin

					writeln ('Ha elegido comenzar cesta de compra nueva');

					writeln('Vamos a crear una cesta nueva');

					inicializa_cesta(cesta_compra,tammaxcesta);

					writeln('Rellene la cesta de la compra');

					lee_cesta(cesta_compra,tammaxcesta);

					guarda_cesta(cesta_compra,tammaxcesta,nombre_fichero);

				end;

			'3':

				begin

					writeln ('Ha elegido anadir producto a la cesta');

					writeln('Vamos a anadir producto a la cesta');

					writeln('Escriba el nombre de la cesta que vamos a modificar: ');

					readln(nombre_fichero);

					incluir_producto_en_cesta(cesta_compra,tammaxcesta);

					guarda_cesta(cesta_compra,tammaxcesta,nombre_fichero);

				end;

			'4':

				begin

					writeln ('Ha elegido eliminar producto de la cesta');

					writeln('Vamos a eliminar producto de la cesta');

					writeln('Escriba el nombre de la cesta que vamos a modificar: ');

					readln(nombre_fichero);

					eliminar_producto_de_cesta(cesta_compra,tammaxcesta);

					guarda_cesta(cesta_compra,tammaxcesta,nombre_fichero);

				end;

			'5':

				begin

					writeln ('Ha elegido guardar cesta');

					writeln('Escriba el nombre de la cesta a guardar: ');

					readln (nombre_fichero);

					guarda_cesta(cesta_compra,tammaxcesta,nombre_fichero);

				end;

			'6':

				begin

					writeln ('Ha elegido pedir cesta');

					writeln('La cesta contiene los siguientes productos:');

					mostrar_cesta(cesta_compra,tammaxcesta);

				end;

			'7':

				begin

				writeln ('Ha elegido salir del programa');

				writeln('El programa se ha acabado');

				end;

		end;

	until (opcion='7');

end.