program PascalGuru;
 
{funkciya dlya preobrazovaniya chisla v stroku}
function roundex(x:real;k:integer):string;
var i:integer;
    s:string;
begin
 Str(x:1:k,S);{preobrazovanie v stroku s zadannim kol-vom znakov}
 roundex:=s;
end;
 
{funkciya dlya polucheniya zadannoy stepeni chisla}
function potens(x , e :longint): real;
var i : longint;
    p : real;
begin
 p := 1;
 if e = 0 then p := 1 else{0-vaya stepen}
 if e < 0 then{esli otricatelnaya stepen}
  begin
   for i := -1 downto e do p := p / x;
  end
 else
  begin
   for i := 1 to e do p := p * x; {vozvedenie v stepen}
  end;
 potens:=p;
end;
 
{funkciya dlya polucheniya nomera cifri}
function digt(ch: char): byte;
const
numstring: string = '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ';
var
 i: byte;
 n: byte;
begin
 n := 0;
 for i := 1 to length(numstring) do{poisk simvola}
  if ch = numstring[i] then n := i - 1;
 digt := n;{vozvrat nomera}
end;
 
{preobrazovanie iz desyatichnoy v zadannyu sistemu}
function dec2basen(base: integer; dec: real; nd:integer): string;
const numstring: string = '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ';
var
num : string;
i, j: integer;
c   : longint;
r: real;
snum:string;
begin
 if (dec = 0) or (base <2) or (base >36) then num := '0'
 else
 begin
 num := '';
 i := 0;
 c:=trunc(dec);
 r:=dec-c;
 while potens(base, i + 1) <= c do i := i + 1;{vozvedenie v naivishuy stepen}
 for j := 0 to i do
  begin
   {nakoplenie chisla}
   num := num + numstring[(c div trunc(potens(base, i - j))) + 1];
   c := c mod trunc(potens(base, i - j));
  end;
 end;
 if (nd <> 0) then{drobnaya chast}
  begin
   num:=num+'.';{tochka}
   for j:=1 to nd do
    begin
     r:=r*base;
     {nakoplenie drobnoy chasti}
     num := num + numstring[trunc(r) + 1];
     r:=r-trunc(r);
    end;
  end;
 dec2basen := num;
end;
 
{preobrazovanie iz zadannoy sistemu v desyatichnuy}
function basen2dec(base: integer; num: string; nd:integer): string;
 
const
 numset: set of char = ['0'..'9', 'A'..'Z'];
var
 j,t,k,len,point : integer;
 error: boolean;
 dec  : real;
begin
 dec := 0;
 error := false;
 if (base <2) or (base >36) then error := true;{esli netdopustimaya baza}
 
 len:=length(num);
 point:=0;
 for j:=1 to length(num) do{poisk kol-vo znakov do tochki}
  if num[j] = '.' then
   begin
    len:=j-1;
    point:=j;
    break;
   end;
 
 k:=0;
 for j := 1 to length(num) do
  if (num[j] <> '.') then
  begin
   k:=k+1;
   if (not (upcase(num[j]) in numset)) or (base < Digt(num[j]) + 1) then
   error:= true;
   {nakoplenie chisla}
   dec := dec + digt(upcase(num[j])) * potens(base, len - k);
  end;
 {esli korretno vozvrashaem chislo}
 if error then basen2dec := '0' else basen2dec := roundex(dec,nd);
end;
 
{proverka korrektnosti zadaniya chisla}
function check(base: integer; num: string): integer;
const
 numset: set of char = ['0'..'9', 'A'..'Z'];
 
var j:integer;
 
begin
 check := 1;
 for j := 1 to length(num) do
  if (num[j] <> '.') then
  begin
   if (not (upcase(num[j]) in numset)) or (base < Digt(num[j]) + 1) then
   {proverka prinadlegnosti diapazonu cifr}
    check:=0;
  end;
end;
 
 
var c:char;
    s1,s2:integer;
    z,f:integer;
    x,t:string;
    tmp:real;
    code:integer;
begin
while c<>'0' do{poka ne vyhod}
 begin
  {vyvod menu}
  writeln('1. Perevod chisla');
  writeln('0. Exit');
  write('=>');
  readln(c);
  if c='1' then
   begin
    s1:=1;
    repeat{poka ne vvedem nugnuy sistemu}
     writeln('Vvedite ishodnyu sistemy shisleniya(2,8,10,16):');
     readln(s1);
    until (s1=2)or(s1=8)or(s1=10)or(s1=16);
    repeat{poka ne vvedem nugnuy sistemu}
     writeln('Vvedite resultiruyshuy sistemy shisleniya(2,8,10,16):');
     readln(s2);
    until (s2=2)or(s2=8)or(s2=10)or(s2=16);
    repeat{poka ne vvedem korrektnoe chislo}
     writeln('Vvedite chislo:');
     readln(x);
     f:=check(s1,x);
     if (f=0) then
      writeln('Chislo zadano neverno povtorite vvod!');
    until f=1;
    writeln('Vvedite kol-vo znakov posle tochki(dlya resultata):');
    readln(z);
    if (s1 <> 10) then
    t:=basen2dec(s1,x,2*z) else t:=x;{perevod v desytichnuy}
    write('result = ');
    val(t,tmp,code);
    writeln(dec2basen(s2,tmp,z));{perevod v zadannuy sistemu}
   end else
   break;
 end;
end.