Алгебраическое сложение целых положительных и отрицательных двоичных чисел в обратном коде

program dop_kod;
 
{Алгебраическое сложение положительных и отрицательных двоичных целых чисел в дополнительных кодах}
 
uses
  CRT, GraphABC;
 
var
  st, st1: string;
  ot: string;
  zam: string;
  r, r1: string;
  i: integer;
  mn: set of char;
  f: boolean;
  t, q: integer;
 
 
 
procedure nul(var st1, st: string);// Убираем нули
var
  i: integer;
begin
  for i := 3 to length(st) do
    if st[i] = '0' then
    begin
      Delete(st, i, 1);
      i := 2;
    end else break;
  for i := 3 to length(st1) do
    if st1[i] = '0' then
    begin
      Delete(st1, i, 1);
      i := 2;
    end else break;
end;
 
 
 
 
procedure long(var st1, st: string);// Процедура расчета длины двух чисел
var
  i: integer;
 
 
begin
  // записываем в переменную число без учета знака
  if st[2] = '.' then for i := 3 to length(st) do r1 := r1 + st[i] else
    for i := 1 to length(st) do r1 := r1 + st[i];
  if st1[2] = '.' then  for i := 3 to length(st1) do r := r + st1[i] else
    for i := 1 to length(st1) do r := r + st1[i];
  writeln('Выравнивание кодов:');
  if length(r) > length(r1) then begin// если первое число больше второго, то добавляем нули  во второе число
    while length(r1) < length(r) do r1 := '0' + r1;
    st := st[1] + '.' + r1;  // добавляем знак к результату
  end;
 
  if length(r) < length(r1) then begin// если второе число больше первого, то добавляем нули в первое число
    while length(r1) > length(r) do r := '0' + r;
    st1 := st1[1] + '.' + r; // добавляем знак к результату
  end;
  writeln(st);
  writeln(st1);
  writeln;
 
end;
 
procedure zamena(var st, st1: string);//Процедура перевода в дополнительный код
var
  i: integer;
  p: integer;
 
begin
  p := 0;
  zam := '';
 
  if (st[2] = '.') and (st[1] = '1') then // определяем отрицательное ли число или нет
  begin
    writeln('Число ', st, ' отрицательное');
    write('Переводим в обратный код и получаем результат:');
    writeln;
    // заменяем 1 на 0, 0 на 1
    for i := 3 to length(st) do
      if st[i] = '1' then zam := zam + '0' else zam := zam + '1';
     // прибавляем к обратному коду знак
    st := st[1] + st[2] + zam;
    writeln(st);
    writeln('Получим дополнительный код:');
    // выполняем действия до точки
    for i := length(st) downto 3 do
    begin
      if ((StrToInt(st[i]) + 1 + p) mod 2 ) = 0 then // если число кратное двум
      begin
        ot := '0' + ot;  // записываем 0
        if st[i] <> '0' then p := 1 else break;  // если равно нулю, значит разряд заполнен, прерываем цикл
      end  else  // иначе
      begin
        ot := '1' + ot;    // записываем 1
        if st[i] <> '0' then p := 1 else break;  // если равно нулю, значит разряд заполнен, прерываем цикл
      end;
    end;
 
    Delete(st, (length(st) + 1) - length(ot), length(ot));
    st := st + ot;
    writeln(st);
 
  end else writeln('Число ', st, ' положительное');
 
  zam := '';
  p := 0;
  ot := '';
  writeln;
 
  if (st1[2] = '.') and (st1[1] = '1') then // определяем отрицательное ли число или нет
  begin
    writeln('Число ', st1, ' отрицательное');
    write('Переводим в обратный код и получаем результат:');
    writeln;
    // заменяем 1 на 0, 0 на 1
    for i := 3 to length(st1) do
      if st1[i] = '1' then zam := zam + '0' else zam := zam + '1';
    // прибавляем к обратному коду знак
    st1 := st1[1] + st1[2] + zam;
    writeln(st1);
    writeln('Получим дополнительный код:');
    // выполняем действия до точки
    for i := length(st1) downto 3 do
    begin
      if ((StrToInt(st1[i]) + 1 + p) mod 2 ) = 0 then // если число кратное двум
      begin
        ot := '0' + ot; // записываем 0
        p := 1; // в остаток 1
      end  else  // иначе
      begin
        ot := '1' + ot;  // записываем 1
        if st1[i] <> '0' then p := 1 else break; // если равно нулю, значит разряд заполнен, прерываем цикл
      end;
    end;
 
    Delete(st1, (length(st1) + 1) - length(ot), length(ot));
    st1 := st1 + ot;
    writeln(st1);
 
  end else writeln('Число ', st1, ' положительное');
 
  writeln;
  writeln;
 
