Delphi 7-Force InputBox только для целого числа?

используя Delphi 7, есть ли в любом случае заставить inputbox разрешить только ввод чисел от 0 до 100 ?

спасибо!

8
delphi delphi-7

5 ответов

вы можете легко написать свой собственный "супер диалог", как

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;

этот диалог позволяет вводить текст и целое число:

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

или

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

образец диалогового входных целочисленных http://privat.rejbrand.se/numdlg.png

обновление

комментатор отметил, что процедуры класса (и т. д.) еще не были представлены по состоянию на Delphi 7. Если это так (я действительно не помню...), просто удалите все это синтаксический сахар:

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;

обновление 2

я написал новую и гораздо более приятную версию диалога. Теперь он выглядит точно как диалоговое окно задачи (я подробно следовал рекомендациям Microsoft), и он предлагает множество вариантов преобразования (например, в верхний или нижний регистр) и проверки (много вариантов) ввода. Он также добавляет элемент управления Up Down в случае целочисленного ввода (для этого не обязательно должны быть натуральные числа).

скриншот диалогового окна ввода строки http://specials.rejbrand.se/dev/classes/multiinput/multiinputstr.png

скриншот диалога ввода целого числа http://specials.rejbrand.se/dev/classes/multiinput/multiinputnum.png

скриншот персонажа диалог ввода http://specials.rejbrand.se/dev/classes/multiinput/multiinputchr.png

исходный код:

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 := DFDFDF;
    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 := 993300;
  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.

полная документация (и исходный код) всегда будет найдена на http://specials.rejbrand.se/dev/classes/multiinput/readme.html.

13

вы можете разрешить пользователю вводить только цифры в поле ввода при добавлении в стиле TEdit внутри в inputbox в ES_NUMBER значение.

проверить этот образец.

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;

Примечание : к сожалению, этот способ не позволяет проверить диапазон чисел.

11

вы можете использовать InputQuery из блока QDialogs, который имеет перегруженную версию с параметрами Min и Max для ограничения диапазона целочисленного ввода. Что-то вроде этого:--2--> 

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;

Не забудьте добавить QDialogs в использует предложение, в противном случае эта версия функции не будет найдена.

но этот диалог не помешает пользователю ввести значение, которое находится за пределами; он будет молча "обрезать" его до ближайшая граница. Например, если пользователь вводит -20, переменная " i " будет установлена в 0. И если он войдет 200, "я" будет установлено на 100. Я не уверен, что эта функциональность подойдет всем, но это один из способов достичь ее без написания пользовательского кода. Надеюсь, это поможет.

5

эта работа с D6. Функция TryStrToInt от 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;
1

нет, это невозможно сделать. Вы должны написать свой собственный диалог, который проверяет ввод элемента управления редактирования.

0