|
|
hola Necesito ayuda con un ejercicio. Ya casi lo termino pero el punto c del enunciado no hace lo que tiene que hacer o lo hace pero el programa nunca termina(bucle infinito).Este es el enunciado:"Un coro municipal tiene que realizar una serie de presentaciones en distintos lugares del pais. los datos conocidos son: provincia, localidad, nombre, nombre del lugar donde se llevara a cabo el evento, direccion, telefono y fecha. se desea obtener un menú que permita realizar lo siguiente:
a) cargar datos en el archivo
b)Agregar datos a los ya existentes
C)generar una lista ordenada por nombre de las localidades en las que se llevara a cabo el evento, también deben figurar la provincia y la fecha de la presentacion
d)modificar la fecha de alguna presentación en el archivo
e)Imprimir el archivo y la lista "
mi codigo hasta ahora es´:
program coro;
uses crt,dos;
type
lista=^reg;
reg=record
prov,loc,noml,dir:string;
tel:string[7];
fech:string[8];
ps:lista;
end;
var
regis:reg;
arc,auxarc:file of reg;
a,op,op5:integer;
sn,s1:string[1];
l:lista;
ar:string;
procedure menu;{Muestra el Menu en pantalla}
begin
clrscr;
for a:=1 to 50 do begin write('*');
if a=20 then begin write('PROGRAMA CORO MUNICIPAL');end;
end;
writeln('');writeln('');
writeln(' MENU');
writeln('1) Cargar Datos en el Archivo');
writeln('2) Agregar Datos a los ya Existentes');
writeln('3) Generar una lista');
writeln('4) Modificar la fecha de presentaci¢n');
writeln('5) Imprimir archivo y lista');
writeln('6) Salir');
end;
procedure opc1;{Carga el archivo}
var
f,cod:integer;
begin
clrscr;
for a:=1 to 50 do begin write('*');
if a=20 then begin write('OPCION 1'); end;
end;
writeln;
writeln;writeln;
{$I-}
reset(arc);
{$I+}
if IOResult<>0 then begin
writeln('El archivo fue creado correctamente');writeln;
rewrite(arc);end
else begin
a:=filesize(arc);
writeln('El archivo fue abierto posee ',a,' Registros');
writeln('Si no desea sobreescribirlos ingrese 0');writeln;
end;
write('¨Cuantas Entradas desea a¤adir al archivo? ');readln(a);
for a:=a downto 1 do begin
writeln('Introduzca la informaci¢n de la presentaci¢n');writeln;
write('Provincia: ');readln(regis.prov);
write('Localidad: ');readln(regis.loc);
write('Nombre del lugar: ');readln(regis.noml);
write('Direcci¢n: ');readln(regis.dir);
write('Telefono: ');readln(regis.tel);
write('Fecha(dd/mm/aaaa): ');readln(regis.fech);
val(regis.fech,f,cod);
if cod<>0 then begin
writeln('Solo puede ingresar numeros');
write('Debe ingresar de nuevo la nueva fecha: ');readln(regis.fech);
end;
write(arc,regis);writeln;
end;
writeln;writeln;
close(arc);
end;
procedure opc2; {A¤ade otro registro en el archivo}
var
b,f,cod:integer;
begin
clrscr;
for a:=1 to 50 do begin write('*');
if a=20 then begin write('OPCION 2: Agregando Datos'); end;
end;
writeln;writeln;
{$I-}
reset(arc);
{$I+}
if IOResult<>0 then begin
rewrite(arc);
end;
b:=filesize(arc);
write('¨Cuantas Entradas desea a¤adir al archivo? ');readln(a);
seek(arc,b);
for a:=a downto 1 do begin
writeln('Introduzca la informaci¢n de la presentaci¢n');writeln;
write('Provincia: ');readln(regis.prov);
write('Localidad: ');readln(regis.loc);
write('Nombre del lugar: ');readln(regis.noml);
write('Direcci¢n: ');readln(regis.dir);
write('Telefono: ');readln(regis.tel);
write('Fecha(dd/mm/aaaa): ');readln(regis.fech);
val(regis.fech,f,cod);
if cod<>0 then begin
writeln('Solo puede ingresar numeros');
write('Debe ingresar de nuevo la nueva fecha: ');readln(regis.fech);
end;
write(arc,regis);writeln;
end;
close(arc);
writeln;
end;
procedure opc3;{Crea una lista ordenada por localidad}
var
nue,act,ant:lista;
fx,f:integer;
m:string;
begin
clrscr;
if op5<>1 then begin
for a:=1 to 50 do begin write('*');
if a=20 then begin write('OPCION 3'); end;
end;
end;
writeln;
{$I-}
reset(arc);
{$I+}
if IOResult<>0 then begin
writeln('No existe el archivo no puede realizar la opci¢n') end
else begin
fx:=filesize(arc);
l:=nil;
for f:=0 to fx do begin
if f1 then begin
for a:=1 to 40 do begin write('*');
if a=20 then begin write('OPCION 3: Ordenando por localidad'); end;
end;writeln;
end;
ant:=nil;
act:=l;
seek(arc,0);read(arc,regis);
m:=regis.loc;
for f:=0 to fx-1 do begin
while (act<>nil) and (m=act^.loc) do begin
ant:=act;
act:=act^.ps;
end;
end;
seek(arc,0);read(arc,regis);
while (l<>nil) do begin
writeln(l^.loc);
writeln(l^.prov);
writeln(l^.noml);
writeln(l^.fech);
end;
close(arc);
end;
end;
procedure opc4;{Modifica la fecha de alguna presentaci¢n}
var ax:reg;
fx,f,cod,m:integer;
begin
if op5<>1 then begin
clrscr;
for a:=1 to 50 do begin write('*');
if a=20 then begin write('OPCION 4'); end;
end;
writeln;
end;
{$I-}
reset(arc);
{$I+}
if IOResult<>0 then begin
writeln('No existe el archivo no puede realizar la opci¢n') end
else begin
seek(arc,0);
fx:=filesize(arc);
writeln('Presentaciones guardadas:');
for f:=1 to fx do begin
read(arc,regis);
writeln;
writeln(' Presentacion: ',f);
writeln('Fecha: ',regis.fech);
write(' Provincia:',regis.prov);writeln(' Localidad:',regis.loc);
write(' Nombre del lugar: ',regis.noml);write(' Direcci¢n:',regis.dir);
writeln(' Telefono: ',regis.tel);writeln;
end;
writeln;write(' ');
writeln('Cantidad de presentaciones: ',fx);writeln;
if op5<>1 then begin
write('¨Que presentaci¢n desea modificar? ');
{$I-}
readln(m);
{$I+}
if (m>fx) or (IOResult<>0) then begin
writeln('Introdujo un numero mayor al registro o un caracter invalido');
end else begin
assign(auxarc,'C:\proyec.txt');
rewrite(auxarc);
seek(arc,m-1);
read(arc,regis);
clrscr;
for a:=1 to 50 do begin write('*');
if a=20 then begin write('OPCION 4: Modificando Fecha'); end;
end;writeln;
writeln('Registro Actual:');
writeln(' Presentacion: ',m);
writeln('Fecha: ',regis.fech);
write(' Provincia:',regis.prov);writeln(' Localidad:',regis.loc);
write(' Nombre del lugar: ',regis.noml);write(' Dirección:',regis.dir);
writeln(' Telefono: ',regis.tel);writeln;
ax:=regis;
write('Ingrese nueva fecha: ');readln(ax.fech);
val(ax.fech,f,cod);
if cod<>0 then begin
writeln('Solo puede ingresar numeros');
write('Debe ingresar de nuevo la nueva fecha: ');readln(ax.fech);
end;
for f:=0 to filesize(arc)-1 do begin
seek(arc,f);
read(arc,regis);
if f=m-1 then begin
write(auxarc,ax);
end else begin
write(auxarc,regis);
end;
end;
erase(arc);
rename(auxarc,'C:\proyecto.txt');
regis.fech:=ax.fech;
write(arc,regis);
close(arc);
reset(arc);
seek(arc,m-1);writeln;
writeln('Registro Modificado:');
writeln(' Presentacion: ',m);
writeln('Fecha: ',regis.fech);
write(' Provincia:',regis.prov);writeln(' Localidad:',regis.loc);
write(' Nombre del lugar: ',regis.noml);write(' Direcci¢n:',regis.dir);
writeln(' Telefono: ',regis.tel);writeln;
end;
close(arc);
end;
end;
end;
procedure opc5;{Imprime la lista y el archivo}
var f:integer;
begin
clrscr;
for a:=1 to 50 do begin write('*');
if a=20 then begin write('OPCION 5'); end;
end;
writeln;writeln;
writeln('EL ARCHIVO CONTIENE:');writeln;
op5:=1;
if IOResult<>0 then begin
writeln('El archivo no existe no puede eleccionar esta opci¢n');writeln;
end else begin
writeln('1)Imprimir Archivo');
writeln('2)Imprimir Lista');writeln;
write('¨Que opcion desea realizar? ');readln(f);
case f of
1:opc4;
2:opc3;
end;
readln(regis.fech);
end;
op5:=0;
writeln;
end;
procedure opcion(op:integer);begin{Selecciona la opci¢n que se va a realizar}
case op of
1:opc1;
2:opc2;
3:opc3;
4:opc4;
5:opc5;
end;
end;
procedure eop;begin{Verifica que se elija una opcion correcta en el menú}
write('Elija la opcion a realizar: ');
{$I-}read(op);{$I+}
if IOResult<>0 then begin
writeln('Ingreso Un caracter invalido;');writeln;
eop;
end;
end;
begin{Programa Principal}
assign(arc,'C:\proyecto.txt');
repeat
menu;
eop;
opcion(op);
if op=6 then begin
writeln;writeln(' Ha Elegido Salir');writeln;
sn:='n';
end else begin
write('¨Desa realizar otra operación?(s/n): ');readln(sn);
end;
until (sn='n');
writeln;writeln;
write('Pulsar Cualquier Tecla para Salir');
readkey;
end.
En el procedimiento opc3 (que es el que resuelve la opcion c) no se que hacer para que cree la lista y la ordene por localidad lo unico que hace es presentar en pantalla la informacion tal cual esta en el archivo y no ordenada por localidad. todo lo demas hace lo que tiene que hacer pero si queres dale una revisada.
Desde ya gracias.
|