D7下的只能输入数字的控件（类似PB的MaskEdit）

【 tulaoshi.com - 编程语言 】

　　我发现Delphi下没有很好用的只能输入数字的控件。所以自己写了一个（D7）。

　　菜鸟一个，希望大家多多指点。呵呵。。。

　　unit ComerMaskEdit;

　　interface

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

　　type
　　  TComerMaskEdit = class(TEdit)
　　  private
　　    FMdNumber: string;
　　    FIpo : Integer;
　　    FLen : Integer;
　　    procedure SetMdNumber(const Value: string);
　　    procedure WMPaste(var Message: TMessage); message WM_PASTE;
　　    { Private declarations }
　　  protected
　　    procedure CreateWnd;override;
　　    { Protected declarations }
　　  public
　　    constructor Create(AOwner:TComponent);override;
　　    procedure DoEnter(); override;
　　    procedure DoExit(); override;
　　    procedure KeyPress(var Key: Char); override;
　　    procedure KeyDown (var Key: Word; Shift: TShiftState);override;
　　    { Public declarations }
　　  published
　　    property MdNumber:string read FMdNumber write SetMdNumber;
　　    { Published declarations }
　　  end;

　　procedure Register;

　　implementation

　　procedure Register;
　　begin
　　  RegisterComponents('Standard', [TComerMaskEdit]);
　　end;

　　{TComerMaskEdit}

　　constructor TComerMaskEdit.Create(AOwner: TComponent);
　　begin
　　  inherited Create(AOwner);
　　    Font.Size :=12;
　　    Font.Name:='宋体';
　　    Font.Charset:=GB2312_CHARSET;
　　    FMdNumber := '';
　　end;

　　procedure TComerMaskEdit.CreateWnd;
　　var
　　  I, k : Integer;
　　  S, Str : string;
　　begin
　　  inherited;
　　    if not Enabled then
　　        Font.Color := clNavy;
　　    Font.Size :=12;
　　    Font.Name :='宋体';
　　    Font.Charset :=GB2312_CHARSET;
　　    if FMdNumber '' then
　　    begin
　　        I := Pos(',',FMdNumber);
　　        if I 0 then
　　        begin
　　            S := Copy(FMdNumber,1,I-1);
　　            FIpo := StrToInt(Copy(FMdNumber,I+1,Length(FMdNumber)-I));
　　            for k:=1 to FIpo do
　　                Str := Str + '0';
　　            Text := '.' + Str;
　　        end
　　        else
　　        begin
　　            S := FMdNumber;
　　            FIpo := 0;
　　            Text := '';
　　        end;
　　        MaxLength := StrToInt(S);
　　        FLen := MaxLength;
　　        imeMode := imClose;
　　    end;
　　end;

　　procedure TComerMaskEdit.SetMdNumber(const Value: string);
　　var
　　  S : string;
　　begin
　　    if Value '' then
　　    begin
　　        S := StringReplace(Value,',','',[rfIgnoreCase]);
　　        try
　　            StrToInt(S);
　　        except
　　            Application.MessageBox('属性值设置不对！','错误',MB_OK+MB_ICONError);
　　            FMdNumber := '';
　　            Exit;
　　        end;
　　    end;
　　    FMdNumber := Value;
　　end;

　　procedure TComerMaskEdit.DoEnter();
　　begin
　　    inherited;
　　    SelStart := 0;
　　end;

　　procedure TComerMaskEdit.DoExit();
　　begin
　　    if (FIpo0) and (Pos('.',Text)=0) then
　　        Text := Text + '.' + StringOfChar('0',FIpo)
　　    else
　　        inherited;
　　end;

