Перевести десятичную дробь в двоичную систему счисления

program Project1;
 
(*Переводит десятичную запись вещественного числа в двоичную.
Точность перевода дробной части - до aPrecision цифр после запятой.*)
function DecToBin(const aStr : String; const aPrecision : Byte) : String;
const
  BaseIn = 10;
  BaseOut = 2;
var
  i, PosDot : Integer;
  StrRes, vStr, StrSign, StrDot : String;
  Num, TmpNum, Weight : Extended;
begin
  DecToBin := '';
  if aStr = '' then Exit;
 
  (*Перевод десятичной записи в число.*)
 
  (*Определяем знак и десятичную запись числа без знака.*)
  if aStr[1] = '-' then begin
    StrSign := '-';
    vStr := Copy(aStr, 2, Length(aStr) - 1);
  end else begin
    StrSign := '';
    vStr := aStr;
  end;
 
  (*Ищем дробную точку.*)
  PosDot := Length(vStr) + 1;
  for i := 1 to Length(vStr) do begin
    if vStr[i] in ['.', ','] then begin
      PosDot := i;
      StrDot := vStr[i];
      Break;
    end;
  end;
 
  Num := 0;
 
  (*Переводим в число запись целой части.*)
  (*Движемся от младших разрядов - к старшим.*)
  (*Вес младшего разряда в целой части.*)
  Weight := 1;
  for i := PosDot - 1 downto 1 do begin
    case vStr[i] of
      '0'  : Num := Num + 0 * Weight; (*Эту строку можно закоментовать.*)
      '1'  : Num := Num + 1 * Weight;
      '2'  : Num := Num + 2 * Weight;
      '3'  : Num := Num + 3 * Weight;
      '4'  : Num := Num + 4 * Weight;
      '5'  : Num := Num + 5 * Weight;
      '6'  : Num := Num + 6 * Weight;
      '7'  : Num := Num + 7 * Weight;
      '8'  : Num := Num + 8 * Weight;
      '9'  : Num := Num + 9 * Weight;
    else
      Writeln('Ошибка! Незарегистрированная цифра.');
    end;
    (*Вес следующего разряда.*)
    Weight := Weight * BaseIn;
  end;
 
  (*Переводим в число запись дробной части.*)
  (*Движемся от старших разрядов - к младшим.*)
  (*Вес старшего разряда в дробной части.*)
  Weight := 1 / BaseIn;
  for i := PosDot + 1 to Length(vStr) do begin
    case vStr[i] of
      '0'  : Num := Num + 0 * Weight; (*Эту строку можно закоментовать.*)
      '1'  : Num := Num + 1 * Weight;
      '2'  : Num := Num + 2 * Weight;
      '3'  : Num := Num + 3 * Weight;
      '4'  : Num := Num + 4 * Weight;
      '5'  : Num := Num + 5 * Weight;
      '6'  : Num := Num + 6 * Weight;
      '7'  : Num := Num + 7 * Weight;
      '8'  : Num := Num + 8 * Weight;
      '9'  : Num := Num + 9 * Weight;
    else
      Writeln('Ошибка! Незарегистрированная цифра.');
    end;
    (*Вес следующего разряда.*)
    Weight := Weight / BaseIn;
  end;
 
  (*Переводим число в двоичную запись.*)
 
  StrRes := '';
 
  (*Перевод целой части.*)
  TmpNum := Int(Num);
  repeat
    (*Определяем очередную двоичную цифру.*)
    (*Аналог (TmpNum mod BaseOut) для случая вещественных операндов.*)
    case Round( TmpNum - Int(TmpNum / BaseOut) * BaseOut ) of
      0 :  StrRes := '0' + StrRes;
      1 :  StrRes := '1' + StrRes;
    end;
    (*Удаляем из числа текущий разряд.*)
    TmpNum := Int(TmpNum / BaseOut);
  until TmpNum = 0;
 
  (*Перевод дробной части с точностью до aPrecision знаков после запятой.*)
  i := 0;
  TmpNum := Frac(Num);
  while (TmpNum <> 0) and (aPrecision > i) do begin
    if i = 0 then StrRes := StrRes + StrDot;
    (*Определяем очередную двоичную цифру.*)
    TmpNum := TmpNum * BaseOut;
    case Round(Int(TmpNum)) of
      0 :  StrRes := StrRes + '0';
      1 :  StrRes := StrRes + '1';
    end;
    (*Удаляем из числа текущий старший разряд.*)
    TmpNum := Frac(TmpNum);
    Inc(i);
  end;
 
  DecToBin := StrSign + StrRes;
end;
 
const
  Precision = 10;
var
  S : String;
begin
  repeat
    Writeln('Введите запись вещественного числа в десятичной системе счисления:');
    Readln(S);
    S := DecToBin(S, Precision);
    Writeln('Запись этого же числа в двоичной системе счисления');
    Writeln('с точностью до ', Precision, ' цифр после запятой:');
    Writeln(S);
    Writeln('Повторить - Enter, выход - любой символ + Enter.');
    Readln(S);
  until S <> '';
end.