ahreee, Pascal - rextester

Language: Layout:

program gimnasio1;
uses crt;
type
 gimnasio=record
 	nombre,direccion:string[30];
 	valor_cuota:real;
 	valor_nutricionista:real;
 	valor_personal_trainer:real;
	end;

actividades=record
 	codigo_actividad:integer;
 	descripcion_actividad:string[30];
	end;

dias_y_horarios=record
 	dia:integer;
 	hora:string[5];
 	codigo_actividad:integer;
	end;

ejercicios_x_rutina=record
 	descripcion_rutina:string[30];
	end;

clientes=record
 	dni:string[8];
 	nombre_y_apellido:string[30];
 	rutina_s_n:char;
 	nutricionista_s_n:char;
 	personaltrainer_s_n:char;
 	pago_en_pesos__peso_actual:array[1..12,1..2] of real;
	end;

rutinasxclientes=record
 	dni:string[8];
 	mes:integer;
 	anio:integer;
 	cantidad_repeticiones:array[1..4,1..50] of integer;
 	borrado_logico:boolean;
  peso:real;
	end;

fgimnasio = file of gimnasio;
 factividades = file of actividades;
 fdiasyhorarios = file of dias_y_horarios;
 fejerciciosxrutina = file of ejercicios_x_rutina;
 fclientes = file of clientes;
 frutinasclientes = file of rutinasxclientes;

var
  	g:gimnasio;
  	a:actividades;
  	dyh:dias_y_horarios;
  	exr:ejercicios_x_rutina;
  	c:clientes;
  	rxc:rutinasxclientes;
  	fg:fgimnasio;
  	fa:factividades;
  	fdyh:fdiasyhorarios;
  	fexr:fejerciciosxrutina;
  	fc:fclientes;
  	frxc:frutinasclientes;

procedure continuar;
begin
	writeln('Presione una tecla para continuar');
	readkey;
	clrscr;
end;

procedure altagimnasio;
begin
	reset(fg);
	writeln('Ingrese el nombre del gimnasio');
	readln(g.nombre);
	writeln('Ingrese la direccion del gimnasio');
	readln(g.direccion);
	writeln('Ingrese el valor de la cuota');
	readln(g.valor_cuota);
	writeln('Ingrese el valor de la nutricionista');
	readln(g.valor_nutricionista);
	writeln('Ingrese el valor del personal trainer');
	readln(g.valor_personal_trainer);
	write(fg, g);
end;

procedure altaejercicios;
var a:integer;
begin
	reset(fexr);
	for a:=1 to 50 do
		begin
			writeln('Ingrese la descripcion del ejercicio ',a);
			readln(exr.descripcion_rutina);
			write(fexr, exr)
		end;
end;

