Crear fichero binario y ordenacion
{Algo asín te vale}
program abinario;
uses
crt;
type
tnombre = string[50];
talumno = record
nombre : tnombre;
expediente : longint;
curso : integer;
becaprevia : boolean;
end;
tclase = array[0..100] of talumno;
tlistaclase = record
listaclase : tclase;
contador : integer;
end;
const
archivo : string = 'Alumnos.bin';
var
tficheroclases : file of tlistaclase;
entra : tlistaclase;
cont : integer;
tecla : char;
dat : string[2];
procedure entradas;
var
no : boolean;
begin
clrscr;
cont := 0;
gotoxy(2,2);write('*** ENTRADA DATOS ALUMNO ***');
gotoxy(2,3);write(' -------------------- ');
gotoxy(2,5);write('Nombre : ');
gotoxy(2,6);write('Expediente : ');
gotoxy(2,7);write('Curso : ');
gotoxy(2,8);write('Beca [si/no] : ');
no := false;
repeat
gotoxy(17,5);readln(entra.listaclase[cont].nombre);
gotoxy(17,6);readln(entra.listaclase[cont].expediente);
gotoxy(17,7);readln(entra.listaclase[cont].curso);
gotoxy(17,8);readln(dat);
if (dat = 'Si') or (dat = 'si') or (dat = 'sI') or (dat = 'SI') then
entra.listaclase[cont].becaprevia := true;
if (dat = 'No') or (dat = 'no') or (dat = 'nO') or (dat = 'NO') then
entra.listaclase[cont].becaprevia := false;
gotoxy(2,12);write('Desea Entrar Mas Alumnos [S/N]');
repeat
tecla := readkey;
until tecla in['s','S','n','N'];
if tecla in['n','N'] then
begin
no := true;
end;
if tecla in['s','S'] then
begin
cont := cont + 1;
if cont > 100 then
cont := 100;
gotoxy(17,5);clreol;
gotoxy(17,6);clreol;
gotoxy(17,7);clreol;
gotoxy(17,8);clreol;
gotoxy(2,12);clreol;
end;
until no = true;
entra.contador := cont;
assign(tficheroclases,'c:\tp\' + archivo);
rewrite(tficheroclases);
seek(tficheroclases,0);
write(tficheroclases,entra);
close(tficheroclases);
end;
procedure visualizar;
var
i, zs : integer;
tc : char;
begin
assign(tficheroclases,'c:\tp\' + archivo);
{$I-} reset(tficheroclases); {$I+}
if ioresult <> 0 then
begin
clrscr;
gotoxy(10,5);write('El Archivo Nombre ',archivo,' No Existe');
gotoxy(10,7);write('Pulse [Enter]');
readln;
exit;
end
else
begin
i := 0;
seek(tficheroclases,0);
read(tficheroclases,entra);
close(tficheroclases);
zs := entra.contador;
repeat
clrscr;
writeln(' ***** DATOS ALUMNOS TOTAL = ',zs + 1,' *****');
writeln;
writeln(' NOMBRE : ',entra.listaclase[i].nombre);
writeln(' EXPEDIENTE : ',entra.listaclase[i].expediente);
writeln(' CURSO : ',entra.listaclase[i].curso);
writeln(' VECA : ',entra.listaclase[i].becaprevia);
writeln;
writeln(' USE LAS TECLAS [',chr(24),chr(25),'] O [ESC] SALIR');
tc := readkey;
if tc = #80 then
begin
i := i + 1;
if i > zs then
i := zs;
end;
if tc = #72 then
begin
i := i - 1;
if i < 0 then
i := 0;
end;
until tc = #27;
end;
end;
procedure ordenar;
var
orde : string[6];
numert : longint;
nomt : tnombre;
vect : boolean;
tiene, j, i : integer;
aux : talumno;
begin
clrscr;
gotoxy(10,2);write('**** ORDENACION ALUMNOS ****');
gotoxy(10,4);write('ENTRE ORDENACION POR [NUMERO] POR [NOMBRE] POR [VECA]');
readln(orde);
assign(tficheroclases,'c:\tp\' + archivo);
{$I-} reset(tficheroclases); {$I+}
if ioresult <> 0 then
begin
clrscr;
gotoxy(10,5);write('El Archivo Nombre ',archivo,' No Existe');
gotoxy(10,7);write('Pulse [Enter]');
readln;
exit;
end
else
begin
seek(tficheroclases,0);
read(tficheroclases,entra);
tiene := entra.contador;
for i := 1 to length(orde) do
begin
orde[i] := upcase(orde[i]);
end;
i := 0;
if orde = 'NUMERO' then
begin
for i := 0 to tiene - 1 do
for j := i + 1 to tiene do
if (entra.listaclase[i].expediente > entra.listaclase[j].expediente) then
begin
aux := entra.listaclase[j];
entra.listaclase[j] := entra.listaclase[i];
entra.listaclase[i] := aux;
end;
end;
if orde = 'NOMBRE' then
begin
for i := 0 to tiene - 1 do
for j := i + 1 to tiene do
if (entra.listaclase[i].nombre > entra.listaclase[j].nombre) then
begin
aux := entra.listaclase[j];
entra.listaclase[j] := entra.listaclase[i];
entra.listaclase[i] := aux;
end;
end;
if orde = 'VECA' then
begin
for i := 0 to tiene - 1 do
for j := i + 1 to tiene do
if (entra.listaclase[i].becaprevia < entra.listaclase[j].becaprevia) then
begin
aux := entra.listaclase[j];
entra.listaclase[j] := entra.listaclase[i];
entra.listaclase[i] := aux;
end;
end;
seek(tficheroclases,0);
write(tficheroclases,entra);
close(tficheroclases);
end;
end;
procedure marcamenu(x, y : integer;estado : boolean);
begin
if estado = true then
begin
gotoxy(x + 1,y - 1);write('-----------------');
gotoxy(x,y);write('|');
gotoxy(x + 18,y);write('|');
gotoxy(x + 1,y + 1);write('-----------------');
end
else
begin
gotoxy(x + 1,y - 1);write(' ');
gotoxy(x,y);write(' ');
gotoxy(x + 18,y);write(' ');
gotoxy(x + 1,y + 1);write(' ');
end;
end;
procedure menu;
var
salir : boolean;
tmen : char;
x, y, opci : integer;
begin
salir := false;
x := 5;
y := 4;
opci := 1;
repeat
gotoxy(5,2);write('*** MENU GENERAL ***');
gotoxy(5,4);write(' Entrada Datos');
gotoxy(5,6);write(' Visualizar Datos');
gotoxy(5,8);write(' Ordenar Datos');
gotoxy(5,10);write(' Salir');
gotoxy(5,14);write('Elija Opcion Con [',chr(25),chr(24),'] Y [Enter]');
marcamenu(x,y,true);
tmen := readkey;
marcamenu(x,y,false);
if tmen = #80 then
begin
y := y + 2;
if y > 10 then
y := 10;
opci := opci + 1;
if opci > 4 then
opci := 4;
end;
if tmen = #72 then
begin
y := y - 2;
if y < 4 then
y := 4;
opci := opci - 1;
if opci < 1 then
opci := 1;
end;
if tmen = #13 then
begin
case opci of
1 : entradas;
2 : visualizar;
3 : ordenar;
4 : salir := true;
end;
end;
clrscr;
until salir = true;
end;
begin
clrscr;
menu;
end.
