只允许输入Double类型的Edit组件

老早写的一个只允许输入Double类型的Edit组件,今天翻到了,就放上来了,希望对大家有所帮助!
具体的使用和几个属性有关:Min/Max/Digits,
Min/Max就不说了,至于Digits是说Double类型的小数位数!
具体使用大家用用就知道了,不难^-^

{**
* 单元：FloatEdit
* 作者：网事如风
* 作用：只允许输入Double类型的Edit
* 使用：
**}

unit FloatEdit;

interface

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

type
  TFloat_Edit = class(TEdit)
  private
    { Private declarations }

    //设置小数位数：
    FDigits : byte;
    FDec : char;

    //设置最大值最小值：
    FMin,FMax : Real;

    FerText : String;
    FoldVal : Real;

  protected

    Function  GetValue : Real;
    procedure SetValue(NewValue : Real);

    procedure SetMin(NewValue : Real);
    procedure SetMax(NewValue : Real);

    procedure SetDigits(Newvalue : byte);

    procedure KeyPress(var Key : Char); OverRide;
    procedure DoExit;  OverRide;
    procedure DoEnter; OverRide;
  public

  published

    property Min   : Real  Read FMin     Write SetMin;
    property Max   : Real  Read FMax     Write SetMax;
    property Value : Real  Read GetValue Write SetValue;

    property Digits : byte Read FDigits  Write SetDigits;

    property ErrorMessage : String Read FerText Write FerText;

    Constructor Create (AOwner : TComponent); OverRide;
  end;

procedure Register;

Const
    Notext = '[No Text]';

implementation

procedure Register;
begin
    RegisterComponents('TianComponent', [TFloat_Edit]);
end;

{ TFloatEdit }

constructor TFloat_Edit.Create(AOwner: TComponent);
begin
    Inherited
    Create(AOwner);
    FDec := DecimalSeparator;  //Char --> FDec = '.'

    FDigits := 1;
    FMin := 0;
    FMax := 99999999.9;
    FerText := NoText; //'[No Text]'
    SetValue(0.0);
end;

procedure TFloat_Edit.DoEnter;
begin
    FoldVal := GetValue;
    Inherited;
end;

procedure TFloat_Edit.DoExit;
var
    Temp_Str : string;
    Result : Real;
begin
     Temp_Str := Text;
     Inherited;

     Try
         Result := StrToFloat(Temp_Str);
     Except
         if FerText <> NoText then
             ShowMessage(FerText);
         SetValue(FoldVal);
         SelectAll;
         SetFocus;
         Exit;
     end;

     if (Result < FMin) or (Result > FMax) then
     begin
         if FerText <> NoText then
             ShowMessage(FerText);
         SetValue(FoldVal);
         SelectAll;
         SetFocus;
         Exit;
     end;

     Text := FloatToStrF(Result,FFFixed,18,FDigits);
     Value := StrToFloat(Text);
     Inherited;
end;

function TFloat_Edit.GetValue(): Real;
var
    Temp_Str : string;
begin
    Temp_Str := Text;
    if (Temp_Str = '-') or (Temp_Str = FDec) or (Temp_Str = '') then
        Temp_Str := '0';
    Try
        Result := StrToFloat(Temp_Str);
    Except
        Result := FMin;
    end;
end;

procedure TFloat_Edit.KeyPress(var Key: Char);
var
     Temp_Str : string;
begin
    if Key = #27 then
    begin
       SetValue(FoldVal);
       SelectAll;
       Inherited;
       Exit;
    end;

    if key < #32 then
    begin
       Inherited;
       Exit;
    end;

    Temp_Str := Copy(Text,1,SelStart) + Copy(Text,SelStart + SelLength + 1, 500);

    if (Key <  '0')   or  (Key >  '9')  then
    if (Key <> FDec) and  (Key  <> '-') then
    begin
        Inherited;
        Key := #0;
        Exit;
    end;

    if Key = FDec then
    if Pos(FDec,Temp_Str) <> 0 then
    begin
        Inherited;
        Key := #0;
        Exit;
    end;

    if Key = '-' then
    if Pos('-',Temp_Str) <> 0 then
    begin
        Inherited;
        Key := #0;
        Exit;
    end;

    if Key = '-' then
    if FMin >= 0 then
    begin
        Inherited;
        Key := #0;
        Exit;
    end;

    if Key = FDec then
    if FDigits = 0 then
    begin
        Inherited;
        Key := #0;
        Exit;
    end;

    Temp_Str := Copy(Text,1,SelStart) + Key + Copy(Text,SelStart + SelLength + 1,500);

    if Key > #32 then
    if Pos(FDec,Temp_Str) <> 0 then
    if Length(Temp_Str) - pos(FDec,Temp_Str) > FDigits then
    begin
        Inherited;
        Key := #0;
        Exit;
    end;

    if Key = '-' then
    if Pos('-',Temp_Str) <> 1 then
    begin
        Inherited;
        Key := #0;
        Exit;
    end;

    if Temp_Str = '' then
    begin
        Inherited;
        Key := #0;
        Text := FloatToStrF(FMin,FFFixed,18,FDigits);
        SelectAll;
        Exit;
    end;

    if Temp_Str = '-' then
    begin
        Inherited;
        Key := #0;
        Text := '-0';
        SelStart := 1;
        SelLength := 1;
        Exit;
    end;

    if Temp_Str = FDec then
    begin
        Inherited;
        Key := #0;
        Text := '0' + FDec + '0';
        SelStart := 2;
        SelLength := 1;
        Exit;
    end;

    Inherited;
end;

procedure TFloat_Edit.SetDigits(Newvalue: byte);
begin
    if FDigits <> NewValue then
    begin
        if NewValue > 18 then
            NewValue := 18;
        FDigits := NewValue;
        SetValue(GetValue);
    end;
end;

procedure TFloat_Edit.SetMax(NewValue: Real);
begin
    if FMin > FMax then
    begin
        ShowMessage('最大值必须不小于最小值!');
        NewValue := FMin;
    end;
    FMax := NewValue;
    SetValue(GetValue);
end;

procedure TFloat_Edit.SetMin(NewValue: Real);
begin
    if FMin > FMax then
    begin
        ShowMessage('最小值必须不大于最大值!');
        NewValue := FMax;
    end;
    FMin := NewValue;
    SetValue(GetValue);
end;

procedure TFloat_Edit.SetValue(NewValue: Real);
var
    Temp_Str : String;
begin
    if NewValue > FMax then
    begin
        if FerText <> NoText then
            ShowMessage(FerText);
        NewValue := FMax;
    end;

    if NewValue < FMin then
    begin
        if FerText <> NoText then
            ShowMessage(FerText);
        NewValue := FMin;
    end;

    Temp_Str := FloatToStrF(NewValue,FFFixed,18,FDigits);
    Text := Temp_Str;
end;

end.