Programa feito em Pascal que verifica e converte os números em todas as suas bases (decimal, hexadecimal, octal e binário).

• Download numeros.pas
• Enviar nova versão

Esconder código-fonte

//= SOBRE ==================================================
//= FEITO POR: Luiz Henrique Rapatão (xpy/curumo)
//= E-MAIL: rapatao@gmail.com
//= SITE: http://www.rapatao.cjb.net
//==========================================================


program numeros;
uses crt;
var menu,base : char;
    numero : string;
    i : integer;


//= FUNCAO VERIFICA BINARIO ================================
function verbin(numero:string):boolean;
begin
  for i:=0 to length(numero) do begin
    if (numero[i]='0') or (numero[i]='1') then verbin:=true
    else verbin:=false;
  end;
end;


//= FUNCAO VERIFICA OCTAL ==================================
function veroct(numero:string):boolean;
begin
  for i:=0 to length (numero) do begin
    if (numero[i]='1') OR (numero[i]='2') OR (numero[i]='3') OR (numero[i]='4') OR (numero[i]='5') OR 
       (numero[i]='6') OR (numero[i]='7') OR (numero[i]='0') then veroct:=true
    else veroct:=false;
  end;
end;


//= FUNCAO VERIFICA HEXADECIMAL ============================
function verhex(numero:string):boolean;
begin
  for i:=0 to length(numero) do begin
    if (numero[i]='1') OR (numero[i]='2') OR (numero[i]='3') OR (numero[i]='4') OR (numero[i]='5') OR 
       (numero[i]='6') OR (numero[i]='7') OR (numero[i]='8') OR (numero[i]='9') OR (numero[i]='0') OR 
       (numero[i]='A') OR (numero[i]='B') OR (numero[i]='C') OR (numero[i]='D') OR (numero[i]='E') OR 
       (numero[i]='F') then verhex:=true
    else verhex:=false;
  end;
end;


//= FUNCAO VERIFICA DECIMAL ================================
function verdec(numero:string):boolean;
begin
  for i:=0 to length (numero) do begin
    if (numero[i]='1') OR (numero[i]='2') OR (numero[i]='3') OR (numero[i]='4') OR (numero[i]='5') OR (numero[i]='6') OR 
       (numero[i]='7') OR (numero[i]='8') OR (numero[i]='9') OR (numero[i]='0') then verdec:=true
    else verdec:=false;
  end;
end;


//= VERIFICAR ==============================================
procedure verificar;
begin
  clrscr;
  write('Entre com o número: ');
  readln(numero);
  numero:=upcase(numero);
  writeln;
  writeln('1) Binario');
  writeln('2) Octal');
  writeln('3) Hexadecimal');
  writeln('4) Decimal');
  write('Opção: '); base:=readkey; writeln(base);
  writeln;
  case base of
    '1': if ((verbin(numero))=true) then writeln('Número binario!') else writeln('Número não é binario!');
    '2': if (veroct(numero) = true) then writeln('Número Octal!') else writeln('Número não é octal!');
    '3': if (verhex(numero) = true) then writeln('Número Hexadecimal!') else writeln('Número não é hexadecimal!');
    '4': if (verdec(numero) = true) then writeln('Número decimal!') else writeln('Número não é decimal!');
  end;
  readkey;
end;


//= CONVERTE PARA DECIMAL ==================================
function todec(numero:string;base:string):string;
var posicao,digito:integer;
    soma:real;
begin
  soma:=0;
  posicao:=length(numero);
  for i:=1 to length(numero) do begin
    case numero[i] of
      'A': digito:=10;
      'B': digito:=11;
      'C': digito:=12;
      'D': digito:=13;
      'E': digito:=14;
      'F': digito:=15;
      else val(numero[i],digito);
    end;
    posicao:=posicao-1;
    if (base='1') then soma:=soma + (digito * exp(ln(2) * posicao));
    if (base='2') then soma:=soma + (digito * exp(ln(8) * posicao));
    if (base='3') then soma:=soma + (digito * exp(ln(16) * posicao));
    if (base='4') then soma:=soma + (digito * exp(ln(10) * posicao));
  end;
  str(soma:0:0,numero);
  todec:=numero;
end;


//= CONVERTE PARA OCTAL ====================================
function tooct(numero:string;base:string):string;
var valor,resultado,resto,soma,posicao:real;
begin
  numero:=todec(numero,base);
  val(numero,valor);
  posicao:=0;
  soma:=0;
  while valor>=8 do begin
    resultado:=valor / 8;
    resultado:=int(resultado);
    resto:=valor-resultado*8;
    soma:=soma + resto * exp(ln(10)*posicao);
    valor:=resultado;
    posicao:=posicao+1
  end;
    soma:=soma + (valor * exp(ln(10)*posicao));
    str(soma:0:0,tooct);
end;


//= CONVERTE PARA HEXADECIMAL ==============================
function tohex(numero:string;base:string):string;
var valor,resultado,resto:integer;
       resto_str,soma_str:string;