procedure diasyhorarios;
begin
  reset(fa);
  reset (fdyh);
	read(fa, a);
  if not eof(fa) then
  begin
    repeat
      Writeln ('Se configurara para la actividad de codigo ', a.codigo_actividad);
      writeln ('Ingrese dia');
      writeln ('1) Lunes');
      writeln ('2) Martes');
      writeln ('3) Miercoles');
      writeln ('4) Jueves');
      writeln ('5) Viernes');
      writeln ('6) Sabado');
      repeat
      	read (dyh.dia);
      until (dyh.dia>=1 and dyh.dia<=6);
      writeln ('Ingrese horario en formato "hh:mm": ');
      read (dyh.hora);
      dyh.codigo_actividad = a.codigo_actividad;
      write(fdyh, dyh);
      read(fa, a)
    until eof(fa);
    writeln('Se han cargado los horarios para las actividades disponibles.');
  end;
	else
  	writeln('No hay actividades disponibles.';
end;

procedure alta_actividades;
begin
	reset(fa);
	repeat
		write('Ingrese el codigo de la actividad (0 para fin de datos): ');
		readln(a.codigo_actividad);
		write('Ingrese descripcion de la actividad a dar de alta: ');
		readln(a.descripcion_actividad);
    write(fa, a);
	until (a.codigo_actividad=0);
end;

procedure altas;
opc=char;
begin
	clrscr;
	writeln('Ingrese opcion para dar de alta');
	writeln('Ingrese la letra a para actividades');
	writeln('Ingrese la letra g para gimnasio');
	writeln('Ingrese la letra d para dias y horarios');
	writeln('Ingrese la letra e para ejercicios por rutina');
	repeat
  	readln(opc)
  until (opc = 'a') or (opc = 'g') or (opc = 'd') or (opc = 'e');
  case opc of
		'a': alta_actividades;
		'g': gimnasio;
		'd': diasyhorarios;
		'e': altaejercicios;
	end;
  clrscr;
end;

procedure modificar;
begin
	reset(fg);
	write('ingrese el nuevo valor de la cuota: ');
	readln(g.valor_cuota);
	write('ingrese el nuevo valor de la cuota del nutricionista: ');
	readln(g.valor_nutricionista);
	write('ingrese el nuevo valor de la cuota del personal trainer: ');
	readln(g.valor_personal_trainer);
write(fg, g)
end;

procedure ABM();
var
op: char;
begin
	repeat
		writeln('Ingrese la letra a: para altas');
		writeln('Ingrese la letra b: para bajas');
		writeln('Ingrese la letra m: para modificar los valores del gimnasio');
		readln(op);
	until (op='a') or (op='b') or (op='m');
	case op of
		'a': altas;
		'b': bajas;
		'm': modificar;
	end;
end;

procedure crear_rutina; {es para el procedimiento de clientes}
begin
	writeln('Se creara un nuevo archivo de rutinas');
	seek(frxc, filesize(frxc));
	write('Ingrese el anio: ');
	readln(rxc.anio);
	write('Ingrese el mes: ');
	readln(rxc.mes);
	rxc.dni := c.dni;
	rxc.borrado_logico := false;
	write(frxc, rxc);
  writeln('Su archivo rutina se ha creado correctamente.');
  continuar
end;

procedure clientes;

var
dni: string[8];
acum: real;

begin
  write('Ingrese dni del cliente: ');
	readln(dni)
	acum:=0;
	repeat
		read(fc,c)
	until (eof(fc) = true) or (dni = c.dni);
	if eof(fc)
  then
  																			{esta parte del codigo es en el caso de que el cliente sea nuevo}
    begin
    	seek(fc, filesize(fc));
			c.dni := dni;
			writeln ('Ingrese el nombre y apellido');
			readln (c.nombre_y_apellido);
			writeln ('Ingrese si requiere rutina, "s" para si y "n" para no: ');
			repeat
				readln (c.rutina_s_n);
			until (c.rutina_s_n='s') or (c.rutina_s_n='n');
      if (c.rutina_s_n='s') then
      	crear_rutina;
      else;
			writeln ('Ingrese si requiere nutricionista, "s" si para y "n" para no: ');
			repeat
				readln (c.nutricionista_s_n);
			until (c.nutricionista_s_n='s')  or (c.nutricionista_s_n='n');
	    if (c.nutricionista_s_n='s') then
        acum:= acum + g.valor_nutricionista;
      else;
			writeln ('Ingrese si requiere personal trainer');
			repeat
				readln (c.personaltrainer_s_n);
			until (c.personaltrainer_s_n='s') or (c.personaltrainer_s_n='n');
	    if (c.personaltrainer_s_n='s') then
	      acum:= acum + g.valor_personal_trainer;
			else;
			acum := acum + g.valor_cuota;
			write('El monto que debe abonar es: $', acum);
      c.pago_en_pesos__peso_actual[rxc.mes, 1] := acum;
      writeln('Gracias!');
      write(fc, c);
    end;

else
  																			{esta parte del codigo es en caso de que el cliente ya haya venido antes}
  	begin
      writeln('El DNI existe en la base de datos');
      writeln('Ingrese el mes actual: ')
			repeat
      	readln(mes)
      until (mes > 0) and (mes < 13);
      if c.pago_en_pesos__peso_actual[mes, 1] = 0 then
      	begin
          writeln('Se le solicita que pague la cuota, "s" para si y "n" para no.')
          repeat
            readln (c.rutina_s_n);
          until (c.rutina_s_n='s') or (c.rutina_s_n='n');
          if (c.rutina_s_n='s');
          	then
              begin
                writeln ('Ingrese si requiere nutricionista, "s" si para y "n" para no: ');
                repeat
                  readln (c.nutricionista_s_n);
                until (c.nutricionista_s_n='s')  or (c.nutricionista_s_n='n');
                if (c.nutricionista_s_n='s');
                then
                  acum:= acum + g.valor-nutricionista;
                else;
                writeln ('Ingrese si requiere personal trainer');
                repeat
                  readln (c.personaltrainer_s_n);
                until (c.personaltrainer_s_n='s') or (c.personaltrainer_s_n='n');
                if (c.personaltrainer_s_n='s');
                then
                  acum:= acum + g.valor_personal_trainer;
                else;
                acum := acum + g.valor_cuota;
                write('El monto que debe abonar es: $', acum);
                c.pago_en_pesos_+_peso_actual[mes, 1] := acum;
                writeln('Gracias!');
                reset(rxc);
                repeat
                   read(frxc,rxc)
                until (eof(frxc) = true) or (dni.rxc = c.dni);
                if eof(frxc) = true;
                then
                  crear_rutina;
                else
                	begin
                		rxc.mes := mes;
                  	writeln('Se le ha actualizado el mes a su archivo rutina');
                    write(frxc, rxc);
                  end;
              end;
            else;
        	write(fc, c)
        end;
    	else writeln('Bienvenido al gimnasio! Ingrese tranquilo');
    end;
  continuar;
end;

procedure rutinas_por_cliente;
var rep,i,mes:integer; dni:string[8]
begin
	write('Ingrese DNI del cliente: ');
  readln(dni);
  write('Ingrese mes actual: ');
  readln(mes);
  reset(frxc);
  repeat
  	readln(frxc,rxc);
	until ((rxc.dni=dni) and rxc.mes=mes)) or (eof(rxc));
  if (rxc.dni = dni) and (rxc.mes = mes) then
  begin
    write('Ingrese el codigo del ejercicio para su rutina (0 para fin de datos) y 50 maximo de ejercicios: ');
    readln(ej);
    while (ej <> 0) and (con <> 50) do
      begin
        writeln('Ingrese la cantidad de repeticiones para el ejercicio durante cada serie:');
        for i:= 1 to 4 do
          begin
            write('Ejercicio codigo ',ej, ' serie ',i, ': ');
            readln(rep);
            rxc.cant_repeticiones[i,ej] := rep;
          end;
        con := con + 1;
        write('Ingrese nuevo codigo de ejercicio: ')
        readln(ej);
      end;
  	writeln('Se ha actualizado el archivo de rutinas.')
    write(frxc,rxc);
		reset(fc, c);
    repeat
    	read(fc, c)
    until g.dni = rxc.dni
    write('Ingrese el peso actual del cliente: ');
    readln(g.pago-en-pesos_+_peso-actual:[mes, 2]);
    readln('Se ha ingresado el peso correctamente.');
    write(fc, c)
  end;
  else
  	writeln('No se encontro el archivo de rutina.');
	continuar;
