程序師世界是廣大編程愛好者互助、分享、學習的平台,程序師世界有你更精彩!
首頁
編程語言
C語言|JAVA編程
Python編程
網頁編程
ASP編程|PHP編程
JSP編程
數據庫知識
MYSQL數據庫|SqlServer數據庫
Oracle數據庫|DB2數據庫
 程式師世界 >> 編程語言 >> 更多編程語言 >> Delphi >> D7下的只能輸入數字的控件(類似PB的MaskEdit)

D7下的只能輸入數字的控件(類似PB的MaskEdit)

編輯:Delphi

  我發現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;

  

  1. 上一頁:
  2. 下一頁:
Copyright © 程式師世界 All Rights Reserved