Написать программу перевода действительных чисел из любой системы счисления в десятичную и обратно

type
  //Допустимые основания систем счисления. Перечень можно расширять.
  TBase = 2..16;
  //Допустимые числовые значения цифр. Перечень можно расширять.
  TDigNum = 0..15;
 
//Возвращает число, соответствующее цифре.
function DigToNum(const aDigit : Char) : TDigNum;
begin
  case aDigit of
    '0' : Result := 0;
    '1' : Result := 1;
    '2' : Result := 2;
    '3' : Result := 3;
    '4' : Result := 4;
    '5' : Result := 5;
    '6' : Result := 6;
    '7' : Result := 7;
    '8' : Result := 8;
    '9' : Result := 9;
    'A', 'a' : Result := 10;
    'B', 'b' : Result := 11;
    'C', 'c' : Result := 12;
    'D', 'd' : Result := 13;
    'E', 'e' : Result := 14;
    'F', 'f' : Result := 15;
  else
    raise Exception.Create('Ошибка. Незарегистрированная цифра: "' + aDigit + '", Code = #' + IntToStr(Ord(aDigit)) + '.');
  end;
end;
 
//Возвращает цифру, соответствующую числу.
function NumToDig(const aNum : TDigNum) : Char;
begin
  case aNum of
    0 : NumToDig := '0';
    1 : NumToDig := '1';
    2 : NumToDig := '2';
    3 : NumToDig := '3';
    4 : NumToDig := '4';
    5 : NumToDig := '5';
    6 : NumToDig := '6';
    7 : NumToDig := '7';
    8 : NumToDig := '8';
    9 : NumToDig := '9';
    10 : NumToDig := 'A';
    11 : NumToDig := 'B';
    12 : NumToDig := 'C';
    13 : NumToDig := 'D';
    14 : NumToDig := 'E';
    15 : NumToDig := 'F';
  end;
end;
 
//Через параметр aStrX получает запись числа в системе счисления по основанию aBaseX.
//Возвращает запись этого же числа в системе счисления по основанию aBaseY.
//Точноть перевода дробной части - aPrec цифр после запятой в системе счисления по основанию aBaseY.
function XcToYc(const aStrX : String; const aBaseX, aBaseY : TBase; const aPrec : Byte) : String;
var
  //Знак, счётчик для циклов и позиция точки - разделителя целой и дробной частей.
  Sign, i, Pos1 : Integer;
  //Строка с представлением числа без знака в системе счисления по основанию aBaseX.
  StrX : String;
  //Само интересующее нас число, вес разряда и переменная для промежуточных вычислений.
  Num, Weight, NumTmp : Extended;
begin
  //Если на входе пустая строка.
  if Length(aStrX) = 0 then begin
    Result := '';
    Exit;
  end;
 
  //Определяем знак числа.
  if aStrX[1] = '-' then begin
    Sign := -1;
    StrX := Copy(aStrX, 2, Length(aStrX) - 1);
  end else begin
    Sign := 1;
    StrX := aStrX;
  end;
 
  //Ищем разделитель целой и дробной части.
  Pos1 := Length(StrX) + 1;
  for i := 1 to Length(StrX) do begin
    if StrX[i] in ['.', ','] then begin
      Pos1 := i;
      Break;
    end;
  end;
 
  Num := 0;
 
  //Учитываем в числе дробную часть aBaseX записи.
  Weight := 1;
  for i := Pos1 + 1 to Length(StrX) do begin
    Weight := Weight / aBaseX;
    Num := Num + DigToNum(StrX[i]) * Weight;
  end;
 
  //Учитываем в числе целую часть aBaseX записи.
  Weight := 1;
  for i := Pos1 - 1 downto 1 do begin
    Num := Num + DigToNum(StrX[i]) * Weight;
    Weight := Weight * aBaseX;
  end;
 
  //Переводим полученное число в aBaseY систему счисления.
 
  Result := '';
 
  //Переводим дробную часть.
  NumTmp := Frac(Num);
  i := 0;
  while (NumTmp <> 0) and (i < aPrec) do begin
    NumTmp := NumTmp * aBaseY;
    Result := Result + NumToDig( Round(Int(NumTmp)) );
    NumTmp := Frac(NumTmp);
    Inc(i);
  end;
 
  //Если дробная часть не нулевая, то добавляем точку - разделитель целой и дробной частей.
  if Result <> '' then Result := '.' + Result;
 
  //Переводим целую часть.
  NumTmp := Int(Num);
  repeat
    Result := NumToDig( Round(NumTmp) mod aBaseY ) + Result;
    NumTmp := Round(NumTmp) div aBaseY;
  until NumTmp = 0;
 
  //Добавляем сведения о знаке.
  if Sign = -1 then Result := '-' + Result;
end;
 
procedure TForm1.Button1Click(Sender: TObject);
var
  S : String;
begin
  Memo1.Clear;
  //Точность перевода 12 знаков после запятой в результирующей записи числа.
 
  //Перевод: четверичная запись - семеричная.
  S := XcToYc('23,22', 4, 7, 12);
  Memo1.Lines.Add('4->7: 23,22 -> ' + S);
  //Перевод: семеричная запись - четверичная.
  S := XcToYc('14,424242424242', 7, 4, 12);
  Memo1.Lines.Add('7->4: 14,424242424242 -> ' + S);
 
  //Перевод: шестнадцатиричная запись - двоичная.
  S := XcToYc('23,0D', 16, 2, 12);
  Memo1.Lines.Add('16->2: 23,0D -> ' + S);
  //Перевод: шестнадцатиричная запись - восмиричная.
  S := XcToYc('23,0D', 16, 8, 12);
  Memo1.Lines.Add('16->8: 23,0D -> ' + S);
  //Перевод: шестнадцатиричная запись - десятичная.
  S := XcToYc('23,0D', 16, 10, 12);
  Memo1.Lines.Add('16->10: 23,0D -> ' + S);
end;