Перевод чисел из одной системы счисления в другую

program L6_19;
uses
crt;
procedure Vvod(s:string;var t:integer; var f:real;var k:integer;var z:char);
var
c:integer;
x:real;
begin
repeat
write('Введите правильную десятичную дробь а=');
read(s);
val(s,x,c);{попробуем преобразовать в вещественное число}
{если не число или нет дродной части, повтор}
if (c<>0) or(pos('.',s)=0) then
write('Ввод не верный, повторите ');
until (c=0) and(pos('.',s)>0);
val(copy(s,1,pos('.',s)-1),t,c);{целая часть}
z:=#0;{если не минус}
if t<0 then {если отрицательное}
begin
z:='-'; {знак минус}
t:=abs(t); {число по модулю}
end;
val(copy(s,pos('.',s),length(s)-pos('.',s)+1),f,c);{дробная}
k:=length(s)-pos('.',s);{количество цифр в дробной части}
end;
{перевод целой части}
procedure DecToBinTr(x:integer;var res:string);
const c:array [0..1] of char= ('0','1');
var
d:0..1;
begin
res:='';{пока цифр нет}
while x<>0 do{пока число не 0}
begin
d:=x mod 2;{берем остаток от 2}
res:=c[d]+res;{приписываем в начало символ омстатка 0 или 1}
x:=x div 2;{сокращаем число в 2 раза}
end;
end;
{перевод дробной части}
procedure FracToBin(x:real;k:integer;var s:string);
var
a:integer;{переменная целого типа для получения цифр}
begin
s:='';{начальное значение строки}
{пока длина строки меньше количества цифр в дробной части}
while length(s)<k do{t-точность, сколько знаков после запятой}
begin
x:=x*2;{умножаем на 2}
a:=trunc(x);{берем целую часть, только первую цифру 0 или 1}
s:=s+chr(a+48);{дописываем в строку символ этой цифры 0=#48, 1=#49}
x:=x-a;{вычитаем целую часть и все повторяем}
end;
end;
var
a,res,s:string;
c,t:integer;
x:real;
z:char;
begin
Vvod(a,c,x,t,z);
DecToBinTr(c,res);
FracToBin(x,t,s);
res:=z+res+'.'+s;
if a[1]='-' then res:='-'+res;
write('Число в СС 2=',res);
end.