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

我发现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 (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.