Delphi 7 - заставить InputBox только целое число? - PullRequest
Новая
       10

Delphi 7 - заставить InputBox только целое число?

8 голосов
/ 15 апреля 2011

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

Спасибо!

Ответы [ 5 ]

13 голосов
/ 15 апреля 2011

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

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) и предлагает множество вариантов преобразования (например, в верхний или нижний регистр) и проверки (много вариантов) ввода.Он также добавляет элемент управления «вверх» и «вниз» в случае целочисленного ввода (для этого необязательно использовать натуральные числа).

Снимок экрана диалогового окна ввода строки 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 := $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.

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

11 голосов
/ 15 апреля 2011

Вы можете разрешить пользователю только вводить числа в поле ввода, добавляя к стилю TEdit внутри поля ввода значение 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;

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

5 голосов
/ 05 ноября 2011

Вы можете использовать InputQuery из модуля QDialogs, который имеет перегруженную версию с параметрами Min и Max для ограничения диапазона ввода целых чисел. Примерно так: 

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, «i» будет установлен на 100. Я не уверен, что эта функциональность подойдет всем, но она одна способ достичь этого без написания какого-либо пользовательского кода. Надеюсь, это поможет.

1 голос
/ 17 октября 2013

Это работа с 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;
0 голосов
/ 15 апреля 2011

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

...