conversion decimal-binario
uses crt;
var
num : Integer;
ss : String ;
op : Char ;
(***********************)
(* convierte el 1 u 0 *)
(* en caracter *)
(***********************)
function gg(x:integer): char ;
begin
if (x=1) then
gg := '1'
else
gg := '0';
end;
function zzz(x:char): integer ;
begin
if (x='1') then
zzz := 1
else
zzz := 0;
end;
function poten(num, expo:integer): real ;
begin
if (expo <= 0) then
poten := 1
else
poten := num * poten(num,expo-1);
end;
(*************************)
(* devuelve una cadena *)
(* al revés *)
(*************************)
function contrario(cad:string):string ;
var
i : Integer;
t: string ;
begin
t := '';
for i:= length(cad) downto 1 do
begin
t := t + cad[i];
end;
contrario := t;
end;
(***************************)
(* convierte un decimal a *)
(* binario *)
(***************************)
function dec_bi(x:Integer):string ;
var
zz, i , y : Integer;
t: string ;
begin
t := '';
while (x>0) do
begin
zz := x mod 2;
y := x div 2;
t := t + gg(zz);
x := y;
end;
dec_bi := contrario(t);
end;
function bi_dec(cad:string):integer;
var
aux : string;
yy, suma, j : integer;
begin
aux := contrario(cad);
suma := 0;
for j:= 0 to length(aux)-1 do
begin
yy := 0;
yy := int(poten(2,j));
suma := suma + yy * zzz(aux[j+1]) ;
end;
bi_dec := suma;
end;
procedure bbb;
var
res : string ;
begin
clrscr;
res := 'S';
while (res = 'S') do
begin
writeln('ingrese el numero entero: ');
readln(num);
clrscr;
writeln('numero: ', num);
writeln('biario: ', dec_bi(num));
writeln('Desea introducir otra numero [S/N]');
readln(res);
clrscr;
res := upcase(res);
end;
end;
procedure ccc;
var
res : string ;
begin
clrscr;
res := 'S';
while (res = 'S') do
begin
writeln('ingrese el numero biario: ');
readln(ss);
clrscr;
writeln('biario: ', ss);
writeln('decimal: ', bi_dec(ss));
writeln('Desea introducir otra numero [S/N]');
readln(res);
clrscr;
res := upcase(res);
end;
end;
begin
clrscr;
repeat
writeln('******************************');
writeln('* MENU DE OPCION *');
writeln('* [1] DECIMAL A BINARIO *');
writeln('* [2] BINARIO A DECIMAL *');
writeln('* [0] SALIR *');
Writeln('******************************');
readln(op);
case op of
'1' : begin
bbb;
end;
'2' : begin
ccc;
end;
'3' : break ;
end;
until op = '0';
end.