Системы счислений, Hex(доп. код) to Dec(прямой код) Опции

[Morfey85]

Исходная информация: целое число , записанное в виде строки шестнадцатиричных цифр в дополнительном коде.
Задание: записать это число в прямом коде в виде строки десятичных цифр.

[Pola]

свой не буду уж...
его исправленный

были ошибки: {error 1}{error 2}{error 3}
1) У положительных чисел дополнительный код совпадает с прямым - у него не совпадает! (исправлено)
2) 80 = -128 из-за потери разряда получался -0 (исправлено)
аналогично 8000, ...
3) поскольку x:longint - 4 байта
то с числами длиннее не работает (так и осталось)
но возникает еще одна ошибка при выводе самого большого по абс.величине отрицательного
80000000 x<=0 и поэтому выводится "-" два раза (исправлено)

Код

uses crt;
var
  znak,ch:Char;
  s:string;
  x:longint;

Procedure Info;
begin
  Writeln('Перевести целое число из шестнадцатиричной системы счислений');
  Writeln('в дополнительном коде, в прямой код в виде строки десятичных');
  Writeln('цифр со знаком.');
end;

Function BinToInt(bin_s:string):longint;
var
  bin,mult:longint;
  i:integer;
begin
  mult:=1; bin:=0;
  for i:=length(bin_s) downto 1 do
  begin
    if bin_s[i]='1' then bin:=bin+mult;
    mult:=mult shl 1;
  end;
  BinToInt:=bin
end;

Function HexToBin(s:string):string;
var
  i:byte;
  s1,a:string;
begin
  s1:='';
  for i:=length(s) downto 1 do
  begin
    case Upcase(s[i]) of
      '0': a:='0000';
      '1': a:='0001';
      '2': a:='0010';
      '3': a:='0011';
      '4': a:='0100';
      '5': a:='0101';
      '6': a:='0110';
      '7': a:='0111';
      '8': a:='1000';
      '9': a:='1001';
      'A': a:='1010';
      'B': a:='1011';
      'C': a:='1100';
      'D': a:='1101';
      'E': a:='1110';
      'F': a:='1111';
    else Writeln('Vvedeno nevernoe chislo!!!');
    end;
    s1:=a+s1;
  end;
  HexToBin:=s1;
end;

Function DopToObr(s:string):string;
var
i,j:integer;
sa:string;
f:boolean;
begin
  if s[1]='0' then znak:='+' else znak:='-';
  sa:='';
  for i:=length(s) downto 1 do   {error 2}
  begin
    sa:=s[i]+sa;
  end;
  if znak='-' then {error 1}
  begin               {error 1}
    Writeln('Bin = ',znak,sa);

  j:=length(sa); f:=true;
  while (j>0) and f do
  begin
  if sa[j]='0' then sa[j]:='1' else
  begin
    sa[j]:='0';
    f:=false;
  end;
  dec(j);
  end;

  Writeln('Obr = ',znak,sa);
  end;  {error 1}
  DopToObr:=sa;
end;

Function ObrToPr(s:string):string;
var
  i:integer;
begin
  if znak='-' then {error 1}
    For i:=length(s) downto 1 do If s[i]='0' then s[i]:='1' else s[i]:='0';
  Writeln('Pr  = ',znak,s);
  ObrToPr:=s;
end;


begin
  repeat
    clrscr;
    Info;
    Write('Hex = ');Readln(s);
    s:=HexToBin(s);
    Writeln('Dop = ',s);
    s:=DopToObr(s);
    s:=ObrToPr(s);
    x:=BinToInt(s);
    Write('Dec = '); if x<0 then writeln(x) else writeln(znak,x); {error 3}
    write('Press q for exit or any key for continue...');
    ch:=ReadKey
  until upcase(ch)='Q';
end.