P13.4.- Se desean procesar los datos de los alumnos de un instituto por medio de un array de registros. El registro se diseñará de manera que pueda contener los siguiente datos:

NOMBRE DEL ALUMNO

CURSO

EDAD

CALIFICACION MEDIA DEL CURSO ANTERIOR

Deben posibilitarse las siguientes opciones:

Captura de datos.

Ordenación de los mismos por curso y nombre.

Búsqueda de un alumno por su nombre y visualización de su ficha.

Listado de los alumnos cuya calificación media del curso anterior sea mayor o igual a 8.5.

program instituto134;

uses crt;

const

n=10;

type

tregistro=record

nombre:string[10];

apellidos:string[20];

curso:string;

edad:integer;

calif:real;

end;

tarray=array [1..n] of tregistro;

var

alumnos:tarray;

opc:char;

{este procedimiento inicializa el registro}

procedure inicializar ( var a:tarray);

var

i:integer;

begin

for i:=1 to n do

begin

a[i].nombre:='';

a[i].apellidos:='';

a[i].curso:='';

a[i].edad:=-1;

a[i].calif:=-1

end

end;

{********************************************}

{presenta el menu de opciones, y devuelve la opci¢n elegida}

procedure menu (var ch:char);

begin

repeat

clrscr;

writeln ('1 - CAPTURAR DATOS');

writeln ('2 - ORDENACIàN');

writeln ('3 - BUSCAR ALUMNO');

writeln ('4 - LISTADO DE ALUMNOS CON NOTA SUPERIOR A 8.5');

writeln ('0 - SALIR');

write ('Seleccione una opci¢n: ');

ch:=upcase (readkey);

until (ch='0') or (ch='1') or (ch='2') or (ch='3') or (ch='4')

end;

{***********************************************************}

{este procedimiento transforma los datos tipo cadena en mayusculas}

function mayusculas (c:string):string;

var

i:integer;

begin

for i:=1 to length (c) do

begin

c[i]:=upcase (c[i])

end;

mayusculas:=c

end;

{****************************************************************}

{este procedimiento recoge los datos del alumno}

procedure capturardatos (var a:tarray);

var

i:integer;

opc:char;

aux:string;

begin

i:=0;

repeat

clrscr;

i:=i+1;

write ('Nombre: '); readln (aux);

a[i].nombre:=mayusculas (aux);

write ('Apellidos: '); readln (aux);

a[i].apellidos:=mayusculas (aux);

write ('Curso: ');readln (a[i].curso);

write ('Edad: '); readln (a[i].edad);

write ('Calificaci¢n del a¤o anterior: '); readln (a[i].calif);

write ('¨Mas alumnos (S/N)?');opc:=upcase(readkey);

until (opc='N')

end;

{************************************************}

{este procedimiento ordena los registros por los campos curso y nombre}

procedure ordenar (a:tarray);

var

i,j:integer;

aux:tregistro;

enco:boolean;

begin

for j:=2 to n do

begin

aux.apellidos:=a[j].apellidos; i:=j-1; enco:=false;

while (i>0) and (enco=false) do

begin

if (aux.apellidos<a[i].apellidos) then

begin

a[i+1]:=a[i];

i:=i-1

end

else

enco:=true

end;

a[i+1]:=aux

end;

end;

{**********************************************************}

{Este procedimiento busca el alumno , por el campo nombre}

procedure buscaralumno (a:tarray);

var

aux:string;

i:integer;

enco:boolean;

begin

clrscr;

write ('Introduzca los apellidos del alumno: ');

readln (aux);

aux:=mayusculas(aux);

i:=1;

enco:=false;

while (enco=false) and (i<=n) do

begin

if (mayusculas(a[i].apellidos))= aux then

enco:=true

else

i:=i+1;

end;

if enco=true then

begin

writeln (a[i].nombre);

writeln (a[i].apellidos);

writeln (a[i].curso);

writeln (a[i].edad);

writeln (a[i].calif)

end

else

write ('El alumno buscado no existe');

readkey

end;

{********************************}

{este procedimiento hace un listado de los alumnos}

procedure listado (a:tarray);

var

i:integer;

begin

clrscr;

for i:=1 to n do

begin

if a[i].calif>=8.5 then

begin

{gotoxy (2,10);} write (a[i].nombre,' ');

{gotoxy (4,10);} write (a[i].apellidos,' ');

{gotoxy (6,10);} write (a[i].curso,' ');

{gotoxy (8,10);} write (a[i].edad:5);

{gotoxy (10,10);} writeln (a[i].calif:5:2)

end

end;

readkey

end;

PROGRAMA PRINCIPAL

begin

clrscr;

inicializar (alumnos);

repeat

menu(opc);

case opc of

'1': capturardatos (alumnos);

'2': ordenar (alumnos);

'3': buscaralumno (alumnos);

'4': listado (alumnos);

end;

until (opc='0')

end.