end;

procedure buscar_dia(dia: integer);
begin
  reset(fdyh);
  reset(fa);
  case dia of:
  	1: writeln('Lunes: ');
  	2: writeln('Martes: ');
  	3: writeln('Miercoles: ');
  	4: writeln('Jueves: ');
  	5: writeln('Viernes: ');
  	6: writeln('Sabado: ');
  	7: writeln('Domingo: ');
  end;
	repeat
  	read(fdyh, dyh)
  until (dyh.dia = dia) or (eof(fdyh));
  if eof(fdyh)
  	then
    	writeln('No hay actividades para ese dia.');
  	else
    	begin
      	repeat
        	repeat
          	read(fa, a);
          until (a.codigo_actividad = dyh.codigo_actividad);
          writeln('Actividad codigo: ', dyh.codigo_actividad);
          writeln('Hora: ', dyh.hora);
          writeln('Descripcion: ', a.descripcion_actividad);
          read(fdyh, dyh);
        until (eof(fdyh)) or (dyh.dia <> dia);
			end;
	continuar;
end;

procedure listado();
var i: integer;
begin
  reset(fg);
  read(fg, g);
  writeln(g.nombre,);
  writeln('Direccion: ', g.direccion);
  writeln('Valor de la cuota del gimnasio $', g.valor_cuota);
  writeln('Valor de la cuota del nutricionista $', g.valor_nutricionista);
  writeln('Valor de la cuota del personal trainer $', g.valor_personal_trainer);
  for i:= 1 to 6 do
  	buscar_dia(i);
