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

来源：互联网发布：三茅软件编辑：程序博客网时间：2024/05/16 11:14

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