end;
 
 
procedure sum(var st, st1: string);// процедура сложения двоичных кодов
var
  i, j: integer;
  p, sum, q: integer;
  z1, z2, a, b: string;
  rr, tri: string;
begin
 
  writeln('   ' + st);
  writeln('  +');
  writeln('   ' + st1);
  writeln('   ---------');
  p := 0; // остаток
  ot := '';
 
  // сложение положительного и отрицательного числа
  if ((st[1] = '0') and (st1[1] = '1')) or ((st[1] = '1') and (st1[1] = '0')) then
 
  begin
    z1 := Copy(st, 1, 2);  // знак первого числа
    z2 := Copy(st1, 1, 2);  // знак второго числа
    // удаляем из строк знаки
    Delete(st, 1, 2);
    Delete(st1, 1, 2);
    // делаем строки кратные трем
    while length(st) mod 3 <> 0 do st := '0' + st;
    while length(st1) mod 3 <> 0 do st1 := '0' + st1;
    
    // переводим первое число в восмиричный код
    while length(st) > 0 do
    begin
      tri := Copy(st, 1, 3); // копируем три символа
 
      case strtoint(tri) of   // выбираем
        000: b := b + '0';
        001: b := b + '1';
        010: b := b + '2';
        011: b := b + '3';
        100: b := b + '4';
        101: b := b + '5';
        110: b := b + '6';
        111: b := b + '7';
      end;
 
      Delete(st, 1, 3);  // удаляем три символа
    end;
 
    a := b;
    b := '';
    // переводим второе число в восмиричный
    while length(st1) > 0 do
    begin
      tri := Copy(st1, 1, 3);
 
      case strtoint(tri) of
        000: b := b + '0';
        001: b := b + '1';
        010: b := b + '2';
        011: b := b + '3';
        100: b := b + '4';
        101: b := b + '5';
        110: b := b + '6';
        111: b := b + '7';
      end;
 
      Delete(st1, 1, 3);
    end;
 
 
 
    // убираем нули в начале
    for i := 1 to length(a) do
      if a[1] = '0' then delete(a, 1, 1) else break;
 
    for i := 1 to length(b) do
      if b[1] = '0' then delete(b, 1, 1) else break;
 
    q := StrToInt(a);
    p := StrToInt(b);
 
    // определяем знак числа
    if z1 = '1.' then q := -q;
    if z2 = '1.' then p := -p;
 
    // складываем
    sum := q + p;
 
    st := IntToStr(sum);
    // если сумма больше 0, значит число положительное
    if sum > 0 then ot := '0.' + ot else begin
      ot := '1.' + ot;
      Delete(st, 1, 1);
    end;
     // переводим число обратно в двоичный код
    for i := 1 to length(st) do
      case StrToInt(st[i]) of
        0: ot := ot + '000';
        1: ot := ot + '001';
        2: ot := ot + '010';
        3: ot := ot + '011';
        4: ot := ot + '100';
        5: ot := ot + '101';
        6: ot := ot + '110';
        7: ot := ot + '111';
      end;
 
 
    TextColor(12);
    TextBold;
    writeln('   ' + ot); // выводим результат
 
 
  end else begin
 
    for i := length(st) downto 1 do
      if st[i] = '.' then begin
        if p = 1 then ot := '.' + IntToStr(p) + ot else
          ot := '.' + ot end else
      if ((StrToInt(st[i]) + StrToInt(st1[i]) + p) mod 2 = 0) then
        // если остаток равен нулю
      begin
        if StrToInt(st[i]) + StrToInt(st1[i]) + p = 0 then
        begin// если сумма равно нулю
                                  // добавляем ноль,иначе...
          ot := '0' + ot;
          p := 0;
        end
                                                    else
        begin
          if StrToInt(st[i]) + StrToInt(st1[i]) + p = 2 then
          begin
            ot := '0' + ot; // добавляем 1
            p := 1;  // записываем 1 в остаток
          end else
          begin
            p := 1;
            ot := '1' + ot;
          end;
        end;
 
      end
        else
      begin
        ot := '1' + ot;  // добавляем еденица
        if StrToInt(st[i]) + StrToInt(st1[i]) + p = 3 then p := 1 else p := 0; // если сумма равно 3 записываем в остаток 1, иначе 0
      end;
 
    if (st[1] = '0') and (st1[1] = '0') then ot[1] := '0';
    if st[1]='1' then ot[1]:='1';
    TextColor(12);
    TextBold;
    writeln('   ' + ot);
    writeln;
 
    end;