end;

procedure recaudacion();
var mes, acum: integer;
begin
	acum := 0;
  reset(frxc);
	writeln('ingrese mes');
  readln(mes);
  repeat
  	read(frxc, rxc);
  until (mes = rxc.mes) or (eof(frxc));
  if eof(frxc);
  then
  	writeln('No hubo pagos durante ese mes');
  else
  	begin
    	repeat
      	reset(fc);
      	repeat
      		read(fc, c);
      	until c.dni = rxc.dni;
        acum := acum + c.pago_en_pesos__peso_actual[mes, 1];
        read(frxc, rxc);
      until (eof(frc)) or (mes <> rxc.mes)
      writeln('El total de dinero recaudado de este mes es: ');
    end;
  continuar;
end;

procedure asignacion();
begin
   assign(fg'c:\pascal\fgimnasio.dat');
   assign(fa'c:\pascal\factividades.dat');
   assign(fdyh'c:\pascal\fdiasyhorarios.dat');
   assign(fexr'c:\pascal\fejreciciosxrutina.dat');
   assign(fc'c:\pascal\fclientes.dat');
   assign(frxc'c:\pascal\frutinasxclientes.dat');
   end;

procedure reiniciar();
var
posicion, m,l:integer;
r:char;
begin
   repeat
        write('Pulse s para borrar campos. Si no desea borrar, pulse n ');
        readln(r);
   until (r='s') or (r='n');
   if (r='s') then
      begin
          repeat
              writeln('Pulse la letra c para borrar el archivo Clientes');
              writeln('Pulse la letra r para borrar el archivo Rutinas');
              readln(r);
          until (r='c') or (r='r');
   if (r='c') then
        begin
           reset(fc);
        for posicion:=0 to filesize(fc)-1 do
         begin
           for m:=1 to 12 do begin
           c.pago_en_pesos__peso_actual [m,l]:=c.pago_en_pesos__peso_actual[m,0];
         end;
        end;

else writeln ('Ingrese el mes: ');
         readln(rxc.mes);
         rxc.mes:=(borrado_logico=true);
         write('Ingrese el anio: ');
         readln(rxc.anio);
         rxc.anio:=(borrado_logico=true);
     end;
end;

procedure menu();
var
opci=integer;
	begin
	repeat
		writeln ('Bienvenido al menu principal');
		writeln ('Por favor, elija una opción');
		writeln ('1) ABM');
		writeln ('2) CLIENTES');
		writeln ('3) RUTINAS POR CLIENTES');
		writeln ('4) LISTADO DE DIAS Y HORARIOS');
		writeln ('5) RECAUDACION');
		writeln ('6) REINICIAR');
    writeln ('0) SALIR');
		readln(opci);
	until (opci>=1) or (opci<=7);

case opci of
 1:ABM;
 2:clientes;
 3:rutinas por clientes;
 4:listado de dias y horarios;
 5:recaudacion;
 6:reiniciar;
 0:writeln('Hasta luego, gracias.')
end;

procedure cerrado();
begin
   close(fgimnasio);
   close(facrividades);
   close(fdiasyhorarios);
   close(fejerciciosporrutina);
   close(fclientes);
   close(frutinasxclientes);
end;

BEGIN
   procedure asignacion;
   procedure menu;
   procedure cerrado;
keypressed;
END.

Show compiler warnings [ + ] Show input
Compilation time: 0.12 sec, absolute service time: 0,21 sec