unit BinHex;
{$I define.pas}

interface
{v0.45}
uses SysUtils;
{/v0.45}
{uses crt;}
const
  HexChars: array [0..$F] of Char = '0123456789ABCDEF';

type BinStr = string[8];
     HexStr = string[8];

function Bin(b: byte): BinStr;
{prevod bytu do dvojkove reprezenatace}
function LongToBin(l:longint; bits:byte):string;

procedure SetBit(Position, Value: byte; var b:byte);
{nastavuje position-ty bit(0-7) v promenne b na hodnotu value(0,1)}

function BitOn(position, b: byte):boolean;
{testuje je-li position-ty bit (0-7) promenne b =1}

function IsHexChar(ch:char):boolean;

function ByteToHex(b: byte): HexStr;
{prevod bytu do hexadec.tvaru}

function HexToByte(ahex: HexStr): byte;

function WordToHex(w: word): HexStr;
{prevod w do hexadecimalniho tvaru}

function LongToHex(l: longint): HexStr;

function HexToWord(s: string): word;

function HexToLong(s: string): longint;

function StringToHex(s: string): string;

function HexToString(s: string): string;

function RecToHex(const Rec; BufSize: byte): shortstring;
function HexToRec(S: shortstring; var Rec; BufSize: byte): boolean;

procedure SetFlag(AMask: word; var AFlag: word; OnOff: boolean);
function IsFlagSet(AMask: word; AFlag: word): boolean;
procedure ToggleFlag(AMask: word; var AFlag: word);

procedure SetBitInByteArray(var Rec; ABitNumber:word; OnOff:boolean);

function GetBitInByteArray(var Rec; ABitNumber:word): boolean;

procedure SetBitsInByte(var AByte: byte; AMask: byte; AValue: byte);
  {changes only those bits of AByte, that are in AMask in 1, to value
  specified in AValue}

