unit bitfield;
interface
uses Classes, Forms, StdCtrls, Controls;
type
TBitSent = procedure (Sender: TObject; bit: Boolean; pos: Integer) of object;
TBitfield = class(TEdit)
private
FBitWidth: word;
FBitSent: TBitSent;
procedure SetBitWidth(w: Word);
procedure KeyPress(Sender: TObject; var Key: Char);
procedure SetBits(q: QWord);
function GetBits: QWord;
public
var ID: QWord;
property Bits: QWord read GetBits write SetBits;
property BitWidth: Word read FBitWidth write SetBitWidth;
property OnBitSent: TBitSent read FBitSent write FBitSent;
constructor Create(TheOwner: TComponent);
destructor Destroy;
end;
implementation
procedure TBitfield.SetBitWidth(w: Word);
var
i: Integer;
add: String;
begin
if (w > 64) then exit;
if (w < Self.FBitWidth) then
begin
Self.Text := Copy(Self.Text, 1, w);
end
else
begin
if (w > Self.FBitWidth) then
begin
add := '';
for i := 1 to (w - Self.FBitWidth) do
begin
add := add + '0';
end;
Self.Text := add + Self.Text;
end;
end;
Self.FBitWidth := w;
end;
procedure TBitfield.KeyPress(Sender: TObject; var Key: Char);
var
pos, bp: Integer;
cp: TPoint;
begin
pos := (Self.CaretPos.X + 1);
if (pos > Self.FBitWidth) then exit;
if ((Key = #48) or (Key = #49)) then
begin
bp := Self.FBitWidth - pos;
if (Self.FBitSent <> nil) then Self.FBitSent(Sender, Key <> #48, bp);
Self.Text := Copy(Self.Text, 1, Self.CaretPos.X) + Key + Copy(Self.Text, pos + 1, bp); // this line crashes on ARM
cp.X := pos - 1;
cp.Y := 0;
Self.CaretPos := cp;
end;
end;
procedure TBitfield.SetBits(q: QWord);
var
i: QWord;
s: String;
begin
s := '';
i := QWord(1) shl (Self.FBitWidth - 1);
while (i > 0) do
begin
s := s + chr(48 + integer((q and i) <> 0));
i := i shr 1;
end;
Self.Text := s;
end;
function TBitfield.GetBits: QWord;
var i, j: Integer;
begin
Result := 0;
i := Self.FBitWidth - 1;
for j := 1 to Self.FBitWidth do
begin
Result := Result or (integer(Self.Text[j] <> #48) shl i);
i := i shr 1;
end;
end;
constructor TBitfield.Create(TheOwner: TComponent);
begin
inherited Create(TheOwner);
Self.ReadOnly := True;
Self.OnKeyPress := TKeyPressEvent(@(Self.KeyPress));
Self.Text := '';
end;
destructor TBitfield.Destroy;
begin
inherited Destroy;
end;
end.