Добавил:
Upload Опубликованный материал нарушает ваши авторские права? Сообщите нам.
Вуз: Предмет: Файл:

745 / Л.Р.№3 / Lab3_var_8

.PAS
Скачиваний:
7
Добавлен:
22.02.2016
Размер:
2 Кб
Скачать
uses crt;
type mas=array [1..17] of integer;
var
  _1:mas;
  _2:mas;
  Sym:mas;
  i,s,k:integer;
  y,x:string;
procedure BBecTu(a:string; var b:mas;i:integer;k:integer);
  begin
    if (a[i-8]='0') then b[k]:=0;
    if (a[i-8]='1') then b[k]:=1;
  end;

procedure z_right;
  var k:integer;
  begin
    for k:=17 downto 9 do
      begin
        _2[k+1]:=_2[k];
      end;
      _2[9]:=0;
    for k:=1 to 17 do
      write(_2[k]);
    writeln;
  end;

procedure z_left;
  var k:integer;
  begin
    for k:=1 to 16 do
      begin
        _1[k]:=_1[k+1];
        write(_1[k]);
      end;
    writeln;
    _1[16]:=0;
  end;

procedure summ;
  var k:integer;
  begin
  for k:=16 downto 1 do
    begin
      s:=sym[k]+_1[k]+s;
      if s=2 then begin
                    S:=1;
                    sym[k]:=0;
                  end
      else if s=3 then begin
                         s:=1;
                         sym[k]:=1;
                       end
      else if s=0 then
                      begin
                         s:=0;
                         sym[k]:=0;
                       end
     else if s=1 then begin
                         s:=0;
                         sym[k]:=1;
                       end;
    end;
  for k:=1 to 16 do
    write(sym[k]);
  writeln;
  end;
begin
  clrscr;
  for i:=1 to 16 do
    sym[i]:=0;
  writeln('BBeDiT" perwuy mno*nuk doB*unoyu 8 pozr"adiv');
  readln(y);
  k:=8;
  for i:=9 to 16 do
    begin
      inc(k);
      BBectu(y,_1,i,k);
    end;
  writeln('BBeDiT" dryguy mno*nuk doB*unoyu 8 pozr"adiv');
  readln(x);
  k:=8;
  for i:=9 to 16 do
    begin
      inc(k);
      BBectu(x,_2,i,k);
    end;
  writeln;
  for i:=1 to 8 do
    begin
      s:=0;
      if i=1 then begin
                    z_right;
                    if _2[17]=1 then summ;
                  end
      else  begin
              z_right;
              z_left;
              if _2[17]=1 then summ;
            end;
      writeln;
    end;
  write('REZALT: ');
  for i:=1 to 16 do
    write(sym[i]);
readkey;
end.
Соседние файлы в папке Л.Р.№3