перевод из двоичной в десятичную и обратно

Хыиуду · 22 май 2007, 10:35

Функции для перевода целых неотрицательных чисел из двоичной системы счисления в десятичную и обратно.

function bin2dec(s:string):integer;
var x:integer;
begin
  x:=0;
  for i:=1 to length(s) do
  begin
     x:=x+ord(s[i])-ord('0');
     if i<length(s) then x:=x*2;
  end;
bin2dec:=x;
end;

function dec2bin(x:integer):string;
var s:string
begin
  s:='';
  while x>0 do
  begin
     s:=chr(ord('0')+x mod 2)+s;
     x:=x div 2;
  end;
dec2bin:=s;
end;

somewhere · 22 май 2007, 10:56

Код: Выделить всё

function bin2dec(s:string):integer;
var x,i:integer;
begin
  x:=0;
  for i:=1 to length(s) do
     x:=(x + ord(s[i])-$30) shl 1;
bin2dec:= x shr 1;
end;

function dec2bin(x:integer):string;
var s:string;
begin
  s:='';
  repeat
     s:=chr($30 + x and 1) + s;
     x:=x shr 1;
  until x=0;
dec2bin:=s;
end;

Оптимизированная версия
Dec2Bin - исправлен недочет, при передачи значения 0 - пустая строка
Как известно команды mod и div выполняются в десятки раз медленнее

BBB · 22 май 2007, 11:01

К строке (функция dec2bin)

Код: Выделить всё

s:=chr(ord('0')+x mod 2)+s;

можно, по вкусу, привесить вот такой бантик с оборочками

Код: Выделить всё

const acBinaryDigits : array [0..1] of char = ('0', '1');
..........................
s:=acBinaryDigits [x mod 2] + s;

А для строк (функция bin2dec)

Код: Выделить всё

  for i:=1 to length(s) do
    x:=(x + ord(s[i])-$30) shl 1;

обратным образом:

Код: Выделить всё

const ai0_or_1 : array ['0'..'1'] of integer = (0, 1);
..........................
  for i:=1 to length(s) do
    x:= (x + ai0_or_1[s[i]]) shl 1;

Ну, понятное дело, тут надо быть уверенным, что все символы исходной строки s содержать только либо '0', либо '1'.

Новенький · 10 июн 2007, 12:36

somewhere, скажи пожалуйста, что означает вот это:
x:=(x + ord(s)-$30) shl 1;
в функции bin2dec
и это:
s:=chr($30 + x and 1) + s;
x:=x shr 1;
в функции dec2bin

somewhere · 13 июн 2007, 11:20

&quot писал(а):x:=(x + ord(s)-$30) shl 1;

К переменной Х добавляется разность кодов символов s и "0". Все потом сдвигается влево на 1 бит.

&quot писал(а):s:=chr($30 + x and 1) + s;

Слева строки S приписывается нулевой бит числа Х, переведенный в символ

Хыиуду · 13 июн 2007, 13:58

$30 - 16ричный символ нуля (48 в десятичной системе)

Новенький · 13 июн 2007, 16:35

понял, спасибо

somewhere · 02 окт 2007, 16:44

Для действительных чисел

Код: Выделить всё

function dec2binR(x:real):string;
var
s      : string;
xi     : Longint;
xf     : Real;
base  : Real;
begin
s:='';
xi := trunc(x);
xf := x - xi;
repeat
     s :=chr($30 + xi and 1) + s;
     xi:=xi shr 1;
until xi=0;
if xf <> 0 then
        begin
        s := s + '.';
        base := 0.5;
        while (xf > 0) and (length(s) < 256) do
	begin
                s := s + chr(ord('0')+trunc(xf/base));
        	xf:= xf - trunc(xf/base)*base;
                base := base / 2;
        	end;
        end;
dec2binR:=s;
end;

execom · 21 ноя 2007, 00:17

Код: Выделить всё

FUNCTION DEC2BIN(DEC: LONGINT): STRING;

VAR
  BIN : STRING;
  I, J: LONGINT;