　　procedure TComerMaskEdit.KeyPress(var Key: Char);
　　var
　　    I, k : Integer;
　　    AfterDot, BeforSelStart : string;
　　    //, AfterSelStart,
　　    Str : string;
　　    TmpText : string;
　　    iSelStart: Integer;
　　    //BeforComma, AfterComma : String;
　　begin
　　    //如果有多个字符被选中
　　    if SelLength 0 then
　　        SelStart := 0
　　    else
　　    begin
　　        if FMdNumber '' then
　　        begin
　　            if (Length(Text)=0) and (FIpo0) then
　　            begin
　　                for k:=1 to FIpo do
　　                    Str := Str + '0';
　　                Text := '.' + Str;
　　            end;
　　            case Key of
　　                #13:
　　                    inherited;
　　                '-':
　　                begin
　　                    if (SelStart0) or (Pos('-',Text)0) then
　　                        Key := #0
　　                    else
　　                        //MaxLength := MaxLength + 1;
　　                        inherited;
　　                end;
　　                #8:
　　                begin
　　                    I := Pos('.',Text);
　　                    if (I 0) and (SelStartI) then
　　                    begin
　　                        key := #0;
　　                        iSelStart := SelStart;
　　                        TmpText := Text;
　　                        BeforSelStart := Copy(TmpText,1,iSelStart-1);
　　                        Text := BeforSelStart + Copy(TmpText,iSelStart+1,Length(TmpText)-iSelStart) + '0';
　　                        SelStart := iSelStart - 1;
　　                    end
　　                    else if (I 0) and (SelStart=I) then
　　                    begin
　　                        key := #0;
　　                        iSelStart := SelStart;
　　                        SelStart := iSelStart - 1;
　　                    end
　　                    else
　　                        inherited;
　　                end;
　　                '0'..'9':
　　                begin
　　                    I := Pos('.',Text);
　　                    //限制位数
　　                    if I 0 then
　　                    begin
　　                        if SelStart = Length(Text) then
　　                            key := #0
　　                        else
　　                        begin
　　                            AfterDot := Copy(Text,I+1,Length(Text)-FIpo);
　　                            if Length(AfterDot) FIpo then
　　                                key := #0
　　                            else if SelStart = I then
　　                            begin
　　                                iSelStart := SelStart;
　　                                TmpText := Text;
　　                                BeforSelStart := Copy(TmpText,1,iSelStart);
　　                                Text := BeforSelStart + Copy(TmpText,iSelStart+2,Length(TmpText)-iSelStart-1);
　　                                SelStart := iSelStart;
　　                            end
　　                            else
　　                                inherited;
　　                        end;
　　                    end
　　                    else if (I=0) and (FIpo0) then  //这种情况基本不存在
　　                    begin
　　                        if Length(Text) = FLen-FIpo-1 then
　　                            key := #0
　　                        else
　　                            inherited;
　　                    end
　　                    else  //FIpo=0
　　                        inherited;
　　                end;
　　                '.':
　　                begin
　　                    Key := #0;
　　                    if FIpo0 then
　　                        SelStart := Pos('.',Text);
　　                end;
　　                else
　　                    Key := #0;
　　            end;
　　        end
　　        else
　　            //Key := #0;
　　            inherited;
　　    end;
　　end;

　　procedure TComerMaskEdit.KeyDown(var Key: Word; Shift: TShiftState);
　　var
　　    I : Integer;
　　    BeforSelStart : string;
　　    TmpText : string;
　　    iSelStart: Integer;
　　begin
　　    //如果有多个字符被选中
　　    if SelLength 0 then
　　    begin
　　        Key := 0;
　　        SelStart := 0;
　　    end
　　    else
　　    begin
　　        if FMdNumber '' then
　　        begin
　　            if Key=VK_DELETE then
　　            begin
　　                I := Pos('.',Text);
　　                if (I 0) and (SelStart=I) then
　　                begin
　　                    key := 0;
　　                    iSelStart := SelStart;
　　                    TmpText := Text;
　　                    BeforSelStart := Copy(TmpText,1,iSelStart);
　　                    if (SelStart=Length(Text)) then
　　                        Text := BeforSelStart + Copy(TmpText,iSelStart+2,Length(TmpText)-iSelStart-1)
　　                    else
　　                        Text := BeforSelStart + Copy(TmpText,iSelStart+2,Length(TmpText)-iSelStart-1) + '0';
　　                    SelStart := iSelStart;
　　                end
　　                else if (I 0) and (SelStart=I-1) then
　　                begin
　　                    key := 0;
　　                    iSelStart := SelStart;
　　                    SelStart := iSelStart + 1;
　　                end;
　　            end
　　            else if (Key=VK_TAB) or (Key=VK_LEFT) or (Key=VK_UP) or (Key=VK_RIGHT) or (Key=VK_DOWN) or (Key=VK_END) or (Key=VK_HOME) then
　　                inherited
　　            else
　　                Key := 0;

　　        end
　　        else
　　            inherited;
　　    end;
　　end;

　　procedure TComerMaskEdit.WMPaste(var Message: TMessage);
　　begin
　　    if FMdNumber='' then
　　        inherited;
　　end;

　　end.