program final;
uses crt;
type
reg_jugadores = record
idjugador,idequipo,fechanac:string[10];
nomyap:string[30];
baja:boolean
end;
reg_equipos = record
idequipo:string[10];
nombre,dt:string[15];
baja:boolean
end;
reg_records = record
idrecord,idjugador:string[15];
titulo:string[20];
baja:boolean
end;
arch_jug =file of reg_jugadores;
arch_eq =file of reg_equipos;
arch_records = file of reg_records;
var
a_j : arch_jug;
a_e: arch_eq;
a_r : arch_records;
s: char;
procedure abrir(var a:arch_jug; var b:arch_eq; var c:arch_records);
begin
assign(a,'jugadores.dat');
assign(b,'equipos.dat');
assign(c,'records.dat');
{$I-};
reset(a);
{$I+};
if ioresult <> 0 then
rewrite(a);
close(a);
{$I-};
reset(b);
{$I+};
if ioresult <> 0 then
rewrite(b);
close(b);
{$I-};
reset(c);
{$I+};
if ioresult <> 0 then
rewrite(c);
close(c)
end;
function buscareq(var a:arch_eq;c:string): integer;
var
enc:boolean;
r:reg_equipos;
pos:integer;
begin
reset(a);
enc:=false;
pos:=-1;
while (not enc) and (not eof(a)) do
begin
read(a,r);
if (r.idequipo= c) and (not r.baja) then
begin
pos:=filepos(a) - 1;
enc:=true
end
end;
close(a);
buscareq:=pos
end;
function buscarjug(var a:arch_jug;c:string): integer;
var
enc:boolean;
r:reg_jugadores;
pos:integer;
begin
reset(a);
enc:=false;
pos:=-1;
while (not enc) and (not eof(a)) do
begin
read(a,r);
if (r.idjugador= c) and (not r.baja) then
begin
pos:=filepos(a) - 1;
enc:=true
end
end;
close(a);
buscarjug:=pos
end;
function buscarrec(var a:arch_records; c:string): integer;
var
enc:boolean;
r:reg_records;
pos:integer;
begin
reset(a);
enc:=false;
pos:=-1;
while (not enc) and (not eof(a)) do
begin
read(a,r);
if (r.idrecord= c) and (not r.baja) then
begin
pos:=filepos(a) - 1;
enc:=true
end
end;
close(a);
buscarrec:=pos
end;
procedure crea_libres (var a:arch_eq);
var
r: reg_equipos;
p:integer;
begin
p:= buscareq(a,'libres');
if p=-1 then
begin
r.idequipo:='libres';
r.nombre:='Agentes libres';
r.dt:='[ninguno]';
r.baja:= false;
reset(a);
seek(a,filesize(a));
write(a,r);
close(a)
end
end;
function valida_s_n(c:char): char;
begin
while (upcase(c) <> 'S') and (upcase(c) <> 'N') do
c := readkey;
valida_s_n := upcase(c)
end;
function valida_j_e_r(c:char): char;
begin
while (upcase(c) <> 'J') and (upcase(c) <> 'E') and (upcase(c) <> 'R') do
c := readkey;
valida_j_e_r := upcase(c)
end;
function valida_e_l_c(c:char): char;
begin
while (upcase(c) <> 'E') and (upcase(c) <> 'L') and (upcase(c) <> 'C') do
c := readkey;
valida_e_l_c := upcase(c)
end;
function valida_a_b_m_l_s(c:char): char;
begin
while (upcase(c) <> 'A') and (upcase(c) <> 'B') and (upcase(c) <> 'M') and (upcase(c) <> 'L') and (upcase(c) <> 'S') do
c := readkey;
valida_a_b_m_l_s := upcase(c)
end;
procedure alta (var a:arch_eq; var b:arch_jug; var c:arch_records);
var
s:char;
rjug:reg_jugadores;
rrec:reg_records;
req:reg_equipos;
p:integer;
begin
clrscr;
writeln('Dar de alta');
write('(J)ugadores / (E)quipos / (R)ecords');
s:= valida_j_e_r(readkey);
if s='E' then
repeat
clrscr;
writeln('Alta equipos');
write('ID del equipo: ');
readln(req.idequipo);
p:= buscareq(a,req.idequipo);
if p<> -1 then
write('El ID ya existe')
else
begin
write('Nombre: ');
readln(req.nombre);
write('DT: ');
readln(req.dt);
req.baja:=false;
reset(a);
seek(a,filesize(a));
write(a,req);
close(a)
end;
gotoxy(1,25);
write('¨Ingresar otro equipo? (s/n)');
s := valida_s_n(readkey)
until (s='N')
else if s='J' then
repeat
clrscr;
writeln('Alta jugadores');
write('ID del jugador: ');
readln(rjug.idjugador);
p:= buscarjug(b,rjug.idjugador);
if p<> -1 then
write('El ID ya existe')
else
begin
write('ID de su equipo: ');
readln(rjug.idequipo);
if buscareq(a,rjug.idequipo) = -1 then
write('El equipo no existe')
else
begin
write('Nombre y apellido: ');
readln(rjug.nomyap);
write('Fecha nacimiento: ');
readln(rjug.fechanac);
rjug.baja:=false;
reset(b);
seek(b,filesize(b));
write(b,rjug);
close(b)
end
end;
gotoxy(1,25);
write('¨Ingresar otro jugador? (s/n)');
s := valida_s_n(readkey)
until (s='N')
else if s='R' then
repeat
clrscr;
writeln('Alta records');
write('ID del record: ');
readln(rrec.idrecord);
p:= buscarrec(c,rrec.idrecord);
if p<> -1 then
write('El ID ya existe')
else
begin
write('T¡tulo: ');
readln(rrec.titulo);
write('ID del jugador: ');
readln(rrec.idjugador);
if buscarjug(b,rrec.idjugador) = -1 then
write('El jugador no existe')
else
begin
rrec.baja:=false;
reset(c);
seek(c,filesize(c));
write(c,rrec);
close(c)
end
end;
gotoxy(1,25);
write('¨Ingresar otro record? (s/n)');
s := valida_s_n(readkey)
until (s='N')
end;
procedure liberajugadores(var a:arch_jug; equipo:string);
var
reg:reg_jugadores;
begin
reset(a);
while (not eof(a)) do
begin
read(a,reg);
if (reg.idequipo=equipo) and (not reg.baja) then
begin
reg.idequipo := 'libres';
seek(a,filepos(a)-1);
write(a,reg)
end
end;
close(a)
end;
procedure eliminarecords(var a:arch_records; jug:string);
var
reg:reg_records;
begin
reset(a);
while (not eof(a)) do
begin
read(a,reg);
if (reg.idjugador = jug) and (not reg.baja) then
begin
reg.baja:= true;
seek(a,filepos(a)-1);
write(a,reg)
end
end;
close(a)
end;
procedure baja (var a:arch_jug;var b:arch_eq;var c:arch_records);
var
s:char;
p,p2:integer;
req:reg_equipos;
rjug:reg_jugadores;
rrec:reg_records;
begin
clrscr;
writeln('Dar de baja');
write('(E)quipos / (J)ugadores / (R)ecords');
s := valida_j_e_r(readkey);
if s='E' then
begin
repeat
clrscr;
write('ID del equipo a eliminar: ');
readln(req.idequipo);
if (req.idequipo <> 'libres') then
begin
p:= buscareq(b,req.idequipo);
if p=-1 then
write('El equipo no existe')
else
begin
reset(b);
seek(b,p);
read(b,req);
writeln('Equipo: ',req.nombre);
writeln('DT: ',req.dt);
writeln;
writeln('Si elimina este equipo, sus jugadores ser n agentes libres');
write('¨Eliminar? (s/n)');
s := valida_s_n(readkey);
if s='S' then
begin
liberajugadores(a,req.idequipo);
req.baja:=true;
seek(b,p);
write(b,req);
gotoxy(1,24);
writeln('Baja realizada')
end
else
begin
gotoxy(1,24);
writeln('Baja cancelada')
end;
close(b)
end
end
else
begin
gotoxy(1,25);
write('Los agentes libres deben ser eliminados uno por uno')
end;
gotoxy(1,25);
write('¨Eliminar otro? (s/n)');
s := valida_s_n(readkey);
until(s='N')
end
else if s='J' then
begin
repeat
clrscr;
write('ID del jugador a eliminar: ');
readln(rjug.idjugador);
p:= buscarjug(a,rjug.idjugador);
if p=-1 then
write('El jugador no existe')
else
begin
reset(a);
seek(a,p);
read(a,rjug);
writeln('Nombre: ',rjug.nomyap);
p2:=buscareq(b,rjug.idequipo);
reset(b);
seek(b,p2);
read(b,req);
close(b);
writeln('Equipo: ',req.nombre);
writeln('Fecha nacimiento: ',rjug.fechanac);
writeln;
if (rjug.idequipo= 'libres') then
begin
write('¨Eliminar? (s/n)');
s:= valida_s_n(readkey)
end
else
begin
write('(E)liminar / (L)iberar / (C)ancelar');
s := valida_e_l_c(readkey)
end;
if s='E' then
begin
rjug.baja:=true;
seek(a,p);
write(a,rjug);
eliminarecords(c,rjug.idjugador);
gotoxy(1,24);
writeln('Baja realizada')
end
else if (s='L') then
begin
rjug.idequipo:='libres';
seek(a,filepos(a)-1);
write(a,rjug);
eliminarecords(c,rjug.idjugador);
gotoxy(1,24);
write('El jugador es ahora agente libre')
end
else
begin
gotoxy(1,24);
writeln('Baja cancelada')
end;
close(a)
end;
gotoxy(1,25);
write('¨Eliminar otro? (s/n)');
s := valida_s_n(readkey)
until(s='N')
end
else if (s='R') then
begin
repeat
clrscr;
write('ID del record a eliminar: ');
readln(rrec.idrecord);
p:= buscarrec(c,rrec.idrecord);
if p=-1 then
write('El record no existe')
else
begin
reset(c);
seek(c,p);
read(c,rrec);
writeln('T¡tulo: ',rrec.titulo);
p2:=buscarjug(a,rrec.idjugador);
reset(a);
seek(a,p2);
read(a,rjug);
close(a);
writeln('Jugador: ',rjug.nomyap);
p2:=buscareq(b,rjug.idequipo);
reset(b);
seek(b,p2);
read(b,req);
close(b);
writeln('Equipo: ',req.nombre);
writeln;
write('¨Eliminar? (s/n)');
s := valida_s_n(readkey);
if s='S' then
begin
rrec.baja:=true;
seek(c,p);
write(c,rrec);
gotoxy(1,24);
writeln('Baja realizada')
end
else
begin
gotoxy(1,24);
writeln('Baja cancelada')
end;
close(c)
end;
gotoxy(1,25);
write('¨Eliminar otro? (s/n)');
s := valida_s_n(readkey)
until (s='N')
end
end;
procedure modificar(var a:arch_jug; var b:arch_eq; var c:arch_records);
var
req: reg_equipos;
rjug: reg_jugadores;
rrec: reg_records;
s: char;
p: integer;
begin
clrscr;
writeln('Modificar');
write('(J)ugadores / (E)quipos / (R)ecords');
s := valida_j_e_r(readkey);
if s='J' then
begin
repeat
clrscr;
writeln('Modificar jugadores');
write('ID del jugador: ');
readln(rjug.idjugador);
p:= buscarjug(a,rjug.idjugador);
if p=-1 then
write('El jugador no existe')
else
begin
write('ID de su equipo: ');
readln(rjug.idequipo);
p:=buscareq(b,rjug.idequipo);
if p=-1 then
write('El equipo no existe')
else
begin
write('Nombre y apellido: ');
readln(rjug.nomyap);
write('Fecha nacimiento: ');
readln(rjug.fechanac);
rjug.baja:=false;
reset(a);
seek(a,p);
write(a,rjug);
close(a)
end
end;
gotoxy(1,25);
write('¨Modificar otro jugador? (s/n)');
s := valida_s_n(readkey);
until (s='N')
end
else if s='E' then
begin
repeat
clrscr;
writeln('Modificar equipos');
write('ID del equipo: ');
readln(req.idequipo);
p:= buscareq(b,req.idequipo);
if p=-1 then
write('El equipo no existe')
else
begin
write('Nombre: ');
readln(req.nombre);
write('DT: ');
readln(req.dt);
req.baja:=false;
reset(b);
seek(b,p);
write(b,req);
close(b)
end;
gotoxy(1,25);
write('Modificar otro equipo? (s/n)');
s := valida_s_n(readkey);
until (s='N')
end
else if s='R' then
begin
repeat
clrscr;
writeln('Modificar records');
write('ID del record: ');
readln(rrec.idrecord);
p:= buscarrec(c,rrec.idrecord);
if p=-1 then
write('El record no existe')
else
begin
write('T¡tulo: ');
readln(rrec.titulo);
write('ID del jugador: ');
readln(rrec.idjugador);
if buscarjug(a,rrec.idjugador) = -1 then
write('El jugador no existe')
else
begin
rrec.baja:=false;
reset(c);
seek(c,p);
write(c,rrec);
close(c)
end
end;
gotoxy(1,25);
write('¨Modificar otro record? (s/n)');
s := valida_s_n(readkey)
until (s='N')
end
end;
procedure listar(var a:arch_eq; var b:arch_jug; var c:arch_records);
var
req: reg_equipos;
rjug: reg_jugadores;
rrec: reg_records;
p,i,cuantos: integer;
s: char;
begin
repeat
cuantos:=0;
clrscr;
writeln('Listar');
write('(E)quipos / (J)ugadores / (R)ecords');
s := valida_j_e_r(readkey);
if s= 'E' then
begin
clrscr;
reset(a);
while (not eof(a)) do
if cuantos < 7 then
begin
read(a,req);
if (not req.baja) then
begin
cuantos:= cuantos +1;
writeln('ID del equipo: ',req.idequipo);
writeln('Equipo: ',req.nombre);
writeln('DT: ',req.dt);
for i:= 1 to 80 do
write('-')
end
end
else
begin
gotoxy(1,25);
write('Presione una tecla para continuar');
readkey;
cuantos:=0
end;
close(a);
end
else if s= 'J' then
begin
clrscr;
reset(b);
while (not eof(b)) do
if cuantos < 5 then
begin
read(b,rjug);
if (not rjug.baja) then
begin
cuantos:= cuantos +1;
writeln('ID del jugador: ',rjug.idjugador);
writeln('Nombre y apellido: ',rjug.nomyap);
p:=buscareq(a,rjug.idequipo);
reset(a);
seek(a,p);
read(a,req);
close(a);
writeln('Equipo: ',req.nombre);
writeln('Fecha nacimiento: ',rjug.fechanac);
for i:= 1 to 80 do
write('-')
end
end
else
begin
gotoxy(1,25);
write('Presione una tecla para continuar');
readkey;
cuantos:=0
end;
close(b)
end
else if s= 'R' then
begin
clrscr;
reset(c);
while (not eof(c)) do
if cuantos < 5 then
begin
read(c,rrec);
if (not rrec.baja) then
begin
cuantos:= cuantos +1;
writeln('ID del record: ',rrec.idrecord);
writeln('T¡tulo: ',rrec.titulo);
p:= buscarjug(b,rrec.idjugador);
reset(b);
seek(b,p);
read(b,rjug);
close(b);
writeln('Jugador: ',rjug.nomyap);
p:= buscareq(a,rjug.idequipo);
reset(a);
seek(a,p);
read(a,req);
close(a);
writeln('Equipo: ',req.nombre);
for i:= 1 to 80 do
write('-')
end;
end
else
begin
gotoxy(1,25);
write('Presione una tecla para continuar');
readkey;
cuantos:=0
end;
close(c)
end;
gotoxy(1,25);
write('¨Desea listar algo m s? (s/n)');
s := valida_s_n(readkey);
until (s = 'N')
end;
begin {PP}
abrir(a_j,a_e,a_r);
crea_libres(a_e);
repeat
clrscr;
writeln('¨Qu desea hacer?');
write('(A)ltas / (B)ajas / (M)odificaciones / (L)istados / (S)alir');
s := valida_a_b_m_l_s(readkey);
if s ='A' then
alta(a_e,a_j,a_r)
else if s='B' then
baja(a_j,a_e,a_r)
else if s ='M' then
modificar(a_j,a_e,a_r)
else if s='L' then
listar(a_e,a_j,a_r)
until (s='S')
end.
Gestión de una liga de baloncesto
Programa de gestión que permite realizar altas, bajas y modificaciones de equipos, jugadores y récords de una liga de baloncesto.
Descargar adjuntos
COMPARTE ESTE TUTORIAL
COMPARTIR EN FACEBOOK
COMPARTIR EN TWITTER
COMPARTIR EN LINKEDIN
COMPARTIR EN WHATSAPP