program proyecto_dos;
uses
crt;
const
n=3;
type
arreglo=array [1..n] of integer;
str5=string[1];
var
hexa:arreglo;
numerouno,numerodos,numerotres:str5;
opcion:char;
i,acarreoo:byte;
hexaa:char;
resp:char;
c:integer;
hexa1,hexa2,hexa3:char;
acarreo:char;
function validarhexa(hexaa:char):integer;
begin
if (ord(hexaa)=49)
then validarhexa:=1
else
if (ord(hexaa)=50)
then validarhexa:=2
else
if (ord(hexaa)=51)
then validarhexa:=3
else
if (ord(hexaa)=52)
then validarhexa:=4
else
if (ord(hexaa)=53)
then validarhexa:=5
else
if (ord(hexaa)=54)
then validarhexa:=6
else
if (ord(hexaa)=55)
then validarhexa:=7
else
if (ord(hexaa)=56)
then validarhexa:=8
else
if (ord(hexaa)=57)
then validarhexa:=9
else
if (ord(hexaa)=65) or (ord(hexaa)=97)
then validarhexa:=10
else
if (ord(hexaa)>=66) or (ord(hexaa)=98)
then validarhexa:=11
else
if (ord(hexaa)=67) or (ord(hexaa)=99)
then validarhexa:=12
else
if (ord(hexaa)=68) or (ord(hexaa)=100)
then validarhexa:=13
else
if (ord(hexaa)=69) or (ord(hexaa)=101)
then validarhexa:=14
else
if (ord(hexaa)=70) or (ord(hexaa)=102)
then validarhexa:=15
else validarhexa:=0;
end;
procedure incluir;
begin
writeln('Diga el primer numero hexadecimal:');
readln(numerouno);
writeln('Diga el segundo numero hexadecimal:');
readln(numerodos);
writeln('Diga el tercer numero hexadecimal: ');
readln(numerotres);
gotoxy(10,20);
writeln('NOTA:');
writeln('El numero hexadecimal debe ser de 5 digitos');
readkey;
end;
procedure inicializar;
begin
hexa1:='"';
hexa2:='"';
hexa3:='"';
end;
procedure calculo(c,i:integer;numerouno,numerodos,numerotres:string;var hexa1,hexa2,hexa3:char;var hexa:arreglo);
begin
c:=1;
for i:=0 to n do
begin
hexa1:=numerouno[c];
hexa2:=numerodos[c];
hexa3:=numerotres[c];
hexa[i]:=validarhexa(hexa1)+validarhexa(hexa2)+validarhexa(hexa3)+validarhexa(acarreo);
if(hexa[i]>=16)
then
begin
hexa[i]:=hexa[i]-16;
acarreoo:=validarhexa(acarreo)+ 1;
end;
c:=c-1;
inc(i);
end;
writeln('Sumado');
readkey;
end;
procedure imprimir;
begin
write('Resultado Suma: ');
for i:=1 to n do
begin
write(hexa[i]);
end;
readkey;
end;
procedure menu;
begin
textcolor (black) ;
while (opcion<> '4') do
begin
textbackground(white);
clrscr;
writeln;
writeln;
textcolor(red);
writeln(' ====== M E N U ====== ');
textcolor(black);
writeln;
writeln;
writeln(' 1... Incluir');
writeln(' 2... Sumar');
writeln(' 3... Imprimir');
writeln(' 4... Salir');
writeln;
textcolor(3);
writeln('Elije una opcion:');
textcolor(black);
opcion:=readkey;
case opcion of
'1': incluir;
'2': calculo(c,i,numerouno,numerodos,numerotres,hexa1,hexa2,hexa3,hexa);
'3': imprimir;
'4': begin
clrscr;
gotoxy(28,8);
textcolor(3);
writeln('Seguro que desea salir?');
textcolor(black);
gotoxy(22,10);
write('1 = SI');
gotoxy(49,10);
writeln('2 = NO');
gotoxy(28,20);
textcolor(red);
writeln('Elige una de las opciones');
resp:=readkey;
case resp of
'1': begin
textbackground(64);
clrscr;
writeln;
writeln;
writeln;
writeln;
textcolor(red);
write(' GRACIAS,');
textcolor(white);
writeln(' por usar mi programa.');
writeln;
writeln(' Programado por : ');
writeln(' Torres, Oswaldo CI: 19590635');
writeln('Correo: Oswaldo_-@live.com');
gotoxy(20,20);
textcolor(89);
writeln('Presione una tecla para finalizar el programa');
readkey;
end;
'2': opcion:='1'
else
begin
clrscr;
writeln;
writeln;
writeln;
textcolor(red);
writeln(' ERROR: ');
textcolor(black);
writeln(' Ingresa una de las dos opciones');
opcion:='1';
gotoxy(20,24);
textcolor(89);
writeln('Presione una tecla para volver al MENU');
textcolor(black);
readkey;
end;
end;
end else begin
clrscr;
textcolor(red);
writeln;
writeln;
writeln(' ERROR:');
textcolor(black);
writeln(' Por favor introduce una opcion valida');
gotoxy(20,20);
textcolor(89);
writeln('Presione una tecla para volver al MENU');
textcolor(black);
readkey;
end;
end;
end;
end;
begin {Cuerpo Principal}
textbackground(blue);
textcolor(black);
clrscr;
writeln;
writeln;
writeln;
writeln;
writeln;
writeln;
write(' 00000 00000 00000 0 0 00000 0000 0000000 00000 0000');
writeln;
write(' 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0');
writeln;
write(' 00000 00000 0 0 0 0000 0 0 0 0 0 0');
writeln;
write(' 0 0 0 0 0 0 0 0 0 0 0 0 ');
writeln;
write(' 0 0 0 00000 0 00000 0000 0 00000 0000000');
writeln;
writeln;
writeln;
writeln;
writeln;
textcolor(white+blink);
writeln(' Presione una tecla para continuar....');
textcolor(black);
readkey;
inicializar;
menu;
end.
