uses crt;
var
te,i,j,tp,p,q,xk,xkt,code:integer;
x,tt:real;
s:string;
{---------------------------------------------------}
{функция возведения числа I в степень j}
function stepen ( i,j:integer): integer;
var
k :integer;
s:longint;
begin
s:=1;
if j=0 then stepen:=1;
for k:=0 to j-1 do
s:=s*i;
stepen:=s;
end;
{---------------------------------------------------}
{нахождение количества цифр в разряде}
procedure Kolvo;
var
sn:integer;
begin
tp:=1;
sn:=q-1;
repeat
sn:=(sn) div p;
tp:=tp+1;
until sn<p;
end;
{---------------------------------------------------}
begin
clrscr;
{ввод в цикле параметров:
Число, основание p и q с.с
в случае некорректного ввода данных на экран выводится сообшение об ошибке,
ввод данных повторяется }
repeat
write(' vvedite 4islo: ');
readln(s);
te:=1;
Val(s, x, Code);
If Code<>0 Then
begin
WriteLn('oshibka pri preobrazovanii v pozicii!!! : ', Code);
te:=0;
end;
if x<>trunc(x) then
begin
writeln('4islo dolzno bit celim');
readln;
te:=0;
end;
if te<>0 then
begin
write(' vvedite osnovanie p: ');
readln(p);
write(' vvedite osnovanie q: ');
readln(q);
if q>10 then
begin
writeln('Error!!! osnovanie ne bolshe 10');
readln;
te:=0;
end;
end;
if te<>0 then
if (p>=q)or(not(p>1))or(not(q>2)) then
begin
writeln('Error!!! nepravilnoe osnovanie!(p>=q)');
readln;
te:=0;
end;
until te=1;
{вызов функции подсчета количества цифр в разряде}
kolvo;
xk:=0;
j:=0;
xk:=0;
xkt:=0;
{перевод числа в q c.c}
Repeat
{перевод разряда}
for i:=1 to tp do
begin
j:=j+1;
tt:=x-trunc(x/10)*10;
if tt>=p then
begin
writeln('Error!!! cifra bolshe osnovaniya!');
readln;
exit;
end;
x:=(x-tt)/10;
{перевод чисел разряда из p в q}
xkt:=xkt + trunc(tt)*stepen(p,i-1);
end;
{проверка на корректность данных}
if xkt>=q then
begin
writeln('Error!!! nevernoe 4islo!');
readln;
exit;
end;
{суммирование разрядов в конечное число}
xk:=xk+ xkt*stepen(10,trunc(j/tp)-1);
xkt:=0;
until j>=10;
writeln;
{вывод результата на экран}
writeln('4islo po osnavaneu ',p,'-',q,' = ',xk);
readln;
end.
P.S. Этот код уже с исправлениями частично под то, что я пытался сделать, но на большее меня не хватило.
Сообщение отредактировано: /7popok -