end;
 
 // основная программа
 
begin
  // HighVideo;
  mn := ['1', '0', '.'];
  write('Введите первое число в двоичном коде:');
  read(st);
  while true do
  begin// проверка правильности ввода
    q := 0;
 
    if st[1] = '+' then  // если введен плюс, заменяем его на двоичный код
    begin
      Delete(st, 1, 1); // удаляем знак
      st := '0.' + st; // вставляем двоичный код
    end;
 
    if st[1] = '-' then  // если введен минус, заменяем его на двоичный код
    begin
      Delete(st, 1, 1); // удаляем знак
      st := '1.' + st; // вставляем двоичный код
    end;
 
    if (st[1] <> '+') and (st[1] <> '-') and (st[2] <> '.') then st := '0.' + st;
 
    for i := 1 to length(st) do
    begin// идем по каждому символу
 
      if st[i] = '.' then inc(q); // проверяем количество точек
      if q > 1 then   // если больше 1, выводим ошибку
      begin
        q := 0;
        writeln('Повторите ввод');
        read(st);
        f := false;
        break;
      end;
 
      if (st[i] in mn) then f := true else
                   // проверка элемента в множестве
                   // если элемент отсутствует выполняем новый ввод
      begin
        writeln('Повторите ввод');
        read(st);
        f := false;
        break;
      end;
    end;
 
    if f then break;
  end;
 
 
  write('Введите второе число в двоичном коде:');
  read(st1);
 
  while true do
  begin// проверка правильности ввода
    q := 0;
 
    if st1[1] = '+' then  // если введен плюс, заменяем его на двоичный код
    begin
      Delete(st1, 1, 1); // удаляем знак
      st1 := '0.' + st1; // вставляем двоичный код
    end;
 
    if st1[1] = '-' then  // если введен минус, заменяем его на двоичный код
    begin
      Delete(st1, 1, 1); // удаляем знак
      st1 := '1.' + st1; // вставляем двоичный код
    end;
 
    if (st1[1] <> '+') and (st1[1] <> '-') and (st1[2] <> '.') then st1 := '0.' + st1;
 
    for i := 1 to length(st1) do
    begin// идем по каждому символу
 
      if st1[i] = '.' then inc(q); // проверяем количество точек
      if q > 1 then   // если больше 1, выводим ошибку
      begin
        q := 0;
        writeln('Повторите ввод');
        read(st1);
        f := false;
        break;
      end;
 
      if (st1[i] in mn) then f := true else
                   // проверка элемента в множестве
                   // если элемент отсутствует выполняем новый ввод
      begin
        writeln('Повторите ввод');
        read(st1);
        f := false;
        break;
      end;
    end;
 
    if f then break;
  end;
 
 
 
  writeln;
  Nul(st, st1);  // процедура удаления нулей
  Long(st, st1);   // процедура выравнивание длин
  Zamena(st, st1);  // преобразовываем в дополнительный код
  Sum(st, st1);  // процедура сложения двоичных кодов
 
end.