{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.20.00.00}
{}
{PBNumEdit is a Delphi Edit component with Alignment and mouse-AutoSelect-all.}
{PBNumEdit is a special Edit component for numeric values - supporting
 WYSIWYG editing, floating and fixed decimalpoint.}
{NumberFormat sets the display- and editformat (Standard, Thousands,
Scientific and Engineering). You can set max- and minValue.}
{ Note: To prevent conversion errors, the display is limited to 15 significant
 numbers though the Value (and AsFloat) property is of type Extended.}
{Supports Windows 95, 98 and NT.}
{Supports Default-Button click.}

unit PBNumEdit;

interface

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

type
{Default: Normal format.}
{Thousands: Showing Thousand-separators.}
{Scientific: Exponential - 1 number left of decimalseparator and a 10-exponent (ex: 1.23E8).}
{Engineering: Same as Scientific except the 10-exponent is always a multiplum
of 3 (like milli, kilo, Mega etc.) and there are 1 to 3 numbers
left of the decimalseparator.}
	TNumberFormat = (Standard, Thousands, Scientific, Engineering);

	TPBNumEdit = class(TCustomEdit)
	private
		FAlignment: TAlignment;
		FDecimals: ShortInt;
		FEnter : Boolean;
		FInvalidEntry: TNotifyEvent;
		FMaxValue: Extended;
		FMinValue: Extended;
		FNumberFormat : TNumberFormat;
		FVersion: String;
		function FormatText(Value: Extended): string;
		function GetAsCurrency: Currency;
		function GetAsFloat: Extended;
		function GetAsInteger: Integer;
		function GetValue: Extended;
		function Remove1000(Num : string): string;
		procedure DeleteKey(Key: Word);
		procedure DeleteSelection;
		procedure InvalidEntry;
		procedure SetAlignment(Value: TAlignment);
		procedure SetAsCurrency(Value: Currency);
		procedure SetAsFloat(Value: Extended);
		procedure SetAsInteger(Value: Integer);
		procedure SetDecimals(Value: ShortInt);
		procedure SetMaxValue(Value: Extended);
		procedure SetMinValue(Value: Extended);
		procedure SetNumberFormat(Value: TNumberFormat);
		procedure SetValue(Value: Extended);
		procedure SetVersion(Value: String);
		procedure WMCut(var Message: TMessage); message WM_CUT;
		procedure WMCopy(var Message: TMessage); message WM_COPY;
		procedure WMPaste(var Message: TMessage); message WM_PASTE;
	protected
		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;
		procedure Keyup(var Key: Word; Shift: TShiftState); override;
	public
		constructor Create(AOwner: TComponent); override;
		procedure CreateParams(var Params: TCreateParams); override;
{Set or access the value as a currency type.}
		property AsCurrency: Currency read GetAsCurrency write SetAsCurrency;
{Set or access the value as an extended type.}
{ Note: To prevent conversion errors, the display is limited to 15 significant
numbers though the Value and AsFloat property are of type Extended and
internally calculates with up to 20 significant numbers.}
		property AsFloat: Extended read GetAsFloat write SetAsFloat;
{Set or access the value as an integer type.}
		property AsInteger: Integer read GetAsInteger write SetAsInteger;
	published
{Set Alignment to: taLeftJustify, taCenter or taRightJustify.}
{Default : taLeftJustify.}
{Supports Windows 95, 98 and NT.}
		property Alignment: TAlignment read FAlignment write SetAlignment;
{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;
		property BorderStyle;
		property Color;
		property Ctl3D;
{Set Decimals to -1 if you want a floating decimalpoint with 0 - 14
decimals.}
{Set Decimals to 0 or a value up to 14 to get fixed decimals.}
{ Note: To prevent conversion errors, the display is limited to 15 significant
numbers though the Value (and AsFloat) property is of type Extended and
internally calculates with up to 20 significant numbers.}
		property Decimals: ShortInt read FDecimals write SetDecimals;
		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: Extended 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: Extended read FMinValue write SetMinValue;
{Sets the display- and editformat.}
{Standard: Normal format.}
{Thousands: Showing Thousand-separators.}
{Scientific: Exponential - 1 number left of decimalseparator and a 10-exponent
(ex: 1.23E8).}
{Engineering: Same as Scientific except the 10-exponent is always a multiplum
of 3 (like milli, kilo, Mega etc.) and there are 1 to 3 numbers
left of the decimalseparator.}
		property NumberFormat: TNumberFormat read FNumberFormat write SetNumberFormat;
		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;
{The value of the text. Set or access the displayed text through
this property.}
{ Note: To prevent conversion errors, the display is limited to 15 significant
numbers though the Value (and AsFloat) property is of type Extended and
internally calculates with up to 20 significant numbers.}
		property Value: Extended read GetValue write SetValue;
{Read only}
		property Version: String read FVersion write SetVersion;
		property Visible;
	end;

procedure Register;

implementation

uses Clipbrd;

constructor TPBNumEdit.Create(AOwner: TComponent);
begin
	inherited Create(AOwner);
	Width := 100;
	FAlignment := taRightJustify;
	FDecimals := -1;
	FEnter := False;
	FMaxValue := 0;
	FMinValue := 0;
	FNumberFormat := Standard;
	FVersion := '2.20.00.00';
	Value := 0;
	Text := FormatText(Value);
end;

procedure TPBNumEdit.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 TPBNumEdit.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
	if (Button = mbLeft) or (ssLeft in Shift) then
	begin
		if FEnter = True then
		begin
			FEnter := False;
			if AutoSelect then SelectAll;
		end;
	end;
	inherited MouseDown(Button, Shift, X, Y);
end;

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

procedure TPBNumEdit.DoExit;
begin
	Text := FormatText(Value);
	if ((FMinValue <> 0) or (FMaxValue <> 0))
		and ((Value < FMinValue) or (Value > FMaxValue)) then
	begin
		InvalidEntry;
		Self.SetFocus;
	end
	else inherited DoExit;
end;

procedure TPBNumEdit.KeyDown(var Key: Word; Shift: TShiftState);
begin
	inherited KeyDown(Key, Shift);
	FEnter := False;
	if not ReadOnly then
	begin
		if Key in [VK_DELETE, VK_BACK] then
		begin
			if SelLength > 0 then DeleteSelection
			else DeleteKey(Key);
			Key := 0;
		end;
	end;
end;

procedure TPBNumEdit.KeyPress(var Key: Char);
var
	P, D, E, SelSt, SelLe, t: Integer;
	N, NE, DefaultButton: Boolean;
begin
	inherited KeyPress(Key);
	if Key =#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 exit;
	if Key in [#3, #22, #24] then exit;
	if Not (Key in ['0'..'9', DecimalSeparator, '-', 'e', 'E']) then
	begin
		Key := #0;
		exit;
	end;
	P := SelStart;
	D := pos(DecimalSeparator, Text);
	E := pos('E', Text);
	if Key = 'e' then Key := 'E';
	if Key in [DecimalSeparator, 'E'] then SelLength := 0
	else DeleteSelection;
	N := (Text[1] = '-');
	NE := (pos('-', copy(Text, E + 1, length(Text) - E)) <> 0) and (E <> 0);
	if N and (SelStart = 0) then SelStart := 1;
	if NE and (Selstart = E + 1) then SelStart := SelStart + 1;
	if Key = '-' then
	begin
		if (P < E) or (E = 0) then
		begin
			if not N then
			begin
				Text := '-' + Text;
				SelStart := P + 1;
			end
			else
			begin
				Text := Copy(Text, 2, Length(Text) - 1);
				SelStart := P - 1;
			end;
		end
		else
		begin
			if not NE then
			begin
				Text := copy(Text, 1, E) + '-' + copy(Text, E + 1, Length(Text) - E);
				SelStart := P + 1;
			end
			else
			begin
				Text := copy(Text, 1, E) + copy(Text, E + 2, Length(Text) - E - 1);
				SelStart := P - 1;
			end;
		end;
		Key := #0;
		exit;
	end;
	if Key = DecimalSeparator then
	begin
		if D <> 0 then
		begin
			Selstart := D;
			Key := #0;
		end
		else if FDecimals < 0 then
		begin
			if E <> 0 then Selstart := E - 1
			else Selstart := Length(Text);
		end;
		exit;
	end
	else if Key = 'E' then
	begin
		if E = 0 then SelStart := Length(Text)
		else
		begin
			SelStart := E;
			Key := #0;
		end;
		exit;
	end;
	if (SelStart <= 2) and (Copy(Text, 2, 1) = '0') and N then
	begin
		SelStart := 1;
		SelLength := 1;
	end
	else if (SelStart <= 1) and (Copy(Text, 1, 1) = '0') then
	begin
		SelStart := 0;
		SelLength := 1;
	end
	else if (SelStart = E) and (E <> 0) and (copy(Text,E + 1, 1) = '0')
		then SelLength := 1
	else if FDecimals > 0 then
	begin
		if (SelStart = D + FDecimals) then Key := #0
		else if SelStart >= D then SelLength := 1
		else if SelStart < D - 1 then SelLength := 0;
	end;
end;

procedure TPBNumEdit.Keyup(var Key: Word; Shift: TShiftState);
var
	Numsep, NumSep0, SelStart0, X, D, N, N0 : integer;
	Text0 : string;
begin
	inherited KeyUp(Key, Shift);
	if (SelLength > 0) then exit;
	if NumberFormat <> Thousands then exit;
	D := pos(DecimalSeparator, Text);
	SelStart0 := SelStart;
	NumSep := 0;
	NumSep0 := 0;
	Text0 := FormatText(AsFloat);
	for X := 1 to length(Text0) do
		if Text0[X] = ThousandSeparator then inc(NumSep0);
	for X := 1 to length(Text) do
		if Text[X] = ThousandSeparator then inc(NumSep);
	N := pos(ThousandSeparator, Text);
	N0 := pos(ThousandSeparator, Text0);
	if (NumSep <> NumSep0) or (N <> N0) or (Key in [32, 13]) then
	begin
		Text := Text0;
		Selstart := SelStart0 + NumSep0 - NumSep;
		if (pos(DecimalSeparator, Text) <> 0) and (D = 0) then Selstart := Selstart + 1
		else if (D <> 0) and (pos(DecimalSeparator, Text) = 0) then Selstart := Selstart - 1;
		if Text[Selstart + 1] = ThousandSeparator then Selstart := Selstart + 1;
	end;
end;

function TPBNumEdit.GetAsCurrency: Currency;
begin
	Result := StrToCurr(Remove1000(Text));
end;

function TPBNumEdit.GetAsFloat: Extended;
begin
	Result := StrToFloat(Remove1000(Text));
end;

function TPBNumEdit.GetAsInteger: Integer;
begin
	Result := Trunc(StrToFloat(Remove1000(Text)));
end;

function TPBNumEdit.GetValue: Extended;
begin
	Result := StrToFloat(Remove1000(Text));
end;

procedure TPBNumEdit.SetAsCurrency(Value: Currency);
begin
	if Text <> FormatText(Value) then Text := FormatText(Value);
end;

procedure TPBNumEdit.SetAsFloat(Value: Extended);
begin
	if Text <> FormatText(Value) then Text := FormatText(Value);
end;

procedure TPBNumEdit.SetAsInteger(Value: Integer);
begin
	if Text <> FormatText(Value) then Text := FormatText(Value);
end;

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

procedure TPBNumEdit.SetDecimals(Value: ShortInt);
var Value0 : ShortInt;
begin
	Value0 := Value;
	if FDecimals <> Value0 then
	begin
		if Value0 < 0 then Value0 := -1
		else if Value0 > 14 then Value0 := 14;
		if (Value0 > MaxLength - 2) and (MaxLength > 0) then Value0 := maxlength - 2;
		FDecimals := Value0;
		Text := FormatText(AsFloat);
	end;
end;

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

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

procedure TPBNumEdit.SetValue(Value: Extended);
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) then Text := FormatText(Value);
end;

procedure TPBNumEdit.DeleteKey(Key: Word);
var
	P, D, E: Integer;
	N: Boolean;
	str0 : string;
begin
	D := pos(DecimalSeparator, Text);
	E := pos('E', Text);
	if E = 0 then E := length(Text) + 1;
	if Key = VK_DELETE then
	begin
		P := SelStart + 1;
		if P > Length(Text) then Exit;
		if Text[P] in [ThousandSeparator, DecimalSeparator, 'E'] then inc(P);
	end
	else
	begin
		P := SelStart;
		if P = 0 then Exit;
		if Text[P] in [ThousandSeparator, DecimalSeparator, 'E'] then dec(P);
	end;
	N := (Pos('-', Text) > 0);
	if (P = 0) or (P > Length(Text)) then exit;
	str0 := '';
	if (P > D) and (D <> 0) and ((P < E) or (E = 0)) then
	begin
		if FDecimals > 0 then str0 := '0';
		Text := Copy(Text, 1, P - 1) + Copy(Text, P + 1,E - P - 1)
			+ str0 + Copy(Text, E, length(Text) - E + 1);
		SelStart := P - 1;
	end
	else if (P = 1) and N then
	begin
		Text := Copy(Text, 2, Length(Text) - 1);
		if Text = '' then Text := '0';
	end
	else if (P = 1) and ((P = D - 1) or (P = E - 1) or (P = length(Text))) then
	begin
		Text := '0' + Copy(Text, 2, Length(Text) - 1);
		SelStart := 1;
		if N then Text := '-' + Text;
	end
	else if P > 0 then
	begin
		Text := Copy(Text, 1, P - 1) + Copy(Text, P + 1, Length(Text) - P);
		SelStart := P - 1;
		if ((FNumberFormat = Scientific) or (FNumberFormat = Engineering))
			and (Text[length(Text)] = 'E') then Text := Text + '0';
	end;
end;

procedure TPBNumEdit.DeleteSelection;
var
	X, Y, Z: Integer;
begin
	if SelLength = 0 then exit;
	if SelText = Text then
	begin
		Text := FormatText(0);
		exit;
	end;
	Y := Length(Remove1000(SelText));
	if pos(DecimalSeparator, SelText) <> 0 then dec(Y);
	Z := Length(SelText);
	SelStart := SelStart + Z;
	for X:= 1 to Y do
	begin
		DeleteKey(VK_BACK);
	end;
end;

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

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

procedure TPBNumEdit.WMCopy(var Message: TMessage);
begin
	ClipBoard.AsText := Remove1000(Seltext);
end;

procedure TPBNumEdit.WMCut(var Message: TMessage);
begin
	ClipBoard.AsText := Remove1000(Seltext);
	DeleteSelection;
end;

procedure TPBNumEdit.WMPaste(var Message: TMessage);
var
	X: integer;
	S: String;
	W: Word;
begin
	DeleteSelection;
	S := Clipboard.AsText;
	for X := 1 to Length(S) do
	begin
		W := Ord(S[X]);
		Perform(WM_CHAR, W, 0);
	end;
end;

procedure TPBNumEdit.SetNumberFormat(Value: TNumberFormat);
begin
	if FNumberFormat <> Value then FNumberFormat := Value;
	Text := FormatText(AsFloat);
end;

function TPBNumEdit.Remove1000(Num : string): string;
var
	t : integer;
begin
	Result := '';
	for t :=1 to length(Num) do
	begin
		if Num[t] <> ThousandSeparator then Result := Result + Num[t];
	end;
	if Result = '' then Result := '0';
	if Result = '-' then Result := '-0';
end;

function TPBNumEdit.FormatText(Value: Extended) : string;
var
	e0, E, D, NN, t, FD : integer;
	a : extended;
	Formatmask : string;
begin
	if (FNumberFormat = Engineering) and (Value <> 0) then
	begin
		e0 := trunc(ln(abs(Value)) / ln(10) / 3) * 3;
		Result := 'E' + inttostr(e0);
		a := Value / StrToFloat('1' + Result);
		FD := 14;
		if a > 9 then dec(FD);
		if a > 99 then dec(FD);
		if (FD > FDecimals) and (FDecimals <> -1) then FD := FDecimals;
		if FDecimals < 0 then Result := formatfloat('0.' + StringOfChar('#',FD), a) + Result
		else if FDecimals = 0 then Result := formatfloat('0', a) + Result
		else Result := formatfloat('0.' + StringOfChar('0',FD), a) + Result;
	end
	else
	begin
		FormatMask := '0';
		if FNumberFormat = Thousands then FormatMask := ',' + FormatMask;
		if FDecimals > 0 then FormatMask := FormatMask + '.' + StringOfChar('0', FDecimals)
		else if FDecimals < 0 then FormatMask := FormatMask + '.' + StringOfChar('#', 14);
		if FNumberFormat > Thousands then FormatMask := FormatMask + 'E-';
		Result := FormatFloat(FormatMask, Value);
		E := pos('E',Result);
		if E = 0 then
		begin
			D := pos(DecimalSeparator, Result);
			if (D <> 0) then
			begin
				NN := 0;
				for t := 1 to D do if (Result[t] in ['0'..'9'] = True) then inc(NN);
				if (FDecimals = -1) then
				begin
					if FNumberFormat = Thousands then Result := FormatFloat(',0.' + StringOfChar('#',15 - NN),Value)
					else if FDecimals <> -1 then Result := FormatFloat('0.' + StringOfChar('#',15 - NN),Value);
				end
				else if (FDecimals > 15 - NN) then
				begin
					if FNumberFormat = Thousands then Result := FormatFloat(',0.' + StringOfChar('0',15 - NN),Value)
					else if FDecimals <> -1 then Result := FormatFloat('0.' + StringOfChar('0',15 - NN),Value);
					Result := Result + StringOfChar('0', Fdecimals -15 + NN);
				end;
			end;
		end;
	end;
end;

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

end.
