BinAHex.pas

   1 program BinAHex;\r
   2 \r
   3 function pot(base, exp: integer): integer;\r
   4 \r
   5 begin\r
   6      if exp > 0 then pot := base * pot(base, exp - 1)\r
   7                 else pot := 1;\r
   8 end;\r
   9 \r
  10 var\r
  11    bin, hex: string[255];\r
  12    aux: string[4];\r
  13    i, j, dhex, tam, veces: integer;\r
  14 \r
  15 begin\r
  16      write('Ingrese un numero binario: ');\r
  17      readln(bin);\r
  18      aux := '0000';\r
  19      hex := '';\r
  20      tam := length(bin);\r
  21      while tam > 0 do\r
  22        begin\r
  23          if tam mod 4 = 0 then veces := tam div 4\r
  24                           else veces := (tam div 4) + 1;\r
  25          for j := 0 to (veces - 1) do\r
  26           begin\r
  27             aux[4] := bin[tam-j*4];\r
  28             for i := 1 to 3 do\r
  29                if (tam - i - j*4) > 0\r
  30                  then aux[4 - i] := bin[tam - i - j*4]\r
  31                  else aux[4 - i] := '0';\r
  32             dhex := 0;\r
  33             for i := 0 to 3 do\r
  34                if aux[4-i] = '1' then dhex := dhex + pot(2, i);\r
  35             case dhex of\r
  36               0: hex := hex + '0';\r
  37               1: hex := hex + '1';\r
  38               2: hex := hex + '2';\r
  39               3: hex := hex + '3';\r
  40               4: hex := hex + '4';\r
  41               5: hex := hex + '5';\r
  42               6: hex := hex + '6';\r
  43               7: hex := hex + '7';\r
  44               8: hex := hex + '8';\r
  45               9: hex := hex + '9';\r
  46               10: hex := hex + 'A';\r
  47               11: hex := hex + 'B';\r
  48               12: hex := hex + 'C';\r
  49               13: hex := hex + 'D';\r
  50               14: hex := hex + 'E';\r
  51               15: hex := hex + 'F';\r
  52             end;\r
  53           end;\r
  54           write('Numero en hexa: ');\r
  55           for i := veces downto 1 do write(hex[i]);\r
  56           writeln;\r
  57           tam := 0;\r
  58        end;\r
  59 \r
  60 end.\r