执行这些代码, Edit1只能输入数字,小数点和负号,负号和小数点只能输入一个,负号必须在最前,粘贴的数字必须完全正确.

执行这些代码, Edit1只能输入数字,小数点和负号,负号和小数点只能输入一个,负号必须在最前,粘贴的数字必须完全正确.

type
  TForm1 = class(TForm)
    Edit1: TEdit;
    procedure FormCreate(Sender: TObject);
  private
    Edit1OldProc: TWndMethod;
    procedure Edit1NewProc(var Message: TMessage);
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

uses Clipbrd;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Edit1OldProc := Edit1.WindowProc;
  Edit1.WindowProc := Edit1NewProc;
end;

procedure TForm1.Edit1NewProc(var Message: TMessage);
var
  s: string;
  v: double;
begin
  case Message.Msg of
    WM_PASTE:
      begin
        s := Clipboard.astext;
        s := copy(edit1.Text, , edit1.SelStart) + s + copy(edit1.Text, edit1.SelStart + edit1.SelLength, length(edit1.Text));
        if trystrtofloat(s, v) then
          Edit1OldProc(Message)
        else
          ShowMessage('只允许输入数字');
      end;
    WM_CHAR:
      begin
        if (TWMCHAR(Message).CharCode = ) then
          if (Pos('-', Edit1.Text) = ) and (Edit1.SelStart = ) then
          Edit1OldProc(Message);
        if (TWMCHAR(Message).CharCode = ) then
          if (Pos('.', Edit1.Text) = ) then
          Edit1OldProc(Message);
        if TWMCHAR(Message).CharCode in [.., , ] then
          Edit1OldProc(Message);
        if (TWMCHAR(Message).CharCode = )  then
          Edit1OldProc(Message);
      end;
  else
    Edit1OldProc(Message);
  end;
end;
-----------