Код:
program lab3;
uses Math, crt;
const
S = 25;
Q = 19;
R = 14;
stroka:string='0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ';
var
i:integer;
TD:string;
x,y,z:String;
DT:real;
S1,S2:String;
{funkcija slozhenija dvuh chisel v proizvol'noj sisteme schislenija}
function Add(n1,n2:String;O:integer):string;
var
s1,s2:string;
s:string;
k:integer;
p1,p2:integer;
x1,x2:integer;
q:integer;
begin
s:='';
k:=0;
s1:=n1;
s2:=n2;
p1:=pos('.',s1);
if p1=0 then insert('.0',s1,length(s1)+1);
p2:=pos('.',s2);
if p2=0 then insert('.0',s2,length(s2)+1);
p1:=pos('.',s1);
p2:=pos('.',s2);
x1:=length(s1)-p1;
x2:=length(s2)-p2;
if p1>p2 then for q:=1 to p1-p2 do insert('0',s2,1) else for q:=1 to p2-p1 do insert('0',s1,1);
if x1>x2 then for q:=1 to x1-x2 do insert('0',s2,length(s2)+1) else for q:=1 to x2-x1 do insert('0',s1,length(s1)+1);
for q:=length(s1) downto 1 do
begin
if s1[q]='.' then
begin
insert('.',s,1);
continue;
end;
{juzaem p1 v kachestve summy razrjada}
p1:=pos(s1[q],stroka)+pos(s2[q],stroka)-2+k;
k:=0;
if p1>=O then
begin
k:=1;
p1:=p1-O;
end;
insert(stroka[p1+1],s,1);
end;
if k=1 then insert('1',s,1);
Add:=s;
end;
{funkcija perevoda Dec chisla v ljubuju ss}
function FromDec(n:real;r:integer):string;
var
s:String;
m:longint;
l:real;
i:integer;
begin
s:='';
m:=trunc(n);
repeat
s:=stroka[(m mod r)+1]+s;
m:=m div r;
until m=0;
l:=frac(n);
s:=s+'.';
for i:=1 to 4 do
begin
l:=l*r;
s:=s+stroka[trunc(l)+1];
l:=frac(l);
end;
FromDec:=s;
end;
{funcija perevoda ljuboj ss v Dec}
function ToDec(n:string;r:real):real;
var
i,p:longint;
m:real;
begin
m:=0;
p:=pos('.',n);
if p=0 then p:=length(n)+1;
for i:=1 to length(n) do if i<>p then
if i<p then
m:=m+(pos(n[i],stroka)-1)*power(r,p-i-1) else
m:=m+(pos(n[i],stroka)-1)*power(r,p-i);
ToDec:=m;
end;
procedure CheckCorrect(s:string;o:integer);
var
n:integer;
i:integer;
begin
n:=0;
for i:=1 to length(s) do if s[i]='.' then inc(n);
if n>1 then
begin
writeln('Slishkom mnogo tochek!');
readln;
halt;
end;
for i:=1 to length(s) do if ((pos(s[i],stroka)>o) or (pos(s[i],stroka)=0)) and (s[i]<>'.') then
begin
writeln('Nekorrektnyj simvol ',s[i]);
readln;
halt;
end;
end;
{osnovnaja programmy}
begin
clrscr;
write('x = ');
readln(x);
write('y = ');
readln(y);
write('z = ');
readln(z);
CheckCorrect(x, S);
CheckCorrect(y, S);
CheckCorrect(z, S);
if ToDec(x,s)>ToDec(y,s) then
begin
writeln('x dolzhno byt men she y');
readln;
halt;
end;
clrscr;
gotoxy(1,1);
write(S);
gotoxy(20,1);
write(10);
gotoxy(40,1);
write(Q);
gotoxy(60,1);
write(R);
writeln;
writeln;
While ToDec(x,S)-ToDec(y,S)<ToDec(z,S) do
begin
write(x);
for i:=1 to 15-length(x) do write(' ');
DT:=ToDec(x, S);
write(DT:4:4);
for i:=19 to 30 do write(' ');
s1:=FromDec(DT,Q);
write(s1);
for i:=1 to 15-length(s1) do write(' ');
writeln(FromDec(DT,R));
x:=Add(x,z,S);
end;
readln;
end.