⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 numedit.pas

📁 数字输入控件
💻 PAS
字号:
unit NumEdit;

interface

uses
  Windows, Messages, SysUtils, Classes, Controls, StdCtrls, SUIEdit, suiThemes, forms;

type
  TCustomNumEdit = class(TsuiEdit)
  private
      property OnChange;
      property OnKeyPress;

  end;
  TNumEdit = class(TCustomNumEdit)
  private
    FHandled: boolean; //是否处理过文本Change事件
    FOldText: string;
    FNumericOnly: boolean; //是否只能输入数字(包括整数浮点), 缺省为true
    FIntCount, FDigCount : integer;  //整数部分的位数,小数部分的位数
    FWordOnly: boolean;
    FBeepOnError: boolean;
    FHintOnError: boolean;
  protected
    procedure WMContextMenu(var Message: TWMContextMenu); message WM_CONTEXTMENU;
    procedure WMPaste(var Message: TMessage); message WM_PASTE;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure SetDigitalCount(DigitalCount: Integer);
    procedure SetIntCount(IntCount: Integer);  //是否只能是正数
    procedure MyKeyPress(Sender: TObject; var Key: Char);
    procedure MyChange(Sender: TObject);
    procedure HintUser;
    procedure KeyPress(var Key: Char); override;
    procedure Change; override;
    procedure CheckAtKeyPress(var key : char);
    procedure CheckAtChanged;
    procedure CheckNumericAtKeyPress(var key : char; const bIsFloat: boolean = true);
    procedure CheckNumericAtChanged;
    procedure SetMaxLength;
    function getMyText: TCaption;
    procedure setMyText(Value: TCaption);
  public
    constructor Create(AOwner: TComponent); override;
    {constructor Create(AOwner: TComponent; const IntCount, DigitalCount: integer;
          const bWordOnly: boolean; const bNumericOnly : boolean = true); overload; }
    procedure SetFormat(const IntCount, DigitalCount: integer;
         const bWordOnly: boolean; const bNumericOnly : boolean = true);
  published
    property IntegerCount : integer read FIntCount write SetIntCount stored true  default 5;
    property DigitalCount : integer read FDigCount write SetDigitalCount stored true default 0;
    property WordOnly : boolean read FWordOnly write FWordOnly stored true default true;
    property NumericOnly : boolean read FNumericOnly write FNumericOnly stored true default true;
    property BeepOnError : boolean read FBeepOnError write FBeepOnError stored true default false;
    property HintOnError : boolean read FHintOnError write FHintOnError stored true default false;
    property Text: TCaption read getMyText write setMyText;
  end;

procedure Register;

implementation
uses math;

const CON_ZERO : double = 10e-6;

procedure Register;
begin
  RegisterComponents('HotZhu', [TNumEdit]);
end;

constructor TNumEdit.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  self.Text := '';
  self.width := 69;
  self.Height := 19;
  self.onChange := MyChange;
  NumericOnly := true;
  WordOnly := true;
  FIntCount := 6;
  FDigCount := 0;
  SetMaxLength;
  BeepOnError := true;
  HintOnError := false;
  self.UIStyle := deepblue;
end;

procedure TNumEdit.WMPaste(var Message: TMessage);
begin
  //
end;

procedure TNumEdit.WMContextMenu(var Message: TWMContextMenu);
begin
  Message.Result := 1;
end;

procedure TNumEdit.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if (mbRight = Button) or (mbMiddle = Button)  then exit;
  inherited;
end;

procedure TNumEdit.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if (mbRight = Button) or (mbMiddle = Button)  then exit;
  inherited;
end;

procedure TNumEdit.KeyPress(var Key: Char);
begin
  if Key = #45 then exit;
  inherited KeyPress(key);
  MyKeyPress(self, Key);
end;

procedure TNumEdit.Change;
begin
  MyChange(self);
end;

procedure TNumEdit.MyChange(Sender: TObject);
begin
  CheckAtChanged;
  if (not FHandled) and Assigned(OnChange) then
  begin
    FHandled := true;
    OnChange(Sender);
  end;
  if not FHandled  then
    FHandled := true;
end;

procedure TNumEdit.MyKeyPress(Sender: TObject; var Key: Char);
begin
  CheckAtKeyPress(key);
end;

{constructor TNumEdit.Create(AOwner: TComponent; const IntCount, DigitalCount: integer;
          const bWordOnly: boolean; const bNumericOnly : boolean = true);
begin
  Create(AOwner);
  SetFormat(IntCount, DigitalCount, bWordOnly, bNumericOnly);
end; }

procedure TNumEdit.SetFormat(const IntCount, DigitalCount: integer;
       const bWordOnly: boolean; const bNumericOnly : boolean = true);
begin
  SetIntCount(IntCount);
  SetDigitalCount(DigitalCount);
  FWordOnly := bWordOnly;
  FNumericOnly := bNumericOnly;
end;

procedure TNumEdit.SetIntCount(IntCount: Integer);
begin
  if IntCount >= 0 then
    FIntCount := IntCount
  else
    FIntCount := 0;
  SetMaxLength;
end;

procedure TNumEdit.SetDigitalCount(DigitalCount: Integer);
begin
  if DigitalCount >= 0 then
    FDigCount := DigitalCount
  else
    FDigCount := 0;
  SetMaxLength;
end;

procedure TNumEdit.SetMaxLength;
begin
  {if self.NumericOnly then
  begin
    self.MaxLength := FIntCount + FDigCount;
    if FDigCount <= 0 then
      self.MaxLength := self.MaxLength + 1;
    if not WordOnly then
      self.MaxLength := self.MaxLength + 1;
  end;}
end;

procedure TNumEdit.CheckAtKeyPress(var key : char);
begin
  if not NumericOnly then exit;
  FOldText := self.Text;
  FHandled := false;
  if not (Key in ['-', '.', '0'..'9', #8,  #9, #13]) then
  begin
    Key := #0;
    FHandled := true;
    HintUser;
    exit;
  end;
  if FWordOnly and (Key in ['+', '-']) and (Pos(Key, self.SelText) = 0) then
  begin
       Key := #0;
       FHandled := true;
       HintUser;
       exit;
  end;
  if (Key in ['.']) and (self.DigitalCount = 0) then
  begin
    Key := #0;  
    FHandled := true;
    HintUser;
    exit;
  end;
  if (Key in ['.', '-'])  and (Pos(Key, self.Text) > 0) and (Pos(Key, self.SelText) = 0) then
  begin
    Key := #0;  
    FHandled := true;
    HintUser;
    exit;
  end;
  if Key in ['0'..'9'] then
    CheckNumericAtKeyPress(Key, DigitalCount > 0);
end;

procedure TNumEdit.CheckAtChanged;
begin
  if not NumericOnly then exit;
  if not FHandled then
    CheckNumericAtChanged;
end;

procedure TNumEdit.CheckNumericAtKeyPress(var key : char; const bIsFloat: boolean = true);
var
  fTemp: double;
  strTemp: string;
  iSel, IntAll, DigAll : integer;
  bSelect : boolean;
begin
  if(self.Text <> '') then
  begin
    try
      iSel := self.GetSelStart;
      bSelect := Self.SelLength > 0;
      if bSelect then
      begin
         strTemp := Copy(self.Text, 1, iSel);
         strTemp := strTemp + Key + Copy(self.Text, iSel + Length(self.SelText) + 1, Length(self.Text));
      end
      else
         strTemp := self.Text;

      if bIsFloat then
        fTemp := abs(StrToFloat(strTemp))
      else
        fTemp := abs(strToInt(strTemp));
      //判断整数位数
      if self.IntegerCount = 0 then
      begin
        if fTemp -1 > CON_ZERO then
        begin   
          FHandled := true;
          Key := #0;
          HintUser;
          exit;
        end;
      end;
      if (self.IntegerCount > 0) then
      begin
        if (Pos('.', strTemp) > 0) then
           IntAll := Pos('.', strTemp) -1
        else
           IntAll := Length(strTemp);
        if (IntAll > 0) and (StrTemp[1] = '-') then
           Dec(IntAll);
        //如果输入的长度大于允许的长度就返回#0, 另外,如果没有选择文本并且文本的长度达到了允许的长度也返回#0
        if (IntAll > self.IntegerCount) then //or ((IntAll = self.IntegerCount) and (not bSelect)) then
        begin
          FHandled := true;
          Key := #0;
          HintUser;
          exit;
        end;
      end;
      //判断小数位数
      if self.DigitalCount > 0 then
      begin
        if (Pos('.', strTemp) = 0) or (Pos('.', strTemp) = Length(strTemp)) then exit; //0位小数;
        DigAll := Length(strTemp) - Pos('.', strTemp);
        if (DigAll > self.DigitalCount) then //or ((DigAll = self.DigitalCount) and (not bSelect)) then
        begin
          FHandled := true;
          Key := #0;
          HintUser;
          exit;
        end;
      end;
    except
      if (Key = '-') and (strTemp = '') then
        exit
      else begin  
        FHandled := true;
        Key := #0;
        HintUser;
      end;//end if
    end; //end try
  end; //end if
end;

procedure TNumEdit.CheckNumericAtChanged;
var
  fTemp: double;
  iSel, DigAll, IntAll: integer;
begin
  if(self.Text <> '') then
  begin
    try
      if self.FDigCount > 0 then
        fTemp := abs(StrToFloat(self.text))
      else
        fTemp := abs(strToInt(self.text));
      //判断整数位数
      if self.IntegerCount = 0 then
      begin
        if fTemp -1 > CON_ZERO then
        begin  
          FHandled := true;   //不用再处理OnChange事件
          self.Text := self.FOldText;
          exit;
        end;
      end
      {else if (self.IntegerCount > 0) and (Trunc(fTemp) div trunc(Power(10, self.IntegerCount))  >= 1) then
      begin
        FHandled := true;   //不用再处理OnChange事件
        self.Text := self.FOldText;
        HintUser;
        exit;
      end; }
      //判断小数位数

      else if (self.IntegerCount > 0) then
      begin
        if (Pos('.', Self.text) > 0) then
           IntAll := Pos('.', Self.text) -1
        else
           IntAll := Length(Self.text);
        if (IntAll > 0) and (Self.text[1] = '-') then
           Dec(IntAll);
        //如果输入的长度大于允许的长度就返回#0, 另外,如果没有选择文本并且文本的长度达到了允许的长度也返回#0
        if IntAll > self.IntegerCount then
        begin
          FHandled := true;   //不用再处理OnChange事件
          self.Text := self.FOldText;
          HintUser;
          exit;
        end;
      end;
      //判断小数位数
      if (self.DigitalCount = 0) and (Pos('.', Self.text) > 0) then
      begin
        if Pos('.', Self.text) < Length(self.text) then
        begin 
          FHandled := true;   //不用再处理OnChange事件
          self.Text := self.FOldText;
          HintUser;
          exit;
        end;
      end 
      else if self.DigitalCount > 0 then
      begin
        if (Pos('.', Self.text) = 0) or (Pos('.', Self.text) = Length(Self.text)) then exit; //0位小数;
        DigAll := Length(Self.text) - Pos('.', Self.text);
        if (DigAll > self.DigitalCount) then
        begin
          FHandled := true;   //不用再处理OnChange事件
          self.Text := self.FOldText;
          HintUser;
          exit;
        end;
      end;

      {if (self.DigitalCount > 0) then
      begin
        if (Pos('.', self.text) = 0) or (Pos('.', self.text) = Length(self.text)) then exit; //0位小数;
        if Length(self.text) - Pos('.', self.text) > self.DigitalCount then  //小数位超过规定长度
        begin
          FHandled := true;   //不用再处理OnChange事件
          self.Text := self.FOldText;
          HintUser;
          exit;
        end;
      end; }
    except      
        FHandled := true;   //不用再处理OnChange事件
        self.Text := self.FOldText;
        HintUser;
    end; //end try
  end; //end if
end;

procedure TNumEdit.HintUser;
begin
  if BeepOnError then sysutils.Beep;
  if HintOnError then Application.MessageBox(PChar('错误输入!'),PChar('提示'),MB_OK + MB_ICONHAND);
end;


function TNumEdit.getMyText: TCaption;
begin
  Result := inherited Text;
end;

procedure TNumEdit.setMyText(Value: TCaption);
var
  FormatStr, ValueStr: string;
  i: integer;
begin
  ValueStr := Value;
  if (Length(ValueStr) > 0) and self.FNumericOnly then
  begin
    FormatStr := '0';
    if self.DigitalCount > 0 then
    begin
      FormatStr := '0.';
      for I := 1 to self.DigitalCount do    // Iterate
      begin
        FormatStr := FormatStr + '0';
      end;    // for
    end;
    ValueStr := FormatFloat(FormatStr, StrToFloat(Value));
  end;
  inherited text := ValueStr;
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -