Код
program perevod;
var
q,p,n,osnov,s,m,i:longint;
st:string;
ch:char;
mas:array[1..30] of byte;
function test(st:string; osnov:integer):boolean;
var n,i:integer; mn:set of char;
begin
test:=true;
mn:=[];
for i:=0 to osnov-1 do
if i<=9 then mn:=mn+[chr(i+48)]
else mn:=mn+[chr(i+55)];
n:=ord(st[0]);
for i:=1 to n do
if (st[i]<>',') and (not(st[i] in mn)) then
begin
writeln('neverniu vvod');
test:=false;
i:=n;
end;
end;
function chislo(ch:char):integer;
begin
if ord(ch) in [48..57] then chislo:=ord(ch)-48
else chislo:=ord(ch)-55;
end;
function simvol(n:byte):char;
begin
if n in [10..15] then simvol:=chr(n+55)
else simvol:=chr(n+48);
end;
begin
writeln ('vvedite osnovanie p(sistema s4isleni9)');
readln(p);
writeln ('vvod 4isla (posle 9 pisat ABC...)');
repeat
readln (st);
until test(st,p);
writeln ('v kakyuy perevesti sistemy s4isleni9?');
readln (q);
s:=0;
m:=1;
n:=ord(st[0]);
for i:=n downto 1 do
begin
s:=s+chislo(st[i])*m;
m:=m*p;
end;
m:=0;
repeat
inc(m);
mas[m]:=s mod q;
s:=s div q;
until s<=q-1;
inc(m);
mas[m]:=s;
for i:=m downto 1 do
write(simvol(mas[i]));
readln;
end.
var
q,p,n,osnov,s,m,i:longint;
st:string;
ch:char;
mas:array[1..30] of byte;
function test(st:string; osnov:integer):boolean;
var n,i:integer; mn:set of char;
begin
test:=true;
mn:=[];
for i:=0 to osnov-1 do
if i<=9 then mn:=mn+[chr(i+48)]
else mn:=mn+[chr(i+55)];
n:=ord(st[0]);
for i:=1 to n do
if (st[i]<>',') and (not(st[i] in mn)) then
begin
writeln('neverniu vvod');
test:=false;
i:=n;
end;
end;
function chislo(ch:char):integer;
begin
if ord(ch) in [48..57] then chislo:=ord(ch)-48
else chislo:=ord(ch)-55;
end;
function simvol(n:byte):char;
begin
if n in [10..15] then simvol:=chr(n+55)
else simvol:=chr(n+48);
end;
begin
writeln ('vvedite osnovanie p(sistema s4isleni9)');
readln(p);
writeln ('vvod 4isla (posle 9 pisat ABC...)');
repeat
readln (st);
until test(st,p);
writeln ('v kakyuy perevesti sistemy s4isleni9?');
readln (q);
s:=0;
m:=1;
n:=ord(st[0]);
for i:=n downto 1 do
begin
s:=s+chislo(st[i])*m;
m:=m*p;
end;
m:=0;
repeat
inc(m);
mas[m]:=s mod q;
s:=s div q;
until s<=q-1;
inc(m);
mas[m]:=s;
for i:=m downto 1 do
write(simvol(mas[i]));
readln;
end.
как сделать чтобы она с дробными числами работала?