Программа первоначально должна запрашивать систему исчисления в которой находится исходное число(двоичная, восьмеричная, десятеричная, шестнадцатеричная). После программа требует ввод исходного числа, в этот момент программа должна проводить проверку(возможно ли существования исходного числа в данной системе). Если число дробное то программа должна запрашивать до какого знака требуется округлить будущий перевод. Программа запрашивает систему(двоичную, восьмеричную, десятеричную, шестнадцатеричную) в которую нужно перевести исходное число. Вывод на экран переведенного числа из одной системы в другую — Pascal(Паскаль)

program PascalGuru;

{ funkciya dlya preobrazovaniya chisla v stroku }
function roundex(x: real; k: integer): string;
var
  i: integer;
  s: string;
begin
  Str(x: 1: k, s); { preobrazovanie v stroku s zadannim kol-vom znakov }
  roundex := s;
end;

{ funkciya dlya polucheniya zadannoy stepeni chisla }
function potens(x, e: longint): real;
var
  i: longint;
  p: real;
begin
  p := 1;
  if e = 0 then
    p := 1
  else { 0-vaya stepen }
    if e < 0 then { esli otricatelnaya stepen }
    begin
      for i := -1 downto e do
        p := p / x;
    end
    else
    begin
      for i := 1 to e do
        p := p * x; { vozvedenie v stepen }
    end;
  potens := p;
end;

{ funkciya dlya polucheniya nomera cifri }
function digt(ch: char): byte;
const
  numstring: string = '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ';
var
  i: byte;
  n: byte;
begin
  n := 0;
  for i := 1 to length(numstring) do { poisk simvola }
    if ch = numstring[i] then
      n := i - 1;
  digt := n; { vozvrat nomera }
end;

{ preobrazovanie iz desyatichnoy v zadannyu sistemu }
function dec2basen(base: integer; dec: real; nd: integer): string;
const
  numstring: string = '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ';
var
  num: string;
  i, j: integer;
  c: longint;
  r: real;
  snum: string;
begin
  if (dec = 0) or (base < 2) or (base > 36) then
    num := '0'
  else
  begin
    num := '';
    i := 0;
    c := trunc(dec);
    r := dec - c;
    while potens(base, i + 1) <= c do
      i := i + 1; { vozvedenie v naivishuy stepen }
    for j := 0 to i do
    begin
      { nakoplenie chisla }
      num := num + numstring[(c div trunc(potens(base, i - j))) + 1];
      c := c mod trunc(potens(base, i - j));
    end;
  end;
  if (nd <> 0) then { drobnaya chast }
  begin
    num := num + '.'; { tochka }
    for j := 1 to nd do
    begin
      r := r * base;
      { nakoplenie drobnoy chasti }
      num := num + numstring[trunc(r) + 1];
      r := r - trunc(r);
    end;
  end;
  dec2basen := num;
end;

{ preobrazovanie iz zadannoy sistemu v desyatichnuy }
function basen2dec(base: integer; num: string; nd: integer): string;

const
  numset: set of char = ['0' .. '9', 'A' .. 'Z'];
var
  j, t, k, len, point: integer;
  error: boolean;
  dec: real;
begin
  dec := 0;
  error := false;
  if (base < 2) or (base > 36) then
    error := true; { esli netdopustimaya baza }

  len := length(num);
  point := 0;
  for j := 1 to length(num) do { poisk kol-vo znakov do tochki }
    if num[j] = '.' then
    begin
      len := j - 1;
      point := j;
      break;
    end;

  k := 0;
  for j := 1 to length(num) do
    if (num[j] <> '.') then
    begin
      k := k + 1;
      if (not(upcase(num[j]) in numset)) or (base < digt(num[j]) + 1) then
        error := true;
      { nakoplenie chisla }
      dec := dec + digt(upcase(num[j])) * potens(base, len - k);
    end;
  { esli korretno vozvrashaem chislo }
  if error then
    basen2dec := '0'
  else
    basen2dec := roundex(dec, nd);
end;

{ proverka korrektnosti zadaniya chisla }
function check(base: integer; num: string): integer;
const
  numset: set of char = ['0' .. '9', 'A' .. 'Z'];

var
  j: integer;

begin
  check := 1;
  for j := 1 to length(num) do
    if (num[j] <> '.') then
    begin
      if (not(upcase(num[j]) in numset)) or (base < digt(num[j]) + 1) then
        { proverka prinadlegnosti diapazonu cifr }
        check := 0;
    end;
end;

var
  c: char;
  s1, s2: integer;
  z, f: integer;
  x, t: string;
  tmp: real;
  code: integer;

begin
  while c <> '0' do { poka ne vyhod }
  begin
    { vyvod menu }
    writeln('1. Perevod chisla');
    writeln('0. Exit');
    write('=>');
    readln(c);
    if c = '1' then
    begin
      s1 := 1;
      repeat { poka ne vvedem nugnuy sistemu }
        writeln('Vvedite ishodnyu sistemy shisleniya(2,8,10,16):');
        readln(s1);
      until (s1 = 2) or (s1 = 8) or (s1 = 10) or (s1 = 16);
      repeat { poka ne vvedem nugnuy sistemu }
        writeln('Vvedite resultiruyshuy sistemy shisleniya(2,8,10,16):');
        readln(s2);
      until (s2 = 2) or (s2 = 8) or (s2 = 10) or (s2 = 16);
      repeat { poka ne vvedem korrektnoe chislo }
        writeln('Vvedite chislo:');
        readln(x);
        f := check(s1, x);
        if (f = 0) then
          writeln('Chislo zadano neverno povtorite vvod!');
      until f = 1;
      writeln('Vvedite kol-vo znakov posle tochki(dlya resultata):');
      readln(z);
      if (s1 <> 10) then
        t := basen2dec(s1, x, 2 * z)
      else
        t := x; { perevod v desytichnuy }
      write('result = ');
      val(t, tmp, code);
      writeln(dec2basen(s2, tmp, z)); { perevod v zadannuy sistemu }
    end
    else
      break;
  end;

end.