Перевод числа X, заданного в системе счисления с основанием q в систему счисления с основанием p

const
     digit:string[16]='0123456789ABCDEF';
 
function DecimalToXStr (aBase : Integer; aVal : double; Precision:integer) : String;
var
  Val : double;
  IntVal : Int64;
  FracVal : double;
  StrInt : String;
  StrFrac : String;
  i : Integer;
begin
  // Получаем целую и дробную части числа.
  IntVal := Trunc(aVal);
  FracVal := Frac(aVal);
 
  //Переводим целую часть.
  StrInt := '';
  repeat
    StrInt := digit[IntVal mod aBase+1] + StrInt;
    IntVal := IntVal div aBase;
  until IntVal = 0;
 
  // Если дробная часть = 0, то перевод закончен.
  if FracVal = 0 then begin
    Result := StrInt;
    exit;
  end;
 
  //Переводим дробную часть. Точность - до Precision цифр после запятой.
  StrFrac := '';
  for i := 1 to Precision do begin
    Val := FracVal * aBase;
    StrFrac := StrFrac + digit[Trunc(Val)+1];
    FracVal := Frac(Val);
    //Если дробная часть = 0, то перевод закончен.
    if FracVal = 0 then Break;
  end;
  if StrFrac<>'' then begin  StrInt:=StrInt + '.' + StrFrac;
    while StrInt[length(StrInt)]='0' do delete(StrInt,length(strint),1);
  end;
  Result:=StrInt;
end;
 
function ToDec(n:string;r:Int64):Int64;
var
  m:Int64;
  i:longint;
begin
Result:=0;
if trim(n)<>'' then begin // пустые строки не обрабатываем
  m:=0;
  while pos('0',n)=1 do  delete(n,1,1);//убираем лидирующие 0
    for i:=1 to length(n) do m:=m*r+pos(n[i],digit)-1;//сама формула перевода
    if (m>=MaxInt64) or (m<0) then begin//введено число больше чем Int64
      writeln('Достигнут максимальный предел вычислений!');
      m:=0;
    end;
    Result:=m;
  end;
end;
 
 
function ToDecNew(n:string;r:Integer):double;
var
  f:double;
  i:integer;
  r1:int64;
begin
//  if pos('.',n)=0 then Result:=ToDec(n,r) else begin
    i:=pos('.',n);
    if i>0 then begin
    f:=ToDec(copy(n,1,i-1),r);
    delete(n,1,i);
    r1:=r;
    for i:=1 to length(n) do begin
      f:=f+(pos(n[i],digit)-1)/r1;//сама формула перевода
      r1:=r1*r;
    end;
    Result:=f;
  end else Result:=ToDec(n,r);
end;
 
var
  p,q:integer;
  n:string;
begin
  write('Число:');readln(n);
  write('система счисления1:');readln(p);
  write('система счисления2:');readln(q);
  writeln('ответ:',DecimalToXStr (q,ToDecNew(n,p),5));
end.