Uses
CRT;

const
a: string[36] = '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ'; {задаём строку для поиска
в ней символов}
var
rez, s, s2, s3: string;
t, cc, ind, cc2: integer;

{процедура для разделения дробной и целой части числа}
procedure Del(var ss: string);
var
i: integer;
begin
ind := 0; {инициализируем переменные}
s2 := '';
for i := 1 to length(ss) do {идём по строке}
if ss[i] in [',', '.'] then {если символ входит в множество то}
begin
ind := i; {запомнили его индекс}
break{прервали цикл}
end
else {иначе}
s2 := s2 + ss[i]; {пишим в строку по символам целую часть}
s3 := ''; {инициализируем переменную}
if ind <> 0 then {если символ из множества [',','.'] есть в строке то}
begin
delete(s, 1, ind); {удаляем с первой позиции по ind элементы из строки
(т.е. целую часть + [',','.'])}
s3 := ss; {остаток исходной строки заносим в s3 (т.е. дробную часть)}
end;
end;

{функция для перевода (целой части числа) из любой СС в 10-ю}
function ToDec(var ss: string; cc: byte): string;
var
i, n, sum: longint;
s:string;
begin
sum := 0; {инициализируем переменную}
n := length(ss); {присваиваем n - длину строки ss}
for i := 1 to n do {идём по строке}
begin
dec(n); {уменьшаем счётчик на 1}
sum := sum + round((pos(ss[i], a) - 1) * exp(ln(cc) * n)); {суммируем число (найденное в
строке по позиции символа-1 (pos(ss[i],a)-1)) в степени dec(n)}
end;
str(sum,s); {переводим число в строку}
ToDec := s;
end;

{функция для перевода целой части числа из 10-й в любую сс}
function Cel(d: string; c: integer): string;
var
s: string;
k: integer;
n2:real;
begin
val(d,n2,k); {переводим строку в число}
s := ''; {инициализируем переменную}
repeat
s := ((a[round(n2) mod c + 1]) + s); {пока число не будет равно нулю берём целую часть при
делении числа на основание и берём остаток + 1 от деления целой части на 16, записываем
результат посимвольно в строку s}
n2 := round(n2) div c;
until (n2 = 0);
Cel := s;
end;

{функция для перевода дробной части числа из 10-й в любую сс}
function Drob(d: string; t, c: integer): string;
var
s: string;
l2, m: real;
i, k: integer;
begin
if pos('E',d)=0 then {если в строке нет E то)
то добавляем к строке "0."}
val(('0.'+d),m,k)
else {иначе}
val(d,m,k); {переводим строку (без добавления "0.") в число}
s := ''; {инициализируем переменные}
i := 0;
if t <> 0 then {если точность не равна 0 то переводим}
begin
repeat
l2 := m * c;
m := frac(l2); {умножаем число на c (основание СС) берём целую часть и
снова умножаем дробную}
s := s + a[round(int(l2)) + 1]; {ищим в строке элемент на позиции round(int(l2))+1
(целая часть от умножения числа на c +1)}
inc(i); {увеличиваем счётчик}
until i = t;
end
else {иначе}
s := '0'; {присваиваем s '0'}
Drob := s;
end;

{функция для проверки может ли быть это число в заданной системе счисления}
Function prov(c:integer;s:string):boolean;
Var
i,kol,j:integer;
begin
kol:=0; {инициализируем переменную}
for i:=1 to c do {идём по строке а (где с-заданная система счисления)}
begin
for j:=1 to length(s) do {идём по строке s (заданному числу)}
if s[j]=a[i] then {если символ нашего числа равен символу из строки а то}
inc(kol); {увеличиваем счётчик на 1}
end;
if kol=length(s) then {если кол-во символов=длине строки (т.е. все символы в этой СС то) }
prov:=true {истина}
else {иначе}
prov:=false; {ложь}
end;

{перевод (дробной части) из произвольной сс в 10-ю}
function drob2(ss: string; c: integer): string;
var
i: integer;
sum: real;
s:string;
begin
for i := 1 to length(ss) do {идём по строке (по дробной части)}
sum := sum + (pos(ss[i], a) - 1) * exp(ln(c) * -i); {умножаем позицию символа строки -1
на онование системы счисления в степени -i}
str(sum,s); {переводим из числа в строку}
drob2 := s;
end;

begin
ClrScr;
repeat
write('Из какой будем переводить сс: ');
readln(cc2);
write('Введите СС в которую хотите перевести: ');
readln(cc);
until (cc2 in [2..36]) and (cc in [2..36]); {проверка ввода}
repeat
write('ввод числа в ', cc2, '-й СС: ');
readln(s);
Del(s); {разбиваем на дробную и целую части строку}
if not prov(cc2,s2) and not prov(cc2,s3) then
write('Некорректное число.Повторите ')
until prov(cc2,s2) and prov(cc2,s3);
if cc2 = 10 then {если перевод из 10 то юзаем функции Cel и Drob}
begin
t:=5;
if (s3='') then {если дробная часть числа=0 то юзаем Cel}
rez := Cel(s2, cc)
else {иначе юзаем обе и добавляем , между дробной и целой}
rez := Cel(s2, cc) + ',' + Drob(s3, t, cc);
end
else {иначе если перевод не из 10-й СС }
begin
if ind = 0 then
rez := Cel(ToDec(s2, cc2), cc) {переводим сначала из любой в 10-ю сс, а затем из
10-й в любую}
else
rez := Cel(ToDec(s2, cc2), cc) + ',' + drob(drob2(s3, cc2), length(s3), cc); {переводим из любой сс
в другую }
end;
write('Число ',s,'_',cc2,' в ',cc,'-й системе счисления:=',rez); { THE END }
readkey
end.