745 / Л.Р.№4 / lab4_var_1

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

  procedure SUM(var b,c:string);
  var j,r1,r2,f,s:integer;
  begin
    r1:=0;  f:=0; r2:=0;
    for j:=8 downto 1 do
      begin
      r1:=ord(b[j])-48;
      r2:=ord(c[j])-48;
      s:=r1+r2+f;
      case s of
         1:
            begin
                c[j]:='1';
                f:=0;
            end;
         2:
            begin
                c[j]:='0';
                f:=1;
            end;
         3:
            begin
                c[j]:='1';
                f:=1;
            end;
         0: begin
                c[j]:='0';
                f:=0;
            end
      end;
      end;
  end;

 function dodKod(b:string):string;
    var i:integer;
        a:string;
  Begin
    a:=b;
    for i:=length(a) downto 1 do
       if a[i]='1' then break;
    for i:=i-1 downto 1 do if a[i]='0' then a[i]:='1'
      else a[i]:='0';
    dodKod:=a;
  end;

  function ERROR(a:string):boolean;
    var i:integer;
  begin
    ERROR:=FALSE;
    if length(a)<>8 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;
  var i:byte;
  begin
    for i:=2 to 7 do a[i]:=a[i+1];
    a[i+1]:='0';
    zsyv:=a;
  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')and(j<8) do inc(j);
    while (b[j]<>'1')and(n<=8) do
      begin
        b:=Zsyv(b);
        inc(n);
      end;
    if n < 7 then
      begin
        for j:=1 to n do
        begin
          bd:=dodKod(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,9,1);
        end;
      end;
    for j:=1 to 7-n do insert('0',c,2);
    if a1='1' then a:=dodKod(a);
    if a1<>b1 then c:=dodKod(c);
  end;

  Function ERROR_0(a:string):boolean;
    var i:integer;
  begin
    ERROR_0:=TRUE;
    for i:=2 to 8 do if a[i]='1' then ERROR_0:=FALSE;
  end;

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