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

unit ComerMaskEdit;

//2005-1-1

//comerliang

//D7下的只能输入数字的控件（类似PB的MaskEdit）
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 (FIpo>0) 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 (FIpo>0) then
            begin
                for k:=1 to FIpo do
                    Str := Str + '0';
                Text := '.' + Str;
            end;
            case Key of
                #13:
                    inherited;
                '-':
                begin
                    if (SelStart<>0) or (Pos('-',Text)>0) then
                        Key := #0
                    else
                        //MaxLength := MaxLength + 1;
                        inherited;
                end;
                #8:
                begin
                    I := Pos('.',Text);
                    if (I > 0) and (SelStart>I) 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 (FIpo>0) then  //这种情况基本不存在
                    begin
                        if Length(Text) >= FLen-FIpo-1 then
                            key := #0
                        else
                            inherited;
                    end
                    else  //FIpo=0
                        inherited;
                end;
                '.':
                begin
                    Key := #0;
                    if FIpo>0 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.