745 / Л.Р.№4 / lab4_var_5

Program LAB_4;
uses crt;
var a,b,c:string;

procedure SUM(var b,c:string);
var j,r:integer;
begin
r:=0;
for j:=32 downto 1 do
begin
if ord(b[j])+ord(c[j])-96+r>1 then
begin
if ord(b[j])+ord(c[j])-96+r>2 then c[j]:='1'
else c[j]:='0';
r:=1;
end
else
begin
if ord(b[j])+ord(c[j])-96+r=1 then c[j]:='1'
else c[j]:='0';
r:=0;
end;
end;
end;

Function DOD(b:string):string;
var i:integer;
a:string;
Begin
a:=b;
i:=length(a);
while a[i]<>'1' do dec(i);
for i:=i-1 downto 1 do if a[i]='0' then a[i]:='1'
else a[i]:='0';
DOD:=a;
end;

Function ERROR(a:string):boolean;
var i:integer;
begin
ERROR:=FALSE;
if length(a)<>32 then ERROR:=TRUE
else for i:=1 to length(a) do if (a[i]<>'1')and(a[i]<>'0') then ERROR:=TRUE;
end;

Function Zsyv(a:string):string;
begin
delete(a,2,1);
Zsyv:=concat(a,'0');
end;

procedure Znak(var a:string; var a1:char);
begin
a1:=a[1];
a[1]:='0';
end;

Procedure Division(var a:string; b:string; var c:string);
var j,n:integer;
a1,b1:char;
bd:string;
begin
Znak(a,a1);
Znak(b,b1);
j:=2;
n:=1;
while a[j]<>'1' do inc(j);
while b[j]<>'1' do
begin
b:=Zsyv(b);
inc(n);
end;
for j:=1 to n do
begin
bd:=dod(b);
Sum(bd,a);
if a[1]='1' then
begin
Sum(b,a);
c:=concat(c,'0');
end
else c:=concat(c,'1');
b:=concat('0',b);
delete(b,33,1);
end;
For j:=1 to 31-n do insert('0',c,2);
if a1='1' then a:=Dod(a);
if a1<>b1 then c:=Dod(c);
end;

Begin
clrscr;
write('A --> ');
readln(a);
if Error(a) then writeln('FATAL ERROR')
else
begin
write('B --> ');
readln(b);
if Error(b) then writeln('FATAL ERROR')
else
begin
c:='0';
Division(a,b,c);
writeln('Chastka A/B = ',c);
writeln('Ostacha A/B = ',a);
end;
end;
readkey;
End.