begin
  numero:=todec(numero,base);
  val(numero,valor);
  soma_str:='';
  while valor>=16 do begin
    resultado:=valor div 16;
    resto:=valor-resultado*16;
    str(resto,resto_str);
    if resto_str='10' then resto_str:='A'
    else if resto_str='11' then resto_str:='B'
         else if resto_str='12' then resto_str:='C'
              else if resto_str='13' then resto_str:='D'
                   else if resto_str='14' then resto_str:='E'
                        else if resto_str='15' then resto_str:='F';
    insert(resto_str,soma_str,1);
    valor:=resultado;
  end;
    str(valor,resto_str);
    if resto_str='10' then resto_str:='A'
    else if resto_str='11' then resto_str:='B'
         else if resto_str='12' then resto_str:='C'
              else if resto_str='13' then resto_str:='D'
                   else if resto_str='14' then resto_str:='E'
                        else if resto_str='15' then resto_str:='F';
    insert(resto_str,soma_str,1);
    tohex:=soma_str;
end;


//= CONVERTE PARA BINARIO ==================================
function tobin(numero:string;base:string):string;
var valor,resto:integer;
    soma_str:string;
begin
  numero:=todec(numero,base);
  val(numero,valor);
  soma_str:='';
  while valor>=2 do begin
    resto:=valor mod 2;
    if resto = 0 then insert('0',soma_str,1)
    else insert('1',soma_str,1);
    valor:=valor div 2;
  end;
  resto:=valor mod 2;
  if resto = 0 then insert('0',soma_str,1)
  else insert('1',soma_str,1);
  
  tobin:=soma_str;  
end;


//= CONVERTER ==============================================
procedure converter;
var de,para : char;
begin
  clrscr;
  writeln('Converter de: ');
  writeln('1) Binario');
  writeln('2) Octal');
  writeln('3) Hexadecimal');
  writeln('4) Decimal');
  de:=readkey;
  writeln;
  write('Entre com o número: '); readln(numero);
  numero:=upcase(numero);
  writeln;
  writeln('Para: ');
  writeln('1) Binario');
  writeln('2) Octal');
  writeln('3) Hexadecimal');
  writeln('4) Decimal');
  para:=readkey;
  writeln;
  case de of
    '1': begin
           case para of
             '1': if (verbin(numero)=false) then writeln('Erro na conversão') else writeln(numero,' já é um número binario!');
             '2': if (verbin(numero)=false) then writeln('Erro na conversão') else writeln(numero,' em octal é ',tooct(numero,de));
             '3': if (verbin(numero)=false) then writeln('Erro na conversão') else writeln(numero,' em hexadecimal é ',tohex(numero,de));
             '4': if (verbin(numero)=false) then writeln('Erro na conversão') else writeln(numero,' em binario é ',todec(numero,de),' em decimal.');
           end;
         end;
    '2': begin
           case para of
             '1': if (veroct(numero)=false) then writeln('Erro na conversão') else writeln(numero,' em binario é ',tobin(numero,de));
             '2': if (veroct(numero)=false) then writeln('Erro na conversão') else writeln(numero,' já é um número octal!');
             '3': if (veroct(numero)=false) then writeln('Erro na conversão') else writeln(numero,' em hexadecimal é ',tohex(numero,de));
             '4': if (veroct(numero)=false) then writeln('Erro na conversão') else writeln(numero,' em octal é ',todec(numero,de),' em decimal.');
           end;
         end;
    '3': begin
           case para of
             '1': if (verhex(numero)=false) then writeln('Erro na conversão') else writeln(numero,' em binario é ',tobin(numero,de));
             '2': if (verhex(numero)=false) then writeln('Erro na conversão') else writeln(numero,' em octal é ',tooct(numero,de));
             '3': if (verhex(numero)=false) then writeln('Erro na conversão') else writeln(numero,' já é um número hexadecimal!');
             '4': if (verhex(numero)=false) then writeln('Erro na conversão') else writeln(numero,' em hexadecimal é ',todec(numero,de),' em decimal.');
           end;
         end;
    '4': begin
           case para of
             '1': if (verdec(numero)=false) then writeln('Erro na conversão') else writeln(numero,' em binario é ',tobin(numero,de));
             '2': if (verdec(numero)=false) then writeln('Erro na conversão') else writeln(numero,' em octal é ',tooct(numero,de));
             '3': if (verdec(numero)=false) then writeln('Erro na conversão') else writeln(numero,' em hexadecimal é ',tohex(numero,de));
             '4': if (verdec(numero)=false) then writeln('Erro na conversão') else writeln(numero,' já é um número decimal!');
           end;
         end;
  end;
  readkey;
end;


//= BLOCO PRINCIPAL ========================================
Begin
  repeat
    clrscr;
    writeln('Menu');
    writeln('1) Verificar');
    writeln('2) Converter');
    writeln('3) Sair');
    writeln('Entre com a opção: '); menu:=readkey; writeln(menu);
    case menu of
      '1': verificar;
      '2': converter;
    end;
  until(menu='3');
End.

GTK em (Free)Pascal

Crivo de Eratóstenes Simples em Pascal

Juros

Calculadora

Transforme em Binários

Nenhum coment�rio foi encontrado.