Перевести дробное недесятичное число с основанием p в десятичную систему - Pascal

var n, d, s: string; {строки: исходное число, десятичное число, знак числа}
    i, j, k, p, e, r, c: integer; {счётчики, система счисления, точность перевода, значение разряда, перенос}
    dd: double; {число в 10сс}
    f: boolean; {флаг верного результата}
begin
  {ввод системы счисления с проверкой}
  repeat
    write('Введите основание системы счисления в диапазоне [2..9]: ');
    readln(p)
  until p in [2..9];
  {ввод числа с проверкой}
  repeat
    write('|n| < 1;  n = ');
    readln(n);
    f := length(n) > 0; {если не пустая строка, то верно}
    if f {если верно, то проверяем дальше}
      then begin
        s := ''; {знак пока +}
        if n[1] in ['+', '-'] {если знак написан явно,}
          then begin {то}
            if n[1] = '-' then s := n[1]; {если число отрицательное, то знак -}
            delete(n, 1, 1) {удаляем знак}
          end;
        while (length(n) > 2) and (n[1] = '0') do delete(n, 1, 1); {удаляем незначащие 0, если они есть}
        f := (length(n) >= 2) and (n[1] in ['.', ',']); {если длина строки больше двух и есть разделитель, то верно}
        if f {если верно, то проверяем дальше}
          then begin
            delete(n, 1, 1); {удаляем разделитель}
            for i := 1 to length(n) do {проверяем цифры числа}
              begin
                f := n[i] in ['0'..char(byte('0') + p - 1)]; {если цифра в диапазоне 0..p-1, то верно}
                if not f then break {если неверно, то прерываем проверку}
              end
          end
      end;
    if not f then writeln('Это не число, по модулю меньшее 1, и в системе счисления ', p, ', повторите ввод.')
  until f;
  {ввод точности перевода с проверкой}
  repeat
    write('Введите количество цифр после десятичной точки в диапазоне [1..15]');
    readln(e)
  until e in [1..15];
  {перевод числа в десятичную систему счисления}
  d := ''; {пока цифр нет}
  for i := 1 to e + 1 do {делаем на одну цифру больше, чтобы потом была возможность округлить число}
    begin
      for j := length(n) downto 1 do {цикл умножения числа на 10 в системе счисления p}
        begin
          r := (byte(n[j]) - byte('0')) * 10; {умножаем текущий разряд числа на 10}
          n[j] := char(byte('0') + r mod p); {записываем разряд в исходное число}
          c := r div p; {перенос}
          for k := j - 1 downto 1 do {распространяем перенос на старшие разряды}
            if c = 0 {если переноса нет,}
              then break {то выходим}
              else begin {иначе складываем разряд и перенос}
                r := (byte(n[k]) - byte('0')) + c; {складываем текущий разряд и перенос}
                n[k] := char(byte('0') + r mod p); {записываем разряд в исходное число}
                c := r div p {перенос}
              end
        end;
      d := d + char(byte('0') + c) {дописываем полученную цифру (последний перенос) к выходному числу}
    end;
  if d[length(d)] >= '5' {если младший разряд выходного числа не менее 5,}
    then begin {то округляем}
      c := 1; {перенос = 1}
      for k := length(d) - 1 downto 1 do {распространяем перенос на старшие разряды}
        if c = 0
          then break
          else begin
            r := (byte(d[k]) - byte('0')) + c;
            d[k] := char(byte('0') + r mod 10);
            c := r div 10
          end
    end;
  delete(d, length(d), 1); {убираем лишний младший разряд}
  while (length(d) > 1) and (d[length(d)] = '0') do delete(d, length(d), 1); {убираем младшие незначащие разряды}
  d := s + '0.' + d; {добавляем знак и целую часть}
  {печать результата}
  writeln(d);
  {val(d, dd, c);} {если нужна не строка, представляющая число, а само число}
  readln
end.