4
« en: Lunes 3 de Mayo de 2004, 17:20 »
Alli te va un ejemplo de menús que regresan a otros menús. El nomgre de usuario es administrador y a contrraseña es 123
Si el fdelay del uses te da problema quitáselo. Aquí en internet aparecen unos signos raros pero en modo DOS deben aparecer los ASCII adecuados para marcos.
Tambien va como archivo adjunto.
program ProyectoFinal;
uses dos,fdelay,crt;
var
menup:char;
exit:boolean;
{----------------------------------------------------------------------------}
{ dibuja el marco del men£ de opciones del programa }
procedure MenuOpciones;
var x,y:byte;
opcion:char;
begin
clrscr;
{ bordes horizontales y verticales }
textcolor(13);
for y:= 11 to 17 do
begin
gotoxy(24,y); write('º');
end;
for y:= 11 to 17 do
begin
gotoxy(55,y); write('º');
end;
for x:= 25 to 55 do
begin
gotoxy(x,10); write('Í');
end;
for x:= 25 to 55 do
begin
gotoxy(x,18); write('Í');
end;
for x:= 25 to 55 do
begin
gotoxy(x,12); write('Í');
end;
for x:= 25 to 55 do
begin
gotoxy(x,16); write('Í');
end;
{ conectores de esquina e intersecci¢n }
gotoxy(24,12); write('Ì'); gotoxy(55,12); write('¹');
gotoxy(55,10); write('»'); gotoxy(24,18); write('È');
gotoxy(24,10); write('É'); gotoxy(55,18); write('¼');
gotoxy(24,16); write('Ì'); gotoxy(55,16); write('¹');
{ textos de t¡tulo y opci¢n m£ltiple }
textcolor(03); GOTOXY(26,9);
write('PROGRAMA ®CONTROL DE BODEGA¯');
textcolor(08);
gotoxy(26,11); write('M E N U D E O P C I O N E S');
gotoxy(26,13); write('1 - Ingresar al programa');
gotoxy(26,15); write('2 - salir');
gotoxy(26,17); write('Seleccione una opci¢n: '); opcion:=readkey;
case opcion of
'1': write('dlgIngresa');
'2': exit:=true;
end;
end;
{----------------------------------------------------------------------------}
{ dibuja el cuadro de contrase¤a }
procedure dlgIngresar;
var
x,y,i:integer;
clave,usuario,letra:string;
tecla:string[1];
listo:boolean;
begin
clrscr;
{ bordes horizontales y verticales }
textcolor(07);
for y:= 11 to 15 do
begin
gotoxy(20,y); write('º');
end;
for y:= 11 to 15 do
begin
gotoxy(58,y); write('º');
end;
for x:= 21 to 58 do
begin
gotoxy(x,10); write('Í');
end;
for x:= 21 to 58 do
begin
gotoxy(x,12); write('Í');
end;
for x:= 21 to 58 do
begin
gotoxy(x,16); write('Í');
end;
{ conectores de esquina e intersecci¢n }
gotoxy(20,12); write('Ì'); gotoxy(58,12); write('¹');
gotoxy(58,10); write('»'); gotoxy(20,16); write('È');
gotoxy(20,10); write('É'); gotoxy(58,16); write('¼');
{ textos de t¡tulo e INGRESOS }
textcolor(12);
gotoxy(22,11); write('I N G R E S O D E U S U A R I O');
gotoxy(22,13); write('Usuario:');
gotoxy(22,15); write(' Clave:');
textcolor(15);
gotoxy(31,13); read(usuario);
gotoxy(31,15);
{ En la l¡nea anterior deb¡a leerse la contrase¤a, pero
debido a un error (inexplicable) de Pascal, fue necesario
colocar la petici¢n dentro de un ciclo y letra por letra.
Error que fue aprovechado para darle algunos retoques
al procedimiento:
1. Aparecen asteriscos por cada tecla pulsada
2. Se valida la contrase¤a al pulsar <ENTER> o bien,
3. Al haber pulsado 15 teclas
El nombre de usuario y la contrase¤a est n predefinidos,
pero podr¡an leerse de un archivo de texto cifrado (mediante
el cl sico proceso de multiplicar por una matriz num‚rica),
pero eso no es parte del proyecto: "ley del m¡nimo esfuerzo" }
clave:=''; tecla:='';
i:=0;
listo:=false;
repeat
begin
tecla:=readkey;
letra:=tecla;
if letra<>chr(13) then
begin
write('*');
clave:=clave+tecla;
end
else
listo:=true;
i:=i+1;
if i=15 then listo:=true;
end;
until listo=true;
readln;
if usuario = 'administrador' then
begin
gotoxy(31,17); write('Usuario correcto');
delay(2000);
end
else
begin
textcolor(20);
gotoxy(31,17); write('Usuario incorrecto');
delay(2000);
exit:=false;
end;
if clave = '123' then
MenuOpciones
else
begin
textcolor(20);
gotoxy(31,18); writeln('Clave incorrecta');
delay(5000);
exit:=false;
end;
end;
{----------------------------------------------------------------------------}
{ dibuja el marco del men£ principal }
procedure dlgMainmenu;
var x,y:integer;
begin
{ bordes horizontales y verticales }
textcolor(14);
for y:= 11 to 17 do
begin
gotoxy(24,y); write('º');
end;
for y:= 11 to 17 do
begin
gotoxy(55,y); write('º');
end;
for x:= 25 to 54 do
begin
gotoxy(x,10); write('Í');
end;
for x:= 25 to 54 do
begin
gotoxy(x,18); write('Í');
end;
for x:= 25 to 54 do
begin
gotoxy(x,12); write('Í');
end;
for x:= 25 to 54 do
begin
gotoxy(x,16); write('Í');
end;
{ conectores de esquina e intersecci¢n }
gotoxy(24,12); write('Ì'); gotoxy(55,12); write('¹');
gotoxy(55,10); write('»'); gotoxy(24,18); write('È');
gotoxy(24,10); write('É'); gotoxy(55,18); write('¼');
gotoxy(24,16); write('Ì'); gotoxy(55,16); write('¹');
{ textos de t¡tulo y opci¢n m£ltiple }
textcolor(04); GOTOXY(26,9);
write('PROGRAMA ®CONTROL DE BODEGA¯');
textcolor(09);
gotoxy(26,11); write('M E N U P R I N C I P A L');
gotoxy(26,13); write('1 - Ingresar al programa');
gotoxy(26,15); write('2 - salir');
gotoxy(26,17); write('Seleccione una opci¢n: '); menup:=readkey;
case menup of
'1': dlgIngresar;
'2': exit:=true;
end;
end;
{----------------------------------------------------------------------------}
{ SplashScreen con ProgressBar... viva Visual Basic 6.0 ! }
procedure SplashScreen;
var x,y:byte;
percent:real;
begin
textcolor(10);
for y:= 08 to 18 do
begin
for x:=11 to 70 do
begin
gotoxy(x,y);
write('±');
end;
end;
for x:= 21 to 60 do
begin
gotoxy(x,16); write(' ');
end;
textcolor(14);
gotoxy(16,09); write(' UNIVERSIDAD MARIANO GALVEZ ');
gotoxy(16,10); write('Facultad de Ingenier¡a en Sistemas de Informaci¢n ');
gotoxy(16,11); write(' Algoritmos I --- Ing. David Gonz lez ');
gotoxy(16,13); write(' PROYECTO FINAL 2004 --- CONTROL DE BODEGA ');
gotoxy(16,14); write('Augusto Jos‚ Blanco G lvez 0900-04-317 Secci¢n C');
for x:= 21 to 60 do
begin
gotoxy(x,16); write('²'); delay(900);
percent:=(x-20)*100/40; gotoxy(33,17); write('Loading... ',percent:0:0,' %');
end;
end;
{----------------------------------------------------------------------------}
{ cuerpo del programa }
begin
{ llama al SplashScreen}
clrscr;
SplashScreen;
{ llama al men£ principal }
clrscr;
repeat
clrscr;
dlgMainmenu;
until exit=true;
clrscr;
end.