procedure SetBitInByte(var by: byte; ABitNumber: byte; OnOff: boolean);
{set the ABitNumber bit in by to 1(onoff=true) or 0, e.g.
for ABitNumber = 6 it sets 6'th bit (numbering from 0) of the by}

function GetBitInByte(by: byte; ABitNumber: byte): boolean;

{v0.45}
function BCDToString(var AData; ASize: integer): string;
  {e.g. array of bytes ($AF,$1A,$2B..) converts to 'AF1A2B..'}

function StringToBCD(const AString: string; var AData; ASize: integer): integer;
  {e.g. string '123456' converts to array of bytes ($12, $34, $56);
    returns <> 0 if some of the chars in AString is not hexa char (returns
    the position of this char). AData are cleared to 0 (ASize)
    before convertins starts. If AString is too long, the excess part
    will be ignored. }
{/v0.45}

{function GetBitsInByte(AByte:byte; AMask:byte):byte;
  {retuns only the part of AByte with only those}

{v0.70}
function BCDToByte(ABCD: byte): byte;
function ByteToBCD(AByte: byte): byte;
{/v0.70}

implementation

function bin{(b:byte):binstr};
{prevod bytu do dvojkove reprezenatace}
var i:Integer; bt:byte; s:binstr;
begin
  bt:= $01;
  s:='';
  for i := 1 to 8 do begin
    if (b and bt) > 0 then
      s := '1' + s
    else
      s := '0' + s;
  {$R-} bt:=bt shl 1; {$R+}
  end;
  bin:=s;
end;

function LongToBin(l:longint; bits:byte):string;
var
  s:string;
  m:longint;
begin
  if bits = 0 then
    bits := 32;
  m := 1;
  s := '';
  while bits > 0 do begin
    if (m and l) <> 0 then
      s := '1' + s
    else
      s := '0' + s;
    m := m shl 1;
    dec(bits);
  end;
  LongToBin := s;
end;

procedure setbit{(position,value:byte; var b:byte)};
{nastavuje position-ty bit(0-7) v promenne b na hodnotu value(0,1)}
var bt:byte;
begin
  bt:=$01;
  bt:= bt shl position;
  if value=1 then b:=b or bt else begin
    bt:=bt xor $ff;
    b:=b and bt;
  end;
end;

function biton{(position,b:byte):boolean};
{testuje je-li position-ty bit (0-7) promenne b =1}
var
  bt: byte;
begin
  bt := $01;
  bt := bt shl position;
  biton := (bt and b) > 0;
end;

function IsHexChar(ch:char):boolean;
begin
  IsHexChar := (ch in ['0'..'9','a'..'f','A'..'F']);
end;

function ByteToHex{(b:byte):hexstr};
{prevod bytu do hexadec.tvaru}
begin
  ByteToHex := HexChars[b shr 4] + HexChars[b and $F];
end;


function wordtohex{(w:word):hexstr};
{prevod w do hexadecimalniho tvaru}
begin
  wordtohex:=hexChars[Hi(w) shr 4]+hexChars[Hi(w) and $F]+
        hexChars[Lo(w) shr 4]+hexChars[Lo(w) and $F];
end;

function trim(s:string):string;
var i:Integer;
begin
  i := 1;
  while (i <= length(s)) and (s[i] = ' ') do
    inc(i);
  s := copy(s, i, 255);
  while (length(s) > 0) and (s[length(s)] = ' ') do begin
    {$IFDEF WIN32}
    SetLength(s, length(s) - 1);
    {$ELSE}
    dec(s[0]);
    {$ENDIF}
  end;
  trim := s;
end;

function HexToByte(AHex: HexStr): byte;
var
  b: byte;
  code: integer;
begin
  val('$'+trim(ahex), b, code);
  HexToByte:=b;
end;



function longtohex(l:longint):hexstr;
var
  lw:array[0..1]of word absolute l;
begin
  longtohex := wordtohex(lw[1]) + wordtohex(lw[0]);
end;

function hextoword(s:string):word;
var w:word;code:integer;
begin
  val('$'+trim(s),w,code);
  hextoword:=w;
end;

function hextolong(s:string):longint;
var w:longint; code:Integer;
begin
  val('$'+trim(s),w,code);
  hextolong:=w;
end;

function StringToHex(s:string):string;
var
  r:string;
  i:byte;
begin
  r := '';
  for i := 1 to length(s) do
    r := r + HexChars[ord(s[i]) shr 4] + HexChars[ord(s[i]) and $F];
  StringToHex := r;
end;

function HexToString(s:string):string;
var
  r:string;
  i,b:byte;
begin
  r := '';
  for i := 1 to (length(s) div 2) do begin
    b := HexToByte(copy(s,(i - 1) * 2 + 1, 2));
    r := r + chr(b);
  end;
  HexToString := r;
end;

function RecToHex(const Rec; BufSize:byte): shortstring;
begin
  SetLength(Result, BufSize);
  move(Rec, Result[1], BufSize);
  RecToHex := StringToHex(Result);
end;

function HexToRec(S: shortstring; var Rec; BufSize:byte): boolean;
var l: byte;
begin
  S := HexToString(S);
  l := length(S);
  if l > BufSize then
    l := BufSize;
  move(S[1], Rec, l);
  HexToRec := true;
end;

procedure SetFlag(AMask:word; var AFlag:word; OnOff:boolean);
var Flag:word absolute AFlag;
begin
  if OnOff then
    Flag := Flag or AMask
  else
    Flag := Flag and (not AMask);
end;

function IsFlagSet(AMask:word; AFlag:word):boolean;
var Flag:word absolute AFlag;
begin
  IsFlagSet := (AMask and Flag) <> 0;
end;

procedure ToggleFlag(AMask:word; var AFlag:word);
var Flag:word absolute AFlag;
begin
  Flag := Flag xor AMask;
end;

type
  TBuffer = array[0..65520] of byte;

procedure SetBitInByteArray(var Rec; ABitNumber:word; OnOff:boolean);
var
  R: TBuffer absolute Rec;
  p: word;
  b: byte;
begin
  p := ABitNumber div 8;
  b := 1 shl (ABitNumber mod 8);
  if OnOff then
    R[p] := R[p] or b
  else
    R[p] := R[p] and (not b);
end;

procedure SetBitInByte(var by:byte; ABitNumber:byte; OnOff:boolean);
var b:byte;
begin
  b := 1 shl Abitnumber;
  if onoff then
    by := by or b
  else
    by := by and (not b);
end;

function GetBitInByte(by:byte; ABitNumber:byte):boolean;
var b:byte;
begin
  b := 1 shl Abitnumber;
  GetBitInByte := (by and b) <> 0;
end;

function GetBitInByteArray(var Rec; ABitNumber:word):boolean;
var R:TBuffer absolute Rec;
  p:word;
  b:byte;
begin
  p := ABitNumber div 8;
  b := 1 shl (ABitNumber mod 8);
  GetBitInByteArray := (R[p] and b) <> 0;
end;

procedure SetBitsInByte(var AByte:byte; AMask:byte; AValue:byte);
  {changes only those bits of AByte, that are in AMask in 1, to value
  specified in AValue}
begin
  AByte := (AByte and (not AMask)) or (AValue and AMask);
end;

{v0.45}
function BCDToString(var AData; ASize: integer): string;
var
  d: TByteArray absolute AData;
  i: integer;
begin
  Result := '';
  for i := 0 to ASize - 1 do begin
    Result := Result + HexChars[d[i] shr 4] + HexChars[d[i] and $F];
  end;
end;

function StringToBCD(const AString: string; var AData; ASize: integer): integer;
var
  d: TByteArray absolute AData;
  i: integer;
  a: integer;
  code: integer;
  b: byte;
begin
  Result := 0;
  FillChar(AData, ASize, 0);
  for i := 1 to length(AString) do begin
    a := (i - 1) div 2;
    if a >= ASize then
      break;
    val('$' + AString[i], b, code);
    if code <> 0 then begin
      Result := i;
      exit;
    end;
    if (i mod 2) = 1 then begin
      d[a] := b shl 4;
    end else begin
      d[a] := d[a] or b;
    end;
  end;
end;
{/v0.45}

{v0.70}
function BCDToByte(ABCD: byte): byte;
begin
  Result := ((ABCD and ($F0)) shr 4) * 10 + (ABCD and ($F))
end;

function ByteToBCD(AByte: byte): byte;
begin
  Result := ((AByte div 10) shl 4) or (AByte mod 10);
end;
{/v0.70}

end.
