Tips (1541)

Tip Bewertung (33):

{1.}
{**********************************************************}
// Binary to Integer

function BinToInt(Value: string): Integer;
var
  i, iValueSize: Integer;
begin
  Result := 0;
  iValueSize := Length(Value);
  for i := iValueSize downto 1 do
    if Value[i] = '1' then Result := Result + (1 shl (iValueSize - i));
end;


// Integer to Binary

function IntToBin1(Value: Longint; Digits: Integer): string;
var
  i: Integer;
begin
  Result := '';
  for i := Digits downto 0 do
    if Value and (1 shl i) <> 0 then
      Result := Result + '1'
  else
    Result := Result + '0';
end;


function IntToBin2(d: Longint): string;
var
  x, p: Integer;
  bin: string;
begin
  bin := '';
  for x := 1 to 8 * SizeOf(d) do
  begin
    if Odd(d) then bin := '1' + bin
    else
      bin := '0' + bin;
    d := d shr 1;
  end;
  Delete(bin, 1, 8 * ((Pos('1', bin) - 1) div 8));
  Result := bin;
end;


{**********************************************************}
{2. by André Fritzsche}

unit BinConvert;

interface

  //Wandelt Bytewert (Value) zu Binärwert und trennt mit Splitter Hi- und Lo-Bits
function ToBin(Value: Byte; Splitter: Char): string; overload;

  //Wandelt Wordwert (Value) zu Binärwert und trennt mit Splitter Hi- und Lo-Byte
function ToBin(Value: Word; Splitter: Char): string; overload;

  //Wandelt Binärwert (String) zu Zahl (Cardinal)
function BinTo(Value: string): Cardinal;

implementation
{------------------------------------------------------------------------------}

function ToBin(Value: Byte; Splitter: Char): string;
var
  val, bit, intX: Byte;
begin
  val := Value;
  for intX := 0 to 7 do
  begin   //Alle 8 Bits durchlaufen
    bit := 48;    //48 (='0') zu bit
    val := val shr 1; //Value um 1 Bit nach rechts verschieben
    asm
   adc bit,0   //CarryFlag zu bit addieren
  end;
    if intX = 4 then Result := Splitter + Result;
    Result := Chr(bit) + Result;   //zu Result hinzufügen
  end;
end;
{------------------------------------------------------------------------------}

function ToBin(Value: Word; Splitter: Char): string;
begin
  Result := ToBin(Byte(Hi(Value)), Splitter) + Splitter + ToBin(Byte(Lo(Value)), Splitter);
end;
{------------------------------------------------------------------------------}

function BinTo(Value: string): Cardinal;
var
  intX, PosCnt: Byte;
begin
  Result := 0;
  PosCnt := 0;
  for intX := Length(Value) - 1 downto 0 do //zeichen von rechts durchlaufen
    case Value[intX + 1] of   //prüfen, ob 0 oder 1
      '0': Inc(PosCnt);  //bei 0 nur Pos-Zähler erhöhen
      '1':
        begin  //bei 1 Bit an Position einfügen
          Result := Result or (1 shl PosCnt);
          Inc(PosCnt); //und Zähler erhöhen
        end;
    end;
end;
{------------------------------------------------------------------------------}

end.