BEGIN
  IF DEC = 0 THEN BIN := '0'
  ELSE
  BEGIN
    BIN := '';
    I := 0;
    WHILE (1 SHL (I + 1)) <=DEC DO I := I + 1;
    { (1 SHL (I + 1)) = 2^(I + 1) }
    FOR J := 0 TO I DO
    BEGIN
      IF (DEC SHR (I - J)) = 1 THEN BIN := BIN + '1'
      { (DEC SHR (I - J)) = DEC DIV 2^(I - J) }
      ELSE BIN := BIN + '0';
      DEC := DEC AND ((1 SHL (I - J)) - 1);
      { DEC AND ((1 SHL (I - J)) - 1) = DEC MOD 2^(I - J) }
    END;
  END;
  DEC2BIN := BIN;
END;

FUNCTION BIN2DEC(BIN: STRING): LONGINT;

VAR
  J    : LONGINT;
  Error: BOOLEAN;
  DEC  : LONGINT;

BEGIN
  DEC := 0;
  Error := False;
  FOR J := 1 TO Length(BIN) DO
  BEGIN
    IF (BIN[J] <>'0') AND (BIN[J] <>'1') THEN Error := True;
    IF BIN[J] = '1' THEN DEC := DEC + (1 SHL (Length(BIN) - J));
    { (1 SHL (Length(BIN) - J)) = 2^(Length(BIN)- J) }
  END;
  IF Error THEN BIN2DEC := 0
  ELSE BIN2DEC := DEC;
END;

FUNCTION DEC2HEX(DEC: LONGINT): STRING;

CONST
  HEXDigts: STRING[16] = '0123456789ABCDEF';

VAR
  HEX : STRING;
  I, J: LONGINT;

BEGIN
  IF DEC = 0 THEN HEX := '0'
  ELSE
  BEGIN
    HEX := '';
    I := 0;
    WHILE (1 SHL ((I + 1) * 4)) <=DEC DO I := I + 1;
    { 16^N = 2^(N * 4) }
    { (1 SHL ((I + 1) * 4)) = 16^(I + 1) }
    FOR J := 0 TO I DO
    BEGIN
      HEX := HEX + HEXDigts[(DEC SHR ((I - J) * 4)) + 1];
      { (DEC SHR ((I - J) * 4)) = DEC DIV 16^(I - J) }
      DEC := DEC AND ((1 SHL ((I - J) * 4)) - 1);
      { DEC AND ((1 SHL ((I - J) * 4)) - 1) = DEC MOD 16^(I - J) }
    END;
  END;
  DEC2HEX := HEX;
END;

FUNCTION HEX2DEC(HEX: STRING): LONGINT;

FUNCTION Digt(Ch: CHAR): BYTE;

CONST
  HEXDigts: STRING[16] = '0123456789ABCDEF';

VAR
  I: BYTE;
  N: BYTE;

BEGIN
  N := 0;
  FOR I := 1 TO Length(HEXDigts) DO
  IF Ch = HEXDigts[I] THEN N := I - 1;
  Digt := N;
END;

CONST
  HEXSet: SET OF CHAR = ['0'..'9', 'A'..'F'];

VAR
  J    : LONGINT;
  Error: BOOLEAN;
  DEC  : LONGINT;

BEGIN
  DEC := 0;
  Error := False;
  FOR J := 1 TO Length(HEX) DO
  BEGIN
    IF NOT (UpCase(HEX[J]) IN HEXSet) THEN Error := True;
    DEC := DEC + Digt(UpCase(HEX[J])) SHL ((Length(HEX) - J) * 4);
    { 16^N = 2^(N * 4) }
    { N SHL ((Length(HEX) - J) * 4) = N * 16^(Length(HEX) - J) }
  END;
  IF Error THEN HEX2DEC := 0
  ELSE HEX2DEC := DEC;
END;

FUNCTION DEC2OCT(DEC: LONGINT): STRING;

CONST
  OCTDigts: STRING[8] = '01234567';

VAR
  OCT : STRING;
  I, J: LONGINT;

BEGIN
  IF DEC = 0 THEN OCT := '0'
  ELSE
  BEGIN
    OCT := '';
    I := 0;
    WHILE (1 SHL ((I + 1) * 3)) <=DEC DO I := I + 1;
    { 8^N = 2^(N * 3) }
    { (1 SHL (I + 1)) = 8^(I + 1) }
    FOR J := 0 TO I DO
    BEGIN
      OCT := OCT + OCTDigts[(DEC SHR ((I - J) * 3)) + 1];
      { (DEC SHR ((I - J) * 3)) = DEC DIV 8^(I - J) }
      DEC := DEC AND ((1 SHL ((I - J) * 3)) - 1);
      { DEC AND ((1 SHL ((I - J) * 3)) - 1) = DEC MOD 8^(I - J) }
    END;
  END;
  DEC2OCT := OCT;
