|
老早写的一个只允许输入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. |
