Delphi 7 - Force InputBox to integer only?

Question

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

Thanks!

Solution 1

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);

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).

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.

Solution 2

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.

Solution 3

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.

Solution 4

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;

View more solutions

Comments

[David Heffernan]

+1 I have absolutely no idea how anyone could have downvoted this!!

[Dave Keighan]

The class procedures not in D7 comment was made by me, I deleted it because I wasn't certain and I'm new to answered questions and don't really feel it is necessary to look the part.

[Dave Keighan]

TEdit.NumbersOnly wasn't introduced until D2009

[Andreas Rejbrand]

@TDelphiHobbyist: OK, I removed that line from the compatibility version of the code. It isn't really necessary, because I still do validate the input manually.

[David Heffernan]

And you lost my lovely InRange, boo hoo!

[Andreas Rejbrand]

@David: Yeah, I know, but I am not sure that InRange is available in Delphi 7. I just checked Delphi 4, and it wasn't there.

[David Heffernan]

@Andreas It was certainly present in D6 from which I have recently migrated.

[Ken White]

+1. BTW, class functions exist in D7. I'm not sure when they were actually added, but I've got code that compiles under D7 and D2007-XE with class functions declared.

[David]

@David & Andreas: there has been a lot of downvoting in the 'delphi' tag recently for perfectly good answers. I have no idea why. Any ideas / insight?

[Andreas Rejbrand]

@David M: I don't know. It might be random fluctuations, or someone has something against me and/or David 'personally'. I don't know. Fortunately you only lose 2 points, but it's still a bit annoying.