P.9.2.- Escribir un programa que, leido un numero entero positivo, lo transforme en binario y en hexadecimal. Se deben visualizar los resultados.

program hexadecimal92;

uses crt;

var

num:integer;

transb,transh:string;

opc:char;

{PROCEDIMIENTOS}

{este precedimiento lee el numero a transformar, y lo valida (sea entero y positivo)}

procedure leernum (var n:integer);

begin

repeat

write ('Introduzca un numero: ');

readln (n);

until (n=int(n)) and (n=abs(n));

end;

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

{Transforma el numero a binario}

procedure cambiobin (n:integer;var trans:string);

var

cociente,resto:integer;

ch:string;

begin

cociente:=n;

trans:='';

while cociente>=2 do

begin

resto:=cociente mod 2;

str (resto,ch);

trans:=ch+trans;

ch:='';

cociente:=cociente div 2

end; {cierra el while}

str (cociente,ch);

trans:=ch+trans

end;

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

{transforma el numero a hexadecimal}

procedure cambiohex (n:integer; var trans:string);

var

cociente,resto:integer;

ch:char;

{FUNCIONES}

{Esta funci¢n recibe el resto o el cociente y lo transforma en el caracter correspondiente}

function cambiar (x:integer):char;

begin

case x of

0: cambiar:='0';

1: cambiar:='1';

2: cambiar:='2';

3: cambiar:='3';

4: cambiar:='4';

5: cambiar:='5';

6: cambiar:='6';

7: cambiar:='7';

8: cambiar:='8';

9: cambiar:='9';

10: cambiar:='A';

11: cambiar:='B';

12: cambiar:='C';

13: cambiar:='D';

14: cambiar:='E';

15: cambiar:='F'

end

end;

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

begin

cociente:=n;

trans:='';

while cociente>16 do

begin

resto:=cociente mod 16;

ch:=cambiar (resto);

trans:=cambiar (resto)+trans;

cociente:=cociente div 16

end; {cierra el while}

ch:=cambiar (cociente);

trans:=ch+trans

end;

***************************************

{visualiza los resultados}

procedure resultados (num:integer; bin:string; hex:string);

begin

writeln (num, ' EN DECIMAL');

writeln (bin, ' EN BINARIO');

writeln (hex, ' EN HEXADECIMAL');

readkey

end;

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

{PROGRAMA PRINCIPAL}

begin

repeat

CLRSCR;

leernum (num);

cambiobin (num,transb);

cambiohex (num,transh);

resultados (num,transb,transh);

repeat

clrscr;

write ('S-SALIR/C-CONTINUAR');

opc:=upcase (readkey);

until (opc='C') or (opc='S');

until (opc='S')

end.