{Author:	Poul Bak}
{}
{Copyright © 1999 : BakSoft-Denmark (Poul Bak). All rights reserved.}
{}
{http://home11.inet.tele.dk/BakSoft/}
{Mailto: baksoft-denmark@dk2net.dk}
{}
{Component Version: 2.00.00.00}
{}
{PBBinHexEdit is a special Edit-component for Binary, Hexadecimal and integer
 editing, display and conversion.}
{}
{Supports Windows 95, 98 and NT.}
{Supports Default-Button click.}

unit PBBinHexEdit;

interface

uses
	Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
	StdCtrls;

type
	TBaseFormat = (Number, Binary, HexaDecimal);

	TPBBinHexEdit = class(TCustomEdit)
  private
    { Private declarations }
		FAlignment: TAlignment;
		FBaseFormat : TBaseFormat;
		FEnter : Boolean;
		FInvalidEntry: TNotifyEvent;
		FMaxValue: Integer;
		FMinValue: Integer;
		FVersion: String;
		function BinToInt(B : string): integer;
		function FormatText(Value: Integer; NFormat: TBaseFormat): string;
		function GetAsInteger: Integer;
		function GetAsBin: string;
		function GetAsHex: string;
		function IntToBin(I : integer): string;
		procedure InvalidEntry;
		procedure SetAlignment(Value: TAlignment);
		procedure SetAsInteger(Value: Integer);
		procedure SetAsBin(Value: string);
		procedure SetAsHex(Value: string);
		procedure SetBaseFormat(Value: TBaseFormat);
		procedure SetMaxValue(Value: Integer);
		procedure SetMinValue(Value: Integer);
		procedure SetVersion(Value: String);
		procedure WMPaste(var Message: TMessage); message WM_PASTE;
	protected
		{ Protected declarations }
		procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
		procedure DoEnter; override;
		procedure DoExit; override;
		procedure KeyDown(var Key: Word; Shift: TShiftState); override;
		procedure KeyPress(var Key: Char); override;
	public
		{ Public declarations }
		constructor Create(AOwner: TComponent); override;
		procedure CreateParams(var Params: TCreateParams); override;
	published		{ Published declarations }
{Set Alignment to: taLeftJustify, taCenter or taRightJustify.}
{Default : taLeftJustify.}
{Supports Windows 95, 98 and NT.}
		property Alignment: TAlignment read FAlignment write SetAlignment;
{Set or access the value as a binary string: 1010101010}
		property AsBin: string read GetAsBin write SetAsBin;
{Set or access the value as an integer type (normal number)}
		property AsInteger: Integer read GetAsInteger write SetAsInteger;
{Set or access the value as a Hexadecimal string: $FFFFFFFF}
		property AsHex: string read GetAsHex write SetAsHex;
{Default: True.}
{Set AutoSelect to True to select all text when you set focus:}
{Notice that when you set focus using the mouse, all text is also selected -
unlike standard Delphi components that only selects all when setting focus with <tab>.}
{When a form has a defaultbutton and you press <enter>, the click event
triggers and focus is returned to the edit control which autoselect all.}
		property AutoSelect;
		property AutoSize;
{BaseFormat is the edit- and displaytype}
		property BaseFormat: TBaseFormat read FBaseFormat write SetBaseFormat;
		property BorderStyle;
		property Color;
		property Ctl3D;
		property DragCursor;
		property DragMode;
		property Enabled;
		property Font;
		property HideSelection;
		property MaxLength;
{Set MaxValue to prevent users from entering values greater than MaxValue.
OnInvalidEntry triggers when the edit component looses focus.
When MaxValue and MinValue are both zero, they have no effect.}
		property MaxValue: Integer read FMaxValue write SetMaxValue;
{Set MinValue to prevent users from entering values less than MinValue.
OnInvalidEntry triggers when the edit component looses focus.
When MaxValue and MinValue are both zero, they have no effect.}
		property MinValue: Integer read FMinValue write SetMinValue;
		property OnChange;
		property OnClick;
		property OnDblClick;
		property OnDragDrop;
		property OnDragOver;
		property OnEndDrag;
		property OnEnter;
		property OnExit;
{Is called when the user enters a value greater than MaxValue or smaller
than MinValue.}
		property OnInvalidEntry: TNotifyEvent read FInvalidEntry write FInvalidEntry;
		property OnKeyDown;
		property OnKeyPress;
		property OnKeyUp;
		property OnMouseDown;
		property OnMouseMove;
		property OnMouseUp;
		property OnStartDrag;
		property ParentColor;
		property ParentCtl3D;
		property ParentFont;
		property ParentShowHint;
		property PopupMenu;
		property ReadOnly;
		property ShowHint;
		property TabOrder;
		property TabStop;
{Read only}
		property Version: String read FVersion write SetVersion;
{Set Visible to False if you just need the conversion routines.}
		property Visible;
	end;

procedure Register;

implementation

uses Clipbrd;

constructor TPBBinHexEdit.Create(AOwner: TComponent);
begin
	inherited Create(AOwner);
	Width := 100;
	FAlignment := taCenter;
	FEnter := False;
	FMaxValue := 0;
	FMinValue := 0;
	FBaseFormat := HexaDecimal;
	FVersion := '2.00.00.00';
	AsInteger := 0;
	Text := FormatText(0, FBaseFormat);
end;

procedure TPBBinHexEdit.CreateParams(var Params: TCreateParams);
const
	Alignments: array[TAlignment] of Word = (ES_LEFT, ES_RIGHT, ES_CENTER);
begin
	inherited CreateParams(Params);
	Params.Style := Params.Style or ES_MULTILINE or Alignments[FAlignment];
end;

procedure TPBBinHexEdit.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
	inherited MouseDown(Button, Shift, X, Y);
	if (Button = mbLeft) or (ssLeft in Shift) then
	begin
		if FEnter = True then
		begin
			FEnter := False;
			if AutoSelect then SelectAll;
		end;
	end;
end;

procedure TPBBinHexEdit.DoEnter;
begin
	inherited DoEnter;
	if csLButtonDown in ControlState then FEnter := True;
	if AutoSelect then SelectAll;
end;

procedure TPBBinHexEdit.DoExit;
begin
	inherited DoExit;
	if (FMinValue <> 0) and (FMaxValue <> 0)
		and ((AsInteger < FMinValue) or (AsInteger > FMaxValue)) then InvalidEntry;
end;

procedure TPBBinHexEdit.KeyDown(var Key: Word; Shift: TShiftState);
begin
	inherited KeyDown(Key, Shift);
	FEnter := False;
	if not ReadOnly then
	begin
		if Key in [VK_DELETE] then if (SelStart = 0)
			and ((Text[1] in ['$']) or (SelLength = length(Text))) then
		begin
			Text := '$0';
			Key := 0;
			SelStart := 1;
			SelLength := 1;
		end;
	end;
end;

procedure TPBBinHexEdit.KeyPress(var Key: Char);
var
	SelSt, SelLe, t : integer;
	DefaultButton : Boolean;
	Fl : Extended;
begin
	inherited KeyPress(Key);
	if Key in [#3] then exit;
	if Key in [#13] then
	begin
		DefaultButton := False;
		SelSt := SelStart;
		SelLe := SelLength;
		if Owner is TForm then with (Owner as TForm) do
		begin
			Key :=#0;
			for t := 0 to ControlCount - 1 do
			begin
				if (Controls[t] is TButton)then
					if ((Controls[t] as TButton).Default = True) then
					begin
						DefaultButton := True;
						DefocusControl(Self, True);
						(Controls[t] as TButton).Setfocus;
						(Controls[t] as TButton).Click;
					end;
			end;
			if DefaultButton then
			begin
				Self.Setfocus;
				if AutoSelect then SelectAll
				else
				begin
					SelStart := SelSt;
					SelLength := SelLe;
				end;
			end
			else MessageBeep(0);
		end;
		exit;
	end;
	if ReadOnly then
	begin
		Key := #0;
		exit;
	end;
	if (Key in [#22, #24]) then exit;
	if (Key in ['$']) and (FBaseFormat = HexaDecimal) then
	begin
		Text := '$0';
		Key := #0;
		SelStart := 1;
		SelLength := 1;
	end
	else if (Key in [#8]) and (SelStart <= 1) and ((Text[1] in ['$']) or (SelLength = length(Text))) then
	begin
		if (FBaseFormat = HexaDecimal) then
		begin
			Text := '$0';
			SelStart := 1;
		end
		else Text := '0';
		SelLength := 1;
		Key := #0;
	end
	else if (Key in [#8]) then exit
	else if (FBaseFormat = HexaDecimal) then
	begin
		if not (Key in ['0'..'9','a'..'f','A'..'F']) then Key := #0
		else if length(Text) >= 9 then Key := #0
		else
		begin
			if SelStart < 1 then SelStart := 1;
			if Key in ['a'..'f'] then Key := chr(ord(Key) - 32);
		end;
	end
	else if (FBaseFormat = Binary) then
	begin
		if not (Key in ['0','1']) then Key := #0
		else if length(Text) >= 32 then Key := #0
	end
	else
	begin
		if not (Key in ['0'..'9','-']) then Key := #0
		else if (Key = '-') and (pos('-', Text) = 0) then SelStart := 0
		else if (Key = '-') and (pos('-', Text) = 1) then
		begin
			Text := copy(Text, 2, Length(Text) - 1);
			Key := #0;
		end
		else if ((length(Text) >= 10) and (pos('-', Text) = 0))
			or (length(Text) >= 11) then Key := #0
		else
		begin
			if (SelStart < 1) and (Text[1] = '-') then SelStart := 1;
			Fl := StrToFloat(copy(Text, 1, SelStart) + Key + copy(Text,
				SelStart + SelLength + 1, Length(Text) - SelStart - SelLength - 1));
			if (Fl > 2147483647.0) or (Fl < -2147483648.0) then Key := #0;
		end;
	end;
end;

function TPBBinHexEdit.GetAsInteger: Integer;
begin
	if (FBaseFormat = Binary) then Result :=  BinToInt(Text)
	else Result := StrToInt(Text);
end;

function TPBBinHexEdit.GetAsBin: string;
begin
	Result := FormatText(AsInteger, Binary);
end;

function TPBBinHexEdit.GetAsHex: string;
begin
	Result := FormatText(AsInteger, HexaDecimal);
end;

procedure TPBBinHexEdit.SetAsInteger(Value: Integer);
begin
	if csDesigning in ComponentState then
	begin
		If (Value > FMaxValue) and ((FMaxValue <> 0) or (FMinValue <> 0)) then InvalidEntry;
		If (Value < FMinValue) and ((FMaxValue <> 0) or (FMinValue <> 0)) then InvalidEntry;
	end;
	if Text <> FormatText(Value, FBaseFormat) then Text := FormatText(Value, FBaseFormat);
end;

procedure TPBBinHexEdit.SetAsBin(Value: string);
begin
	if AsInteger <> BinToInt(Value) then AsInteger := BinToInt(Value);
end;

procedure TPBBinHexEdit.SetAsHex(Value: string);
begin
	if AsInteger <> StrToInt(Value) then AsInteger := StrToInt(Value);
end;

procedure TPBBinHexEdit.SetAlignment(Value: TAlignment);
begin
	if FAlignment <> Value then
	begin
		FAlignment := Value;
		RecreateWnd;
	end;
end;

procedure TPBBinHexEdit.SetMaxValue(Value: Integer);
begin
	if (FMaxValue <> Value) and (Value >= FminValue) then
	begin
		FMaxValue := Value;
	end;
end;

procedure TPBBinHexEdit.SetMinValue(Value: Integer);
begin
	if (FMinValue <> Value) and (Value <= FmaxValue) then
	begin
		FMinValue := Value;
	end;
end;

procedure TPBBinHexEdit.InvalidEntry;
begin
	if assigned(FInvalidEntry) then FInvalidEntry(Self)
	else Application.MessageBox('Value out of range!', 'Invalid Entry', MB_ICONWARNING + MB_OK);
end;

procedure TPBBinHexEdit.SetVersion(Value: String);
begin
	{ Read only! }
end;

procedure TPBBinHexEdit.SetBaseFormat(Value: TBaseFormat);
var
	Asi : integer;
begin
	if FBaseFormat <> Value then
	begin
		Asi := AsInteger;
		FBaseFormat := Value;
		Text := FormatText(AsI, FBaseFormat);
	end;
end;

function TPBBinHexEdit.FormatText(Value: Integer; NFormat: TBaseFormat): string;
begin
	if NFormat = Number then Result := IntToStr(Value)
	else if NFormat = Binary then Result := IntToBin(Value)
	else Result := '$' + IntToHex(Value, 8);
end;

function TPBBinHexEdit.IntToBin(I : integer): string;
var
	b, t, c : integer;
begin
	Result := '';
	if I < 0 then
	begin
		Result := Result + '1';
		c := I + 2147483647 + 1;
	end
	else c := I;
	t := 1073741824;
	repeat
		b := c - t;
		if b >= 0 then
		begin
			Result := Result + '1';
			c := b;
		end
		else if c <> I then Result := Result + '0';
		t := trunc(t / 2);
	until t = 0;
	if Result = '' then Result := '0';
end;

function TPBBinHexEdit.BinToInt(B : string): integer;
var
	b1: string;
	t : comp;
	a : char;
	ok : boolean;
	t1 : integer;
begin
	ok := True;
	b1 := B;
	Result := 0;
	if b1 = '' then exit;
	for t1 := 1 to length(b1) do if not (b1[t1] in ['0', '1']) then ok := False;
	if ok then
	begin
		t := 1;
		repeat
			a := b1[length(b1)];
			if a = '1' then Result := Result + trunc(t);
			if (t = -1073741824 * 2) then exit
			else if t = 1073741824 then t := -1073741824 * 2
			else t := t * 2;
			b1 := copy(b1, 1, length(b1) - 1);
		until b1 ='';
	end;
end;

procedure TPBBinHexEdit.WMPaste(var Message: TMessage);
var
	X, P: integer;
	S: String;
	W: Word;
begin
	P := SelStart;
	Text := Copy(Text, 1, SelStart)
		+ Copy(Text, SelStart + SelLength + 1, Length(Text) - SelStart - SelLength);
	SelStart := P;
	SelLength := 0;
	S := Clipboard.AsText;
	for X := 1 to Length(S) do
	begin
		W := Ord(S[X]);
		Perform(WM_CHAR, W, 0);
	end;
end;

procedure Register;
begin
	RegisterComponents('PB', [TPBBinHexEdit]);
end;

end.

