登录社区:用户名: 密码: 忘记密码 网页功能:加入收藏 设为首页 网站搜索  

文档

下载

图书

论坛

安全

源码

硬件

游戏
首页 信息 空间 VB VC Delphi Java Flash 补丁 控件 安全 黑客 电子书 笔记本 手机 MP3 杀毒 QQ群 产品库 分类信息 编程网站
  立华软件园 - 安全技术中心 - 技术文档 - Delphi 技术文章 | 相关下载 | 电子图书 | 攻防录像 | 安全网站 | 在线论坛 | QQ群组 | 搜索   
 安全技术技术文档
  · 安全配制
  · 工具介绍
  · 黑客教学
  · 防火墙
  · 漏洞分析
  · 破解专题
  · 黑客编程
  · 入侵检测
 安全技术工具下载
  · 扫描工具
  · 攻击程序
  · 后门木马
  · 拒绝服务
  · 口令破解
  · 代理程序
  · 防火墙
  · 加密解密
  · 入侵检测
  · 攻防演示
 安全技术论坛
  · 安全配制
  · 工具介绍
  · 防火墙
  · 黑客入侵
  · 漏洞检测
  · 破解方法
 其他安全技术资源
  · 攻防演示动画
  · 电子图书
  · QQ群组讨论区
  · 其他网站资源
最新招聘信息

只允许输入Double类型的Edit组件
发表日期:2005-03-16作者:网事如风[原创] 出处:  

老早写的一个只允许输入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.
我来说两句】 【发送给朋友】 【加入收藏】 【返加顶部】 【打印本页】 【关闭窗口
中搜索 只允许输入Double类型的Edit组件

 ■ [欢迎对本文发表评论]
用  户:  匿名发出:
您要为您所发的言论的后果负责,故请各位遵纪守法并注意语言文明。

最新招聘信息

关于我们 / 合作推广 / 给我留言 / 版权举报 / 意见建议 / 广告投放 / 友情链接  
Copyright ©2001-2006 Lihuasoft.net webmaster(at)lihuasoft.net
网站编程QQ群   京ICP备05001064号 页面生成时间:0.00188