{Mira es esto }
program arrypunt;
uses
crt;
const
tipo_esamen : array['A'..'D'] of string = (
'Matematicas',
'Fisica',
'Quimica',
'Naturaleza');
type
info_lista = record
fecha : string[10];
nota : real;
tipo : char;
end;
losalumnos = ^alumnos;
alumnos = record
alumno : string;
n_leg : string[8];
ap_nom : string[40];
nodo : info_lista;
sig : losalumnos;
end;
var
prim, actu, ulti : losalumnos;
datos : alumnos;
orden, paso : losalumnos;
alum : string;
procedure entrada_datos(var datos : alumnos);
begin
writeln('**** Entrada De Datos Alumno ****'); writeln;
with datos do
begin
write(' Entre Alumno : '); readln(alumno);
write(' Entre Num. Legajo : '); readln(n_leg);
write(' Entre Apellido y Nombre : '); readln(ap_nom);
write(' Entre Fecha Formt d/m/a : '); readln(nodo.fecha);
write(' Entre Nota : '); readln(nodo.nota);
write(' Entre Tipo A/B/C/D : '); readln(nodo.tipo);
nodo.tipo := upcase(nodo.tipo);
end;
end;
procedure asigna_puntero(dd : alumnos);
begin
if prim = nil then
begin
new(actu);
actu^ := dd;
prim := actu;
actu^.sig := nil;
end
else
begin
ulti := actu;
new(actu);
actu^ := dd;
ulti^.sig := actu;
actu^.sig := nil;
end;
end;
procedure borrado(b : string;var que : losalumnos);
var
ant, act : losalumnos;
locali : boolean;
begin
locali := false;
ant := nil;
act := prim;
while (act <> nil) and (locali <> true) do
begin
if act^.alumno = b then
locali := true
else
begin
ant := act;
act := act^.sig;
end;
end;
if locali = true then
begin
if ant = nil then
begin
prim := act^.sig;
act^.sig := nil;
end
else
begin
if act^.sig = nil then
begin
ant^.sig := nil;
act := nil;
end
else
begin
ant^.sig := act^.sig;
act^.sig := nil;
end;
end;
que := ant;
end;
end;
procedure muestra_alumnos;
var
ver : losalumnos;
tecla : char;
begin
ver := prim;
while ver <> nil do
begin
writeln(' ',ver^.alumno); writeln(' ',ver^.n_leg); writeln(' ',ver^.ap_nom); writeln(' ',ver^.nodo.fecha); writeln(' ',ver^.nodo.nota:0:2); writeln(' ',tipo_esamen[ver^.nodo.tipo]); writeln;
writeln(' *** Pulse una tecla para ver mas o [ESC] Salir ***'); repeat
tecla := readkey;
until tecla in[#32,#27];
if tecla = #27 then
break;
ver := ver^.sig;
end;
end;
procedure insertadoorden(var cu : losalumnos; don : losalumnos);
var
at, ps, tomcu, tomdon : losalumnos;
si : boolean;
begin
ps := prim;
at := nil;
si := false;
tomcu := cu;
tomdon := don;
while (ps <> nil) and (si <> true) do
begin
if ps^.alumno = cu^.alumno then
si := true
else
begin
at := ps;
ps := ps^.sig;
end;
end;
if si = true then
begin
borrado(ps^.alumno,paso);
if paso^.sig <> nil then
begin
don^.sig := paso^.sig;
paso^.sig := don;
end
else
begin
don := paso;
don^.sig := nil;
paso := nil;
prim := don;
end;
end;
end;
procedure ordenademenosamas;
var
temp : integer;
ren, ver : losalumnos;
begin
ver := prim;
while ver <> nil do
begin
ren := ver^.sig;
while ren <> nil do
begin
with ren^ do
if ver^.alumno > ren^.alumno then
begin
insertadoorden(ver, ren);
end;
ren := ren^.sig;
end;
ver := ver^.sig;
end;
end;
procedure menu;
var
tec : char;
sal : boolean;
begin
sal := false;
repeat
clrscr;
writeln('***** Menu Jeneras *****'); writeln;
writeln(' 1 = Entrada Alumno'); writeln(' 2 = Anular Alumno'); writeln(' 3 = Ver Alumnos'); writeln(' 4 = Ordenar Alumnos'); writeln(' 5 = Salir'); writeln;
writeln('<<<< Elija Opcion >>>>'); repeat
tec := readkey;
until tec in['1','2','3','4','5'];
clrscr;
case tec of
'1' : begin
entrada_datos(datos);
asigna_puntero(datos);
end;
'2' : begin
writeln('***** Borrado De Un Alumno *****'); writeln;
write(' Entre Alumno : '); readln(alum);
borrado(alum,orden);
end;
'3' : muestra_alumnos;
'4' : ordenademenosamas;
'5' : sal := true;
end;
until sal = true;
if prim <> nil then
dispose(actu);
end;
begin
prim := nil;
menu;
end.
Crear cuenta