RE:Como hacer un menu en pascal
{El programa completo espero te ayude}
program menus;
uses
crt;
type
menu = array[1..6] of string[15];
string15 = string[15];
regalumnos = record
nombre : string[25];
ndenei : integer;
npiso : integer;
nplanta : integer;
end;
string25 = string[25];
var
alumnos : regalumnos;
f : file of regalumnos;
opcmenu : integer;
men : menu;
tec, tecla : char;
i1, lon, x1, y1, pxs, pys, px, py, long, i, x, y : integer;
sal, salir : boolean;
procedure marcador(xm, ym, t : integer; estado : boolean);
var
pon : integer;
begin
if xm > 70 then
xm := 70;
if ym > 28 then
ym := 28;
if xm < 1 then
xm := 1;
if ym < 1 then
ym := 1;
if estado = true then
begin
for pon := 0 to t - 1 do
begin
gotoxy(xm + pon,ym);write('-');
gotoxy(xm + pon,ym + 2);write('-');
end;
gotoxy(xm - 1,ym + 1);write('|');
gotoxy(xm + t,ym + 1);write('|');
end
else
begin
for pon := 0 to t - 1 do
begin
gotoxy(xm + pon,ym);write(' ');
gotoxy(xm + pon,ym + 2);write(' ');
end;
gotoxy(xm - 1,ym + 1);write(' ');
gotoxy(xm + t,ym + 1);write(' ');
end;
end;
function cadena_texto(xt, yt : integer;tipo : char) : string25;
var
dato : string25;
tec : char;
co : integer;
finis : boolean;
begin
co := 1;
fillchar(dato,26,' ');
gotoxy(xt,yt);
finis := false;
repeat
tec := readkey;
if tec <> #27 then
begin
if tipo in['t','T'] then
begin
if tec in[#65..#90,#97..#122,#164,#165,#32] then
begin
dato[co] := upcase(tec);
dato[0] := chr(co);
gotoxy(xt + (co - 1),yt);write(dato[co]);
co := co + 1;
if co > 25 then
co := 25;
end;
end;
if tipo in['n','N'] then
begin
if tec in[#48..#57] then
begin
dato[co] := tec;
dato[0] := chr(co);
gotoxy(xt + (co - 1),yt);write(dato[co]);
co := co + 1;
if co > 25 then
co := 25;
end;
end;
if tec = #8 then
begin
co := co - 1;
if co < 1 then
co := 1;
dato[co] := ' ';
dato[0] := chr(co);
gotoxy(xt + (co - 1),yt);write(dato[co]);
end;
if tec = #13 then
begin
finis := true;
end;
end;
until (finis = true) or (tec = #27);
if finis = true then
begin
cadena_texto := copy(dato,1,length(dato));
end
else
begin
cadena_texto := ' ';
end;
end;
procedure entrada_datos_alumno;
var
pul : char;
final : boolean;
nu, erro : integer;
begin
gotoxy(2,2);write('*** Entre datos Ficha Alumno ***');
gotoxy(2,4);write('Nombre : ');
gotoxy(2,6);write('N§ DNI : ');
gotoxy(2,8);write('N§ Piso : ');
gotoxy(2,10);write('N§ Planta : ');
repeat
alumnos.nombre := cadena_texto(13,4,'t');
nu := 0;
val(cadena_texto(13,6,'n'),nu, erro);
alumnos.ndenei := nu;
nu := 0;
val(cadena_texto(13,8,'n'),nu, erro);
alumnos.npiso := nu;
nu := 0;
val(cadena_texto(13,10,'n'),nu, erro);
alumnos.nplanta := nu;
assign(f,'Archivos.aln');
{$I-} reset(f); {$I+}
if ioresult <> 0 then
begin
rewrite(f);
seek(f,0);
write(f,alumnos);
close(f);
end
else
begin
seek(f,filesize(f));
write(f,alumnos);
close(f);
end;
gotoxy(4,12);write('Desea Entrar mas Fichas [S/N]');
repeat
pul := readkey;
if pul in['n','N'] then
begin
clrscr;
final := true;
end;
if pul in['s','S'] then
begin
gotoxy(13,4); clreol;
gotoxy(13,6); clreol;
gotoxy(13,8); clreol;
gotoxy(13,10); clreol;
gotoxy(4,12); clreol;
end;
until pul in['s','S','n','N']
until final = true;
end;
procedure presenta_alumnos_por_planta(cual : char);
var
hh, erro, contador, planta1, planta : integer;
begin
assign(f,'Archivos.aln');
{$I-} reset(f); {$I+}
if ioresult <> 0 then
begin
clrscr;
gotoxy(5,15);write('*** Error *** No Esiste Archivo de Alumnos',
' [Pulse una tecla]');
repeat until keypressed;
halt(1);
end
else
begin
planta := 0;
planta1 := 0;
if cual in['p','P'] then
begin
gotoxy(2,2);write('*** Alumnos por Planta ***');
gotoxy(2,4);write('Entre N§ Planta : ');
val(cadena_texto(19,4,'n'),planta,erro);
end;
if cual in['s','S'] then
begin
gotoxy(2,2);write('*** Alumnos por Salon y Planta ***');
gotoxy(2,4);write('Entre N§ Salon : ');
val(cadena_texto(18,4,'n'),planta,erro);
gotoxy(2,6);write('Entre N§ Planta : ');
val(cadena_texto(19,6,'n'),planta1,erro);
end;
hh := 0;
contador := 0;
repeat
seek(f,hh);
read(f,alumnos);
if cual in['p','P'] then
begin
if alumnos.nplanta = planta then
begin
contador := contador + 1;
end;
end;
if cual in['s','S'] then
begin
if (alumnos.npiso = planta) and (alumnos.nplanta = planta1) then
begin
contador := contador + 1;
end;
end;
hh := hh + 1;
until hh > filesize(f) - 1;
close(f);
clrscr;
if cual in['p','P'] then
begin
gotoxy(2,2);write('*** El N§ de Alumnos de la Planta [',planta,'] ***');
gotoxy(2,4);write(' ES : ',contador);
end;
if cual in['s','S'] then
begin
gotoxy(2,2);write('*** El N§ de Alumnos del Piso [',planta,'] Salon [',planta1,'] ***');
gotoxy(2,4);write(' ES : ',contador);
end;
gotoxy(2,7);write(' <<< Pulse Enter >>>');
readln;
end;
end;
procedure menugeneral(xm, ym : integer;dato1,dato2,dato3,dato4,dato5,dato6 : string15;
longi, datos : integer);
begin
clrscr;
x := xm;
y := ym;
men[1] := dato1;
men[2] := dato2;
men[3] := dato3;
men[4] := dato4;
men[5] := dato5;
men[6] := dato6;
long := longi;
for i := 1 to datos do
begin
gotoxy(x,(y - 1) + i * 2);write(men[i]);
end;
gotoxy(x,(y - 1) + (i * 2) + 4);write('** MENU GENERAL **');
marcador(x,y,long,true);
salir := false;
i := datos;
opcmenu := 1;
gotoxy(xm,ym - 2);write('Use las flechas [ ][ ] y Enter');
gotoxy(xm + 17,ym - 2);write(chr(24));
gotoxy(xm + 20,ym - 2);write(chr(25));
gotoxy(x + (long + 1) ,y + 1);
repeat
tecla := readkey;
marcador(x,y,long,false);
if tecla = #80 then
begin
y := y + 2;
if y > datos + ((i - 1) * 2) then
y := datos + ((i - 1) * 2);
opcmenu := opcmenu + 1;
if opcmenu > i then
opcmenu := i;
end;
if tecla = #72 then
begin
y := y - 2;
if y < datos then
y := datos;
opcmenu := opcmenu - 1;
if opcmenu < 1 then
opcmenu := 1;
end;
if tecla = #13 then
begin
case opcmenu of
1 : begin
clrscr;
px := x;
py := y;
entrada_datos_alumno;
clrscr;
x := xm;
y := ym;
for i := 1 to datos do
begin
gotoxy(x,(y - 1) + i * 2);write(men[i]);
end;
gotoxy(xm,ym - 2);write('Use las flechas [ ][ ] y Enter');
gotoxy(xm + 17,ym - 2);write(chr(24));
gotoxy(xm + 20,ym - 2);write(chr(25));
gotoxy(x,(y - 1) + (i * 2) + 4);write('** MENU GENERAL **');
x := px;
y := py;
end;
2 : begin
clrscr;
px := x;
py := y;
presenta_alumnos_por_planta('p');
clrscr;
x := xm;
y := ym;
for i := 1 to datos do
begin
gotoxy(x,(y - 1) + i * 2);write(men[i]);
end;
gotoxy(xm,ym - 2);write('Use las flechas [ ][ ] y Enter');
gotoxy(xm + 17,ym - 2);write(chr(24));
gotoxy(xm + 20,ym - 2);write(chr(25));
gotoxy(x,(y - 1) + (i * 2) + 4);write('** MENU GENERAL **');
x := px;
y := py;
end;
3 : begin
clrscr;
px := x;
py := y;
presenta_alumnos_por_planta('s');
clrscr;
x := xm;
y := ym;
for i := 1 to datos do
begin
gotoxy(x,(y - 1) + i * 2);write(men[i]);
end;
gotoxy(xm,ym - 2);write('Use las flechas [ ][ ] y Enter');
gotoxy(xm + 17,ym - 2);write(chr(24));
gotoxy(xm + 20,ym - 2);write(chr(25));
gotoxy(x,(y - 1) + (i * 2) + 4);write('** MENU GENERAL **');
x := px;
y := py;
end;
4 : begin
clrscr;
px := x;
py := y;
assign(f,'Archivos.aln');
{$I-} reset(f); {$I+}
if ioresult <> 0 then
begin
exit;
end
else
begin
gotoxy(2,3);write('*** La Totalidad de Alumnos ***');
gotoxy(2,5);write('Es : ',filesize(f));
gotoxy(2,8);write('<<< Pulse Una Tecla Para Segir >>>');
repeat until keypressed;
close(f);
clrscr;
end;
x := xm;
y := ym;
for i := 1 to datos do
begin
gotoxy(x,(y - 1) + i * 2);write(men[i]);
end;
gotoxy(xm,ym - 2);write('Use las flechas [ ][ ] y Enter');
gotoxy(xm + 17,ym - 2);write(chr(24));
gotoxy(xm + 20,ym - 2);write(chr(25));
gotoxy(x,(y - 1) + (i * 2) + 4);write('** MENU GENERAL **');
x := px;
y := py;
end;
5 : salir := true;
end;
end;
marcador(x,y,long,true);
until salir = true;
end;
begin
menugeneral(4,4,'Entrada Alumno','Datos Por Planta','Datos Por Salon ',
'Alumnos Totales','Terminar Sesion',' ',16,5);
end.