unit NumEdit;
interface
uses
Windows,Messages,SysUtils,Classes,Graphics,Controls,Forms,StdCtrls;
const
NumChars: set of Char = ['0'..'9'];
MaxBinary = 32;
MaxHex = 8;
type
TEditType = (etString,etInteger,etFloat,etBinary,etHex,etIntString,etPercent);
TNumEdit = class(TEdit)
private
FEditType: TEditType;
FAutoFocus: Bool;
FNextDialogOnEnter: Bool;
FNextDialogOnCursorKeys: Bool;
FPrecision: Byte;
FDecimals: Byte;
FFocusWidthInc: Integer;
FMin: Double;
FMax: Double;
FColorFocus: TColor;
FColorNoFocus: TColor;
FColorError: TColor;
FOnInvalidValue: TNotifyEvent;
FOnLimitMin: TNotifyEvent;
FOnLimitMax: TNotifyEvent;
CharSet: set of Char;
Error: Boolean;
Form: TCustomForm;
FTextAlign: TAlignment;
procedure SetTextAlign(const Value: TAlignment);
protected
procedure KeyPress(var Key: Char); override;
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
procedure WndProc(var Message: TMessage); override;
function NoValidValue: Bool;
procedure SetEditType(Value: TEditType);
procedure SetColor(Index: Integer; Value: TColor);
function IntToBin(Value,Digits: Integer): ShortString;
function BinToInt(const Value: ShortString): Integer;
function HexToInt(const Value: ShortString): Integer;
procedure CMEnter(var Message: TCMGotFocus); message CM_ENTER;
procedure CMExit(var Message: TCMExit); message CM_EXIT;
procedure CreateParams(var Params: TCreateParams);override;
public
constructor Create(AOwner: TComponent); override;
function CheckError: Bool;
procedure SetInteger(Value: Integer);
procedure SetFloat(Value: Double);
function GetInteger: Integer;
function GetFloat: Double;
published
property Precision: Byte index 0 read FPrecision write FPrecision;
property Decimals: Byte index 1 read FDecimals write FDecimals;
property FocusWidthInc: Integer read FFocusWidthInc write FFocusWidthInc DEFAULT 0;
property EditType: TEditType read FEditType write SetEditType;
property TextAlign: TAlignment read FTextAlign write SetTextAlign default taRightJustify;
property NextDialogOnEnter: Bool read FNextDialogOnEnter write FNextDialogOnEnter;
property NextDialogOnCursorKeys: Bool read FNextDialogOnCursorKeys write FNextDialogOnCursorKeys;
property AutoFocus: Bool read FAutoFocus write FAutoFocus DEFAULT False;
property Min: Double read FMin write FMin;
property Max: Double read FMax write FMax;
property ColorFocus: TColor index 0 read FColorFocus write SetColor;
property ColorNoFocus: TColor index 1 read FColorNoFocus write SetColor;
property ColorError: TColor index 2 read FColorError write SetColor;
property OnInvalidValue: TNotifyEvent read FOnInvalidValue write FOnInvalidValue;
property OnLimitMin: TNotifyEvent read FOnLimitMin write FOnLimitMin;
property OnLimitMax: TNotifyEvent read FOnLimitMax write FOnLimitMax;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Gaoshan', [TNumEdit]);
end;
constructor TNumEdit.Create;
begin
inherited;
FPrecision:=15;
FDecimals:=2;
FNextDialogOnEnter:=True;
FNextDialogOnCursorKeys:=True;
FAutoFocus:=False;
FColorFocus:=clWindow;
FColorNoFocus:=clWindow;
FColorError:=clRed;
Color:=clWindow;
FFocusWidthInc:=0;
Text:='0';
FMin:=0;
FMax:=65535;
FEditType:=etInteger;
FOnInvalidValue:=nil;
FOnLimitMin:=nil;
FOnLimitMax:=nil;
FTextAlign :=taRightJustify;
Error:=False;
SetEditType(FEditType);
SetInteger(0);
SetTextAlign(FTextAlign);
end;
procedure TNumEdit.SetTextAlign(const Value: TAlignment);
begin
FTextAlign := Value;
RecreateWnd;
end;
procedure TNumEdit.CreateParams(var Params: TCreateParams);
const
Alignments: array [TAlignment] of DWord = (ES_LEFT, ES_RIGHT, ES_CENTER);
begin
inherited CreateParams(Params);
with Params do
begin
Style := Params.Style or ES_MULTILINE or Alignments[FTextAlign];
end;
end;
procedure TNumEdit.KeyPress(var Key: Char);
begin
if not (FEditType = etString) then Key:=UpCase(Key);
if FNextDialogOnEnter and (Key = #13) then
begin
Key:=#0;
Form:=GetParentForm(Self);
if Assigned(Form) then SendMessage(Form.Handle,WM_NEXTDLGCTL,0,0);
end
else if not ((Key = #8) or (Key in CharSet)) then Key:=#0;
inherited;
end;
procedure TNumEdit.KeyDown(var Key: Word; Shift: TShiftState);
var
CtlDir: Word;
begin
if FNextDialogOnCursorKeys and ((Key = VK_UP) or (Key = VK_DOWN)) then
begin
Form:=GetParentForm(Self);
if Key = VK_UP then CtlDir:=1 else CtlDir:=0;
if Assigned(Form) then SendMessage(Form.Handle,WM_NEXTDLGCTL,CtlDir,0);
end
else inherited KeyDown(Key,Shift);
end;
procedure TNumEdit.WndProc(var Message: TMessage);
begin
case Message.Msg of
WM_PAINT: if Focused then Color:=FColorFocus
else if not Error then Color:=FColorNoFocus else Color:=FColorError;
WM_SETFOCUS: begin
Error:=False;
if FFocusWidthInc <> 0 then Width:=Width + FFocusWidthInc;
Perform(WM_PAINT,0,0);
end;
WM_KILLFOCUS: begin
Error:=CheckError;
if FFocusWidthInc <> 0 then Width:=Width - FFocusWidthInc;
if not Error and (FEditType = etFloat) then SetFloat(GetFloat);
Perform(WM_PAINT,0,0);
end;
cm_MouseEnter: if FAutoFocus then SetFocus;
end;
inherited;
end;
function TNumEdit.CheckError: Bool;
var
Temp: Double;
i:Integer;
ThisText:String;
FloatNum:Real;
begin
Result:=False;
Temp:=0;
if not (FEditType = etString) then
begin
Result:=NoValidValue;
if Result and Assigned(FOnInvalidValue) then FOnInvalidValue(Self) else
begin
case FEditType of
etFloat: Temp:=GetFloat;
etInteger: Temp:=GetInteger;
etHex: Temp:=GetInteger;
etBinary: Temp:=GetInteger;
etIntString: Temp:=GetInteger;
etPercent:begin
ThisText:=Text;
i:=Pos('%',ThisText);
if i>0 then
begin
Delete(ThisText,i,Length(ThisText)-(i-1));
try
if ThisText='' then
ThisText:='0';
FloatNum:=(StrToFloat(ThisText))/100;
except
on exception do
FloatNum:=1;
end;
end else
begin
if ThisText='' then
ThisText:='0';
FloatNum:=StrToFloat(ThisText);
end;
Temp:=Round(FloatNum*1000000)/1000000;
end;
end;
Result:=Temp < FMin;
if Result and Assigned(FOnLimitMin) then FOnLimitMin(Self)
else
begin
Result:=Temp > FMax;
if Result and Assigned(FOnLimitMax) then FOnLimitMax(Self);
end;
end;
end;
end;
procedure TNumEdit.SetEditType(Value: TEditType);
begin
FEditType:=Value;
Text:='0';
case FEditType of
etBinary: CharSet:=['0','1'];
etHex: begin CharSet:=NumChars + ['A'..'F'];FMax:=0;end;
etInteger: CharSet:=NumChars + ['-'];
etFloat: CharSet:=NumChars + ['-'] + [DecimalSeparator] + ['E'];
etString:begin CharSet:=[#0..#255];Text:='';end;
etIntString: begin CharSet:=NumChars + ['-'];Text:='';end;
etPercent:begin CharSet:=NumChars+[DecimalSeparator]+['%'];end;
end;
end;
procedure TNumEdit.SetColor(Index: Integer; Value: TColor);
begin
case Index of
0: FColorFocus:=Value;
1: FColorNoFocus:=Value;
2: FColorError:=Value;
end;
Repaint;
end;
procedure TNumEdit.SetInteger(Value: Integer);
begin
case FEditType of
etFloat: Text:=FloatToStrF(Value,ffFixed,FPrecision,FDecimals);
etInteger: Text:=IntToStr(Value);
etHex: Text:=IntToHex(Value,MaxLength);
etBinary: Text:=IntToBin(Value,MaxLength);
etIntString: Text:=IntToStr(Value);
etPercent: Text:=FloatToStrF(Value*100,ffFixed,FPrecision,FDecimals)+'%';
end;
end;
procedure TNumEdit.SetFloat(Value: Double);
begin
if FEditType = etFloat then Text:=FloatToStrF(Value,ffFixed,FPrecision,FDecimals)
else if not (FEditType = etFloat) then SetInteger(Round(Value));
end;
function TNumEdit.GetInteger: Integer;
var
Error1: Integer;
i:Integer;
ThisText:String;
begin
Result:=0;
case FEditType of
etFloat,
etInteger: Val(Text,Result,Error1);
etHex: Result:=HexToInt(Text);
etBinary: Result:=BinToInt(Text);
etIntString: Val(Text,Result,Error1);
etPercent:begin
ThisText:=Text;
i:=Pos('%',ThisText);
if i>0 then
Delete(ThisText,i,Length(ThisText)-(i-1))
else
ThisText:=IntToStr(StrToIntDef(ThisText,1)*100);
Val(ThisText,Result,Error1);
end;
end;
end;
function TNumEdit.GetFloat: Double;
begin
Result:=0.0;
if (FEditType = etFloat) and not NoValidValue then
begin
if Text='' then
Text:='0.00';
Result:=StrToFloat(Text);
end;
end;
function TNumEdit.NoValidValue: Bool;
var
N: Byte;
begin
Result:=False;
Text:=Trim(Text);
if Length(Text) > 0 then
begin
for N:=1 to Length(Text) do if not (Text[N] in CharSet) then Result:=True;
if not Result then
begin
if (FEditType = etInteger) or (FEditType = etFloat) then
if Pos('-',Text) > 1 then Result:=True
else if (FEditType=etPercent) then
if Pos('%',Text) > 1 then Result:=True;
end;
end
else Result:=True;
end;
function TNumEdit.IntToBin(Value,Digits: Integer): ShortString;
var
C: Cardinal;
N: Integer;
begin
Result:='';
C:=1;
if (Digits < 1) or (Digits > 32) then Exit;
for N:=1 to Digits do
begin
if Value and C = C then Result:='1' + Result else Result:='0' + Result;
C:=C shl 1;
end;
end;
function TNumEdit.BinToInt(const Value: ShortString): Integer;
var
Add: Integer;
N,Len: Byte;
begin
Result:=0;
Len:=Length(Value);
if (Len < 1) or (Len > MaxBinary) then Exit;
Add:=1;
for N:=Len downto 1 do
begin
if not (Value[N] in ['0','1']) then Exit;
if Value[N] = '1' then Result:=Result + Add;
Add:=Add shl 1;
end;
end;
function TNumEdit.HexToInt(const Value: ShortString): Integer;
var
Hex: Integer;
N,Len,Digit: Byte;
Ch: Char;
begin
Result:=0;
Len:=Length(Value);
if (Len < 1) or (Len > MaxHex) then Exit;
Hex:=1;
for N:=Len downto 1 do
begin
Ch:=Value[N];
if not (Ch in ['0'..'9','A'..'F']) then Exit;
if Ch in ['0'..'9'] then Digit:=Ord(Ch) - 48 else Digit:=Ord(Ch) - 55;
Result:=Result + (Digit * Hex);
Hex:=Hex shl 4;
end;
end;
procedure TNumEdit.CMEnter(var Message: TCMGotFocus);
begin
inherited;
end;
procedure TNumEdit.CMExit(var Message: TCMExit);
Var ThisText:String;
begin
if FEditType=etPercent then
begin
if pos('%',Text)<=0 then
begin
if Text='' then
Text:='0';
Text:=FloatToStrF(StrToFloat(Text)*100,ffFixed,FPrecision,FDecimals)+'%'
end
else
begin
if Text='%' then
Text:='0.00%'
else
begin
ThisText:=Text;
Delete(ThisText,pos('%',Text),Length(Text)-(pos('%',Text)-1));
Text:=Text;
end;
end;
end;
inherited;
end;
initialization
end.
