quote:


program tabanarit;
uses crt;
var
X, Z ,K :array[1..1000] of Integer;
T : String;
T1, T2 : Longint;
a1, l , basdeg, hata, hata1, A, i, j, f, m, n : Integer;
ch : Char;
B : Boolean;

label
sart, sart1, sart2, sart3;

begin
repeat
......
......
WriteLn('Tabani giriniz =>');
sart1:
ReadLn(a1);
if a1<2 then
begin
WriteLn('Lutfen gecerli bir taban degeri giriniz');
goto sart1;
end;
if a1>10 then
begin
WriteLn('Lutfen gecerli bir taban degeri giriniz');
goto sart1;
end;
sart2:
WriteLn('Sayiyi giriniz =>');
ReadLn(T1);
Str(T1,T);
n:=length(T);

for l:=1 to n do
begin
Val(T[l],K[l],hata);
if K[l]>=a1 then
begin
WriteLn('Yanlis bir giris yaptiniz! (Sayinin rakamlari tabandan kucuk olmalidir)');
goto sart2;
end;
end;
WriteLn('Sayiyi cevirmek istediginiz tabani giriniz =>');
sart3:
ReadLn(m);
if m<2 then
begin
WriteLn('Lutfen gecerli bir taban degeri giriniz');
goto sart3;
end;
if m>10 then
begin
WriteLn('Lutfen gecerli bir taban degeri giriniz');
goto sart3;
end;
basdeg:=1;
for j:=n downto 1 do
begin
Val(T[j],Z[j],hata1);
T2:=T2+Z[j]*basdeg;
basdeg:=basdeg*a1;
end;
i:=1;
repeat
X:=T2 mod m;
T2:=T2 div m;
i:=i+1;
until T2<m;
Write(a1, ' tabaninda ', T1, ' = ', m, ' tabaninda ');
Write(T2);
i:=i-1;
for f:=i downto 1 do
begin
Write(X[f]);
end;

sart:
WriteLn;
WriteLn;
Writeln('Devam etmek istermisiniz ?...(E/H)');
ch:=Readkey;
Case ch Of
'E','e':B:=True;
'H','h':B:=False;
else
begin
textcolor(7);
WriteLn('Gecersiz bir giris yaptiniz. Lutfen tekrar deneyin!...');
goto sart;
end;
end;
until ( B=False );
......
......
Readkey;
end.