END;

FUNCTION OCT2DEC(OCT: STRING): LONGINT;

CONST
  OCTSet: SET OF CHAR = ['0'..'7'];

VAR
  J    : LONGINT;
  Error: BOOLEAN;
  DEC  : LONGINT;

BEGIN
  DEC := 0;
  Error := False;
  FOR J := 1 TO Length(OCT) DO
  BEGIN
    IF NOT (UpCase(OCT[J]) IN OCTSet) THEN Error := True;
    DEC := DEC + (Ord(OCT[J]) - 48) SHL ((Length(OCT) - J) * 3);
    { 8^N = 2^(N * 3) }
    { N SHL ((Length(OCT) - J) * 3) = N * 8^(Length(OCT) - J) }
  END;
  IF Error THEN OCT2DEC := 0
  ELSE OCT2DEC := DEC;
END;

execom · 21 ноя 2007, 00:18

Код: Выделить всё

FUNCTION BIN2HEX(BIN: STRING): STRING;

FUNCTION SetHex(St: STRING; VAR Error: BOOLEAN): CHAR;

VAR
  Ch: CHAR;

BEGIN
       IF St = '0000' THEN Ch := '0'
  ELSE IF St = '0001' THEN Ch := '1'
  ELSE IF St = '0010' THEN Ch := '2'
  ELSE IF St = '0011' THEN Ch := '3'
  ELSE IF St = '0100' THEN Ch := '4'
  ELSE IF St = '0101' THEN Ch := '5'
  ELSE IF St = '0110' THEN Ch := '6'
  ELSE IF St = '0111' THEN Ch := '7'
  ELSE IF St = '1000' THEN Ch := '8'
  ELSE IF St = '1001' THEN Ch := '9'
  ELSE IF St = '1010' THEN Ch := 'A'
  ELSE IF St = '1011' THEN Ch := 'B'
  ELSE IF St = '1100' THEN Ch := 'C'
  ELSE IF St = '1101' THEN Ch := 'D'
  ELSE IF St = '1110' THEN Ch := 'E'
  ELSE IF St = '1111' THEN Ch := 'F'
  ELSE Error := True;
  SetHex := Ch;
END;

VAR
  HEX  : STRING;
  I    : INTEGER;
  Temp : STRING[4];
  Error: BOOLEAN;

BEGIN
  Error := False;
  IF BIN = '0' THEN HEX := '0'
  ELSE
  BEGIN
    Temp := '';
    HEX := '';
    IF Length(BIN) MOD 4 <>0 THEN
    REPEAT
      BIN := '0' + BIN;
    UNTIL Length(BIN) MOD 4 = 0;
    FOR I := 1 TO Length(BIN) DO
    BEGIN
      Temp := Temp + BIN[I];
      IF Length(Temp) = 4 THEN
      BEGIN
        HEX := HEX + SetHex(Temp, Error);
        Temp := '';
      END;
    END;
  END;
  IF Error THEN BIN2HEX := '0'
  ELSE BIN2HEX := HEX;
END;

FUNCTION HEX2BIN(HEX: STRING): STRING;

VAR
  BIN  : STRING;
  I    : INTEGER;
  Error: BOOLEAN;

BEGIN
  Error := False;
  BIN := '';
  FOR I := 1 TO Length(HEX) DO
  CASE UpCase(HEX[I]) OF
    '0': BIN := BIN + '0000';
    '1': BIN := BIN + '0001';
    '2': BIN := BIN + '0010';
    '3': BIN := BIN + '0011';
    '4': BIN := BIN + '0100';
    '5': BIN := BIN + '0101';
    '6': BIN := BIN + '0110';
    '7': BIN := BIN + '0111';
    '8': BIN := BIN + '1000';
    '9': BIN := BIN + '1001';
    'A': BIN := BIN + '1010';
    'A': BIN := BIN + '1011';
    'C': BIN := BIN + '1100';
    'D': BIN := BIN + '1101';
    'E': BIN := BIN + '1110';
    'F': BIN := BIN + '1111';
    ELSE Error := True;
  END;
  IF Error THEN HEX2BIN := '0'
  ELSE HEX2BIN := BIN;
END;