开发者

Delphi 7 - Force InputBox to integer only?

开发者 https://www.devze.com 2023-02-24 22:21 出处：网络
Using Delphi 7, is there anyway to force inputbox to allow only numbers entry from 0 to 100 ? 开发者_Python百科Thanks!You could easily write your own \'super dialog\' like
相关专题：delphidelphi-7

Using Delphi 7, is there anyway to force inputbox to allow only numbers entry from 0 to 100 ?

开发者_Python百科

Thanks!

You could easily write your own 'super dialog' like

type
  TMultiInputBox = class
  strict private
    class var
      frm: TForm;
      lbl: TLabel;
      edt: TEdit;
      btnOK,
      btnCancel: TButton;
      shp: TShape;
      FMin, FMax: integer;
      FTitle, FText: string;
    class procedure SetupDialog;
    class procedure ValidateInput(Sender: TObject);
  public
    class function TextInputBox(AOwner: TCustomForm; const ATitle,
      AText: string; var Value: string): boolean;
    class function NumInputBox(AOwner: TCustomForm; const ATitle,
      AText: string; AMin, AMax: integer; var Value: integer): boolean;
  end;

class procedure TMultiInputBox.SetupDialog;
begin
  frm.Caption := FTitle;
  frm.Width := 512;
  frm.Position := poOwnerFormCenter;
  frm.BorderStyle := bsDialog;
  lbl := TLabel.Create(frm);
  lbl.Parent := frm;
  lbl.Left := 8;
  lbl.Top := 8;
  lbl.Width := frm.ClientWidth - 16;
  lbl.Caption := FText;
  edt := TEdit.Create(frm);
  edt.Parent := frm;
  edt.Top := lbl.Top + lbl.Height + 8;
  edt.Left := 8;
  edt.Width := frm.ClientWidth - 16;
  btnOK := TButton.Create(frm);
  btnOK.Parent := frm;
  btnOK.Default := true;
  btnOK.Caption := 'OK';
  btnOK.ModalResult := mrOk;
  btnCancel := TButton.Create(frm);
  btnCancel.Parent := frm;
  btnCancel.Cancel := true;
  btnCancel.Caption := 'Cancel';
  btnCancel.ModalResult := mrCancel;
  btnCancel.Top := edt.Top + edt.Height + 16;
  btnCancel.Left := frm.ClientWidth - btnCancel.Width - 8;
  btnOK.Top := btnCancel.Top;
  btnOK.Left := btnCancel.Left - btnOK.Width - 4;
  frm.ClientHeight := btnOK.Top + btnOK.Height + 8;
  shp := TShape.Create(frm);
  shp.Parent := frm;
  shp.Brush.Color := clWhite;
  shp.Pen.Style := psClear;
  shp.Shape := stRectangle;
  shp.Align := alTop;
  shp.Height := btnOK.Top - 8;
  shp.SendToBack;
end;

class function TMultiInputBox.TextInputBox(AOwner: TCustomForm; const ATitle,
  AText: string; var Value: string): boolean;
begin
  FTitle := ATitle;
  FText := AText;

  frm := TForm.Create(AOwner);
  try
    SetupDialog;
    edt.NumbersOnly := false;
    edt.Text := Value;
    result := frm.ShowModal = mrOK;
    if result then Value := edt.Text;
  finally
    frm.Free;
  end;
end;

class procedure TMultiInputBox.ValidateInput(Sender: TObject);
var
  n: integer;
begin
  btnOK.Enabled := TryStrToInt(edt.Text, n) and InRange(n, FMin, FMax);
end;

class function TMultiInputBox.NumInputBox(AOwner: TCustomForm; const ATitle,
  AText: string; AMin, AMax: integer; var Value: integer): boolean;
begin
  FMin := AMin;
  FMax := AMax;
  FTitle := ATitle;
  FText := AText;

  frm := TForm.Create(AOwner);
  try
    SetupDialog;
    edt.NumbersOnly := true;
    edt.Text := IntToStr(value);
    edt.OnChange := ValidateInput;
    result := frm.ShowModal = mrOK;
    if result then Value := StrToInt(edt.Text);
  finally
    frm.Free;
  end;
end;

This dialog allows both text and integer input:

v := 55;
if TMultiInputBox.NumInputBox(Self, 'This is the title', 'Enter a number between 1 and 100:', 1, 100, v) then
  ShowMessage(IntToStr(v));

or

s := 'Test';
if TMultiInputBox.TextInputBox(Self, 'This is the title', 'Enter some text:', s) then
  ShowMessage(s);

Delphi 7 - Force InputBox to integer only?

Update

A commenter remarked that class procedures (etc.) had not been introduced yet as of Delphi 7. If this is the case (I don't really remember...), simply remove all this syntactic sugar:

var
  frm: TForm;
  lbl: TLabel;
  edt: TEdit;
  btnOK,
  btnCancel: TButton;
  shp: TShape;
  FMin, FMax: integer;
  FTitle, FText: string;

procedure SetupDialog;
begin
  frm.Caption := FTitle;
  frm.Width := 512;
  frm.Position := poOwnerFormCenter;
  frm.BorderStyle := bsDialog;
  lbl := TLabel.Create(frm);
  lbl.Parent := frm;
  lbl.Left := 8;
  lbl.Top := 8;
  lbl.Width := frm.ClientWidth - 16;
  lbl.Caption := FText;
  edt := TEdit.Create(frm);
  edt.Parent := frm;
  edt.Top := lbl.Top + lbl.Height + 8;
  edt.Left := 8;
  edt.Width := frm.ClientWidth - 16;
  btnOK := TButton.Create(frm);
  btnOK.Parent := frm;
  btnOK.Default := true;
  btnOK.Caption := 'OK';
  btnOK.ModalResult := mrOk;
  btnCancel := TButton.Create(frm);
  btnCancel.Parent := frm;
  btnCancel.Cancel := true;
  btnCancel.Caption := 'Cancel';
  btnCancel.ModalResult := mrCancel;
  btnCancel.Top := edt.Top + edt.Height + 16;
  btnCancel.Left := frm.ClientWidth - btnCancel.Width - 8;
  btnOK.Top := btnCancel.Top;
  btnOK.Left := btnCancel.Left - btnOK.Width - 4;
  frm.ClientHeight := btnOK.Top + btnOK.Height + 8;
  shp := TShape.Create(frm);
  shp.Parent := frm;
  shp.Brush.Color := clWhite;
  shp.Pen.Style := psClear;
  shp.Shape := stRectangle;
  shp.Align := alTop;
  shp.Height := btnOK.Top - 8;
  shp.SendToBack;
end;

function TextInputBox(AOwner: TCustomForm; const ATitle,
  AText: string; var Value: string): boolean;
begin
  FTitle := ATitle;
  FText := AText;

  frm := TForm.Create(AOwner);
  try
    SetupDialog;
    edt.NumbersOnly := false;
    edt.Text := Value;
    result := frm.ShowModal = mrOK;
    if result then Value := edt.Text;
  finally
    frm.Free;
  end;
end;

type
  TInputValidator = class
    procedure ValidateInput(Sender: TObject);
  end;

procedure TInputValidator.ValidateInput(Sender: TObject);
var
  n: integer;
begin
  btnOK.Enabled := TryStrToInt(edt.Text, n) and InRange(n, FMin, FMax);
end;

function NumInputBox(AOwner: TCustomForm; const ATitle,
  AText: string; AMin, AMax: integer; var Value: integer): boolean;
var
  iv: TInputValidator;
begin
  FMin := AMin;
  FMax := AMax;
  FTitle := ATitle;
  FText := AText;

  frm := TForm.Create(AOwner);
  try
    SetupDialog;
    edt.Text := IntToStr(value);
    iv := TInputValidator.Create;
    try
      edt.OnChange := iv.ValidateInput;
      result := frm.ShowModal = mrOK;
      if result then Value := StrToInt(edt.Text);
    finally
      iv.Free;
    end;
  finally
    frm.Free;
  end;
end;

Update 2

I have written a new and much nicer version of the dialog. It now looks exactly like a Task Dialog (I followed Microsoft's guidelines in detail), and it offers many options to transform (e.g., to upper or lower case) and verify (many options) the input. It also adds an Up Down control in case of integer input (need not be natural numbers for that one).

Delphi 7 - Force InputBox to integer only?

Delphi 7 - Force InputBox to integer only?

Delphi 7 - Force InputBox to integer only?

Source code:

unit MultiInput;

interface

uses
  Windows, SysUtils, Types, Controls, Graphics, Forms, StdCtrls, ExtCtrls,
  CommCtrl;

type
  TAllowOnlyOption = (aoCapitalAZ, aoSmallAZ, aoAZ, aoLetters, aoDigits, aoSpace,
    aoPeriod, aoComma, aoSemicolon, aoHyphenMinus, aoPlus, aoUnderscore, aoAsterisk);
  TAllowOnlyOptions = set of TAllowOnlyOption;
  TInputVerifierFunc = reference to function(const S: string): boolean;
  TMultiInputBox = class
  strict private
    class var
      frm: TForm;
      edt: TEdit;
      btnOK,
      btnCancel: TButton;
      FMin, FMax: integer;
      FFloatMin, FFloatMax: real;
      FAllowEmptyString: boolean;
      FAllowOnly: TAllowOnlyOptions;
      FInputVerifierFunc: TInputVerifierFunc;
      spin: HWND;
      FTitle, FText: string;
      lineat: integer;
      R: TRect;
    class procedure Paint(Sender: TObject);
    class procedure FormActivate(Sender: TObject);
    class procedure SetupDialog;
    class procedure ValidateIntInput(Sender: TObject);
    class procedure ValidateRealInput(Sender: TObject);
    class procedure ValidateStrInput(Sender: TObject);
  private
    class procedure ValidateStrInputManual(Sender: TObject);
  public
    class function TextInputBox(AOwner: TCustomForm; const ATitle,
      AText: string; var Value: string; ACharCase: TEditCharCase = ecNormal;
      AAllowEmptyString: boolean = true; AAllowOnly: TAllowOnlyOptions = []): boolean;
    class function CharInputBox(AOwner: TCustomForm; const ATitle,
      AText: string; var Value: char; ACharCase: TEditCharCase = ecNormal;
      AAllowOnly: TAllowOnlyOptions = []): boolean;
    class function TextInputBoxEx(AOwner: TCustomForm; const ATitle,
      AText: string; var Value: string; ACharCase: TEditCharCase = ecNormal;
      AInputVerifierFunc: TInputVerifierFunc = nil): boolean;
    class function NumInputBox(AOwner: TCustomForm; const ATitle,
      AText: string; var Value: integer; AMin: integer = -MaxInt + 1;
      AMax: integer = MaxInt): boolean;
    class function FloatInputBox(AOwner: TCustomForm; const ATitle,
      AText: string; var Value: real; AMin: real; AMax: real): boolean;
  end;

implementation

uses Math, Messages, Character;

class procedure TMultiInputBox.Paint(Sender: TObject);
begin
  with frm.Canvas do
  begin
    Pen.Style := psSolid;
    Pen.Width := 1;
    Pen.Color := $00DFDFDF;
    Brush.Style := bsSolid;
    Brush.Color := clWhite;
    FillRect(Rect(0, 0, frm.ClientWidth, lineat));
    MoveTo(0, lineat);
    LineTo(frm.ClientWidth, lineat);
    DrawText(frm.Canvas.Handle, FText, Length(FText), R,
      DT_NOPREFIX or DT_WORDBREAK);
  end;
end;

class procedure TMultiInputBox.SetupDialog;
begin
  { * = Metrics from                                                           }
  { https://msdn.microsoft.com/en-us/windows/desktop/dn742486                  }
  {            and                                                             }
  { https://msdn.microsoft.com/en-us/windows/desktop/dn742478                  }
  frm.Font.Name := 'Segoe UI';
  frm.Font.Size := 9{*};
  frm.Caption := FTitle;
  frm.Width := 400;
  frm.Position := poOwnerFormCenter;
  frm.BorderStyle := bsDialog;
  frm.OnPaint := Paint;
  frm.OnActivate := FormActivate;

  frm.Canvas.Font.Size := 12; { 'MainInstruction' }
  frm.Canvas.Font.Color := $00993300;
  R := Rect(11{*}, 11{*}, frm.Width - 11{*}, 11{*} + 2);
  DrawText(frm.Canvas.Handle, FText, Length(FText),
    R, DT_CALCRECT or DT_NOPREFIX or DT_WORDBREAK);

  edt := TEdit.Create(frm);
  edt.Parent := frm;
  edt.Top := R.Bottom + 5{*};
  edt.Left := 11{*};
  edt.Width := frm.ClientWidth - 2*11{*};
  lineat := edt.Top + edt.Height + 11{*};
  btnOK := TButton.Create(frm);
  btnOK.Parent := frm;
  btnOK.Height := 23{*};
  btnOK.Default := true;
  btnOK.Caption := 'OK';
  btnOK.ModalResult := mrOk;
  btnCancel := TButton.Create(frm);
  btnCancel.Parent := frm;
  btnCancel.Height := 23{*};
  btnCancel.Cancel := true;
  btnCancel.Caption := 'Cancel';
  btnCancel.ModalResult := mrCancel;
  btnCancel.Top := edt.Top + edt.Height + 11{*} + 1{*} + 11{*};
  btnCancel.Left := frm.ClientWidth - btnCancel.Width - 11{*};
  btnOK.Top := btnCancel.Top;
  btnOK.Left := btnCancel.Left - btnOK.Width - 7{*};
  frm.ClientHeight := btnOK.Top + btnOK.Height + 11{*};
end;

class procedure TMultiInputBox.ValidateStrInputManual(Sender: TObject);
begin
  btnOK.Enabled := (not Assigned(FInputVerifierFunc)) or FInputVerifierFunc(edt.Text);
end;

class function TMultiInputBox.TextInputBoxEx(AOwner: TCustomForm; const ATitle,
  AText: string; var Value: string; ACharCase: TEditCharCase;
  AInputVerifierFunc: TInputVerifierFunc): boolean;
begin
  FTitle := ATitle;
  FText := AText;
  FInputVerifierFunc := AInputVerifierFunc;

  frm := TForm.Create(AOwner);
  try
    SetupDialog;
    edt.Text := Value;
    edt.CharCase := ACharCase;
    edt.OnChange := ValidateStrInputManual;
    ValidateStrInputManual(nil);
    result := frm.ShowModal = mrOK;
    if result then Value := edt.Text;
  finally
    frm.Free;
  end;
end;

class procedure TMultiInputBox.ValidateStrInput(Sender: TObject);

  function IsValidStr: boolean;
  var
    S: string;
    i: integer;
  begin
    S := edt.Text;

    result := (Length(S) > 0) or FAllowEmptyString;
    if not result then Exit;

    if FAllowOnly = [] then Exit;

    if aoLetters in FAllowOnly then
      Include(FAllowOnly, aoAZ);

    if aoAZ in FAllowOnly then
    begin
      Include(FAllowOnly, aoCapitalAZ);
      Include(FAllowOnly, aoSmallAZ);
    end;

    result := true;
    for i := 1 to Length(S) do
      case S[i] of
        'a'..'z':
          if not (aoSmallAZ in FAllowOnly) then
            Exit(false);
        'A'..'Z':
          if not (aoCapitalAZ in FAllowOnly) then
            Exit(false);
        '0'..'9':
          if not (aoDigits in FAllowOnly) then
            Exit(false);
        ' ':
          if not (aoSpace in FAllowOnly) then
            Exit(false);
        '.':
          if not (aoPeriod in FAllowOnly) then
            Exit(false);
        ',':
          if not (aoComma in FAllowOnly) then
            Exit(false);
        ';':
          if not (aoSemicolon in FAllowOnly) then
            Exit(false);
        '-':
          if not (aoHyphenMinus in FAllowOnly) then
            Exit(false);
        '+':
          if not (aoPlus in FAllowOnly) then
            Exit(false);
        '_':
          if not (aoUnderscore in FAllowOnly) then
            Exit(false);
        '*':
          if not (aoAsterisk in FAllowOnly) then
            Exit(false);
      else
        if not (TCharacter.IsLetter(S[i]) and (aoLetters in FAllowOnly)) then
          Exit(false);
      end;

  end;

begin
    btnOK.Enabled := IsValidStr;
end;

class function TMultiInputBox.TextInputBox(AOwner: TCustomForm; const ATitle,
  AText: string; var Value: string; ACharCase: TEditCharCase = ecNormal;
  AAllowEmptyString: boolean = true; AAllowOnly: TAllowOnlyOptions = []): boolean;
begin
  FTitle := ATitle;
  FText := AText;
  FAllowEmptyString := AAllowEmptyString;
  FAllowOnly := AAllowOnly;

  frm := TForm.Create(AOwner);
  try
    SetupDialog;
    edt.Text := Value;
    edt.CharCase := ACharCase;
    edt.OnChange := ValidateStrInput;
    ValidateStrInput(nil);
    result := frm.ShowModal = mrOK;
    if result then Value := edt.Text;
  finally
    frm.Free;
  end;
end;

class procedure TMultiInputBox.ValidateIntInput(Sender: TObject);
var
  n: integer;
begin
  btnOK.Enabled := TryStrToInt(edt.Text, n) and InRange(n, FMin, FMax);
end;

class procedure TMultiInputBox.ValidateRealInput(Sender: TObject);
var
  x: double;
begin
  btnOK.Enabled := TryStrToFloat(edt.Text, x) and InRange(x, FFloatMin, FFloatMax);
end;

class function TMultiInputBox.CharInputBox(AOwner: TCustomForm; const ATitle,
  AText: string; var Value: char; ACharCase: TEditCharCase;
  AAllowOnly: TAllowOnlyOptions): boolean;
begin
  FTitle := ATitle;
  FText := AText;
  FAllowEmptyString := false;
  FAllowOnly := AAllowOnly;

  frm := TForm.Create(AOwner);
  try
    SetupDialog;
    edt.Text := Value;
    edt.CharCase := ACharCase;
    edt.OnChange := ValidateStrInput;
    edt.MaxLength := 1;
    ValidateStrInput(nil);
    result := frm.ShowModal = mrOK;
    if result then Value := edt.Text[1];
  finally
    frm.Free;
  end;
end;

class function TMultiInputBox.FloatInputBox(AOwner: TCustomForm; const ATitle,
  AText: string; var Value: real; AMin, AMax: real): boolean;
begin
  FFloatMin := AMin;
  FFloatMax := AMax;
  FTitle := ATitle;
  FText := AText;

  frm := TForm.Create(AOwner);
  try
    SetupDialog;
    edt.Text := FloatToStr(Value);
    edt.OnChange := ValidateRealInput;
    ValidateRealInput(nil);
    result := frm.ShowModal = mrOK;
    if result then Value := StrToFloat(edt.Text);
  finally
    frm.Free;
  end;
end;

class procedure TMultiInputBox.FormActivate(Sender: TObject);
var
  b: boolean;
begin
  if SystemParametersInfo(SPI_GETSNAPTODEFBUTTON, 0, @b, 0) and b then
    with btnOK do
      with ClientToScreen(Point(Width div 2, Height div 2)) do
        SetCursorPos(x, y);
  frm.OnActivate := nil;
end;

class function TMultiInputBox.NumInputBox(AOwner: TCustomForm; const ATitle,
  AText: string; var Value: integer; AMin: integer = -MaxInt + 1;
  AMax: integer = MaxInt): boolean;
const
  UDM_SETPOS32 = WM_USER + 113;
var
  ICCX: TInitCommonControlsEx;
begin
  FMin := AMin;
  FMax := AMax;
  FTitle := ATitle;
  FText := AText;

  frm := TForm.Create(AOwner);
  try
    SetupDialog;

    ICCX.dwSize := sizeof(ICCX);
    ICCX.dwICC := ICC_UPDOWN_CLASS;
    InitCommonControlsEx(ICCX);
    spin := CreateWindowEx(0, PChar(UPDOWN_CLASS), nil,
      WS_CHILDWINDOW or WS_VISIBLE or UDS_NOTHOUSANDS or UDS_SETBUDDYINT or
      UDS_ALIGNRIGHT or UDS_ARROWKEYS or UDS_HOTTRACK, 0, 0, 0, 0, frm.Handle,
      0, HInstance, nil);
    SendMessage(spin, UDM_SETRANGE32, FMin, FMax);
    SendMessage(spin, UDM_SETPOS32, 0, Value);
    SendMessage(spin, UDM_SETBUDDY, edt.Handle, 0);

    if FMin >= 0 then
      edt.NumbersOnly := true;
    edt.Text := IntToStr(value);
    edt.OnChange := ValidateIntInput;
    ValidateIntInput(nil);
    result := frm.ShowModal = mrOK;
    if result then Value := StrToInt(edt.Text);
  finally
    frm.Free;
  end;
end;

end.

Full documentation (and source code) will always be found at https://specials.rejbrand.se/dev/classes/multiinput/readme.html.

you can allow to the user only enter numbers in the input box adding to the style of the TEdit inside of the inputbox the ES_NUMBER value.

check this sample.

const
  InputBoxNumberMessage = WM_USER + 666;// a custom message

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    procedure InputBoxSetOnlyNumbers(var Msg: TMessage); message InputBoxNumberMessage;
  public
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}



procedure TForm1.Button1Click(Sender: TObject);
var
  InputString: string;
begin
  PostMessage(Handle, InputBoxNumberMessage, 0, 0);
  InputString := InputBox('Input', 'Enter a number', '');
  ShowMessage(InputString);
end;

procedure TForm1.InputBoxSetOnlyNumbers(var Msg: TMessage);
var
  hActiveForm : HWND;
  hEdit       : HWND;
  dwLong      : Longint;
begin
  hActiveForm := Screen.ActiveForm.Handle;
  if (hActiveForm <> 0) then
  begin
    hEdit := FindWindowEx(hActiveForm, 0, 'TEdit', nil);//determine the handle of the TEdit
    dwLong := GetWindowLong(hEdit, GWL_STYLE);//get the current style of the control
    SetWindowLong(hEdit, GWL_STYLE, dwLong or ES_NUMBER)//set the new style
  end;
end;

Note : unfortunately this method doesn't allow to validate the range of the numbers.

You could use InputQuery from QDialogs unit, which has an overloaded version with Min and Max parameters for limiting the range of Integer input. Something like this:

var i:Integer;
begin
  i:=0; // Initial value to show the user in the textbox
  if InputQuery('Dialog Caption', 'Please enter the number between 0 and 100:', i, 0, 100) then ShowMessage('Entered: '+IntToStr(i));
end;

Do not forget to add QDialogs to the uses clause, otherwise this version of the function will not be found.

BUT this dialog will not prevent user from entering a value that is out of bounds; it will silently "trim" it to the nearest bound. For example, if the user enters -20, variable "i" will be set to 0. And if he enters 200, "i" will be set to 100. I'm not sure if that functionality would suit everybody, but it's one way to achieve it without writing any custom code. Hope this helps.

This work with D6. Function TryStrToInt is from SysUtils.

procedure TForm.ButtonClick(Sender: TObject);
  var vInt:Integer;
      vStr:String;
begin
  Repeat
    Repeat
     vStr:=InputBox('Some title','Enter integer betwen 0-100','');
    Until TryStrToInt(vStr, vInt);
  Until (vInt>=0) and (vInt<=100);
end;

No, there is no way to do this. You should write your own dialog which validates the input to an edit control.

0

上一篇:

:下一篇

更多 问答 相关资讯：

精彩评论

暂无评论...
登录 注册
Qedev.com
验证码 换一张
取 消

关注公众号

热门标签

图文推荐

Delphi - Custom drawing a message list

Delphi - Custom drawing a message list
C++ header-only include pattern

C++ header-only include pattern
IE7 Margin Collapses Into Padding

IE7 Margin Collapses Into Padding
in CoffeeScript, how can I use a variable as a key in a hash?

in CoffeeScript, how can I use a variable as a key in a hash?
Interactive visualization of a graph in python [closed]

Interactive visualization of a graph in python [closed]
How to customise PHP MYSQL tables?

How to customise PHP MYSQL tables?
High quality, simple random password generator

High quality, simple random password generator
Image Recognition ApI in android

Image Recognition ApI in android

开发者开发者网给大家分享系统运维,大数据运维,云计算,编程开发技巧,路由交换,运维和开发相关的资讯及技术文章，同时StackOverflow中文社区，知识经验交流分享。

法律声明：本站内容均为网友上传，网站举办方负责审核和监督，如存在版权或非法内容，欢迎举报，我们将尽快予以删除。邮箱：devze@qq.com

Copyright © 2018-2020 开发者. All rights reserved. Powered by 开发者ICP备案号: 京ICP备10032868号-9