How to Validate InputQuery user input before the user clicks OK?-CodePudding

In a 32-bit VCL Application in Windows 10 in Delphi 11 Alexandria, I show an INPUT DIALOG to the user:

  var aNewFolderName: string := 'New Project Folder';
  if Vcl.Dialogs.InputQuery('New Project Folder', 'Enter the name of the new Project Folder:', aNewFolderName) then
  begin
    // Todo: Create the folder if everything went OK, ELSE REPEAT the input action :-(
  end;

Is there a way to VALIDATE the user's input BEFORE he clicks the OK button? (E.g., checking for not allowed characters, existing folder, etc.). Just repeating the whole input action in the case of invalid input AFTER the user clicked OK is not very smart and efficient:

  var aNewFolderName: string := 'New Project Folder';
  var InputIsValid: Boolean;
  repeat
    if Vcl.Dialogs.InputQuery('New Project Folder', 'Enter the name of the new Project Folder:', aNewFolderName) then
    begin
      InputIsValid := CheckInput(aNewFolderName);
      if InputIsValid then CreateTheFolder(aNewFolderName);
    end
    else
      BREAK;
  until InputIsValid;

Also, with this method, there is no feedback for the user about the specific cause of any invalid input.

CodePudding user response：

Although it is possible to solve this problem by using repeated dialogs, I don't think that is a particularly elegant solution from a UX perspective.

I'd rather make my own dialog and do something like this:

procedure TForm1.btnSetPasswordClick(Sender: TObject);
begin
  var psw := '';
  if SuperInput(
    Self,
    'Frog Simulator',
    'Please enter the new frog password:',
    psw,
    function(const Text: string; out AErrorMessage: string): Boolean
    begin
      if Text.Length < 8 then
      begin
        AErrorMessage := 'The password''s length must be at least 8 characters.';
        Exit(False);
      end;
      if not StrHasChrOfType(Text, TCharacter.IsLetter) then
      begin
        AErrorMessage := 'The password must contain at least one letter.';
        Exit(False);
      end;
      if not StrHasChrOfType(Text, TCharacter.IsDigit) then
      begin
        AErrorMessage := 'The password must contain at least one digit.';
        Exit(False);
      end;
      if not StrHasChrOfType(Text, TCharacter.IsPunctuation) then
      begin
        AErrorMessage := 'The password must contain at least one punctuation character.';
        Exit(False);
      end;
      Result := True;
    end)
  then
    lblNewPassword.Caption := psw;
end;

Here's the code:

unit SuperInputDlg;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls;

type
  TValidator = reference to function(const Text: string;
    out AErrorMessage: string): Boolean;
  TSuperInputForm = class(TForm)
    lblCaption: TLabel;
    shClient: TShape;
    Edit: TEdit;
    pbErrorIcon: TPaintBox;
    lblError: TLabel;
    Validator: TTimer;
    btnOK: TButton;
    btnCancel: TButton;
    procedure FormCreate(Sender: TObject);
    procedure pbErrorIconPaint(Sender: TObject);
    procedure EditChange(Sender: TObject);
    procedure ValidatorTimer(Sender: TObject);
    procedure btnOKClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    FErrorIcon: HICON;
    FLIWSD: Boolean;
    FValidator: TValidator;
    function DoValidate: Boolean;
  public
  end;

function SuperInput(AOwnerForm: TCustomForm; const ACaption, AMainInstruction: string;
  var AText: string; AValidator: TValidator = nil): Boolean;

implementation

{$R *.dfm}

function Scale(X: Integer): Integer;
begin
  Result := MulDiv(X, Screen.PixelsPerInch, 96);
end;

procedure TSuperInputForm.btnOKClick(Sender: TObject);
begin
  if DoValidate then
    ModalResult := mrOK;
end;

function TSuperInputForm.DoValidate: Boolean;
begin

  var LErrMsg: string;
  var LIsValid := not Assigned(FValidator) or FValidator(Edit.Text, LErrMsg);

  btnOK.Enabled := LIsValid;

  if not LIsValid then
    lblError.Caption := LErrMsg;

  pbErrorIcon.Visible := not LIsValid;
  lblError.Visible := not LIsValid;

  Result := LIsValid;

end;

procedure TSuperInputForm.EditChange(Sender: TObject);
begin
  Validator.Enabled := False;
  Validator.Enabled := True;
end;

procedure TSuperInputForm.FormCreate(Sender: TObject);
var
  ComCtl: HMODULE;
  LoadIconWithScaleDown: function(hinst: HINST; pszName: LPCWSTR; cx: Integer;
    cy: Integer; var phico: HICON): HResult; stdcall;
begin

  ComCtl := LoadLibrary('ComCtl32.dll');
  if ComCtl <> 0 then
  begin
    try
      LoadIconWithScaleDown := GetProcAddress(ComCtl, 'LoadIconWithScaleDown');
      if Assigned(LoadIconWithScaleDown) then
        LoadIconWithScaleDown(0, IDI_ERROR, Scale(16), Scale(16), FErrorIcon);
    finally
      FreeLibrary(ComCtl);
    end;
  end;

  FLIWSD := FErrorIcon <> 0;
  if FErrorIcon = 0 then
    FErrorIcon := LoadIcon(0, IDI_ERROR);

end;

procedure TSuperInputForm.FormDestroy(Sender: TObject);
begin
  if FLIWSD then
    DestroyIcon(FErrorIcon);
end;

procedure TSuperInputForm.pbErrorIconPaint(Sender: TObject);
begin
  if FErrorIcon <> 0 then
    DrawIconEx(pbErrorIcon.Canvas.Handle, 0, 0, FErrorIcon,
      Scale(16), Scale(16), 0, 0, DI_NORMAL);
end;

procedure TSuperInputForm.ValidatorTimer(Sender: TObject);
begin
  DoValidate;
end;

function SuperInput(AOwnerForm: TCustomForm; const ACaption, AMainInstruction: string;
  var AText: string; AValidator: TValidator = nil): Boolean;
begin
  var LFrm := TSuperInputForm.Create(AOwnerForm);
  try
    LFrm.Caption := ACaption;
    LFrm.lblCaption.Caption := AMainInstruction;
    LFrm.Edit.Text := AText;
    LFrm.FValidator := AValidator;
    LFrm.DoValidate;
    Result := LFrm.ShowModal = mrOk;
    if Result then
      AText := LFrm.Edit.Text;
  finally
    LFrm.Free;
  end;
end;

end.

and DFM:

object SuperInputForm: TSuperInputForm
  Left = 0
  Top = 0
  Caption = 'Input Box'
  ClientHeight = 166
  ClientWidth = 469
  Color = clBtnFace
  Constraints.MaxHeight = 204
  Constraints.MinHeight = 204
  Constraints.MinWidth = 400
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -12
  Font.Name = 'Segoe UI'
  Font.Style = []
  OldCreateOrder = False
  Position = poOwnerFormCenter
  OnCreate = FormCreate
  OnDestroy = FormDestroy
  DesignSize = (
    469
    166)
  PixelsPerInch = 96
  TextHeight = 15
  object shClient: TShape
    Left = 0
    Top = 0
    Width = 468
    Height = 127
    Anchors = [akLeft, akTop, akRight, akBottom]
    Pen.Style = psClear
    ExplicitWidth = 499
    ExplicitHeight = 175
  end
  object lblCaption: TLabel
    Left = 24
    Top = 24
    Width = 65
    Height = 21
    Caption = 'Input Box'
    Font.Charset = DEFAULT_CHARSET
    Font.Color = 10040064
    Font.Height = -16
    Font.Name = 'Segoe UI'
    Font.Style = []
    ParentFont = False
  end
  object pbErrorIcon: TPaintBox
    Left = 24
    Top = 88
    Width = 16
    Height = 16
    OnPaint = pbErrorIconPaint
  end
  object lblError: TLabel
    Left = 50
    Top = 88
    Width = 3
    Height = 15
  end
  object Edit: TEdit
    Left = 24
    Top = 51
    Width = 418
    Height = 23
    Anchors = [akLeft, akTop, akRight]
    TabOrder = 0
    OnChange = EditChange
    ExplicitWidth = 449
  end
  object btnOK: TButton
    Left = 286
    Top = 133
    Width = 75
    Height = 25
    Anchors = [akRight, akBottom]
    Caption = 'OK'
    Default = True
    TabOrder = 1
    OnClick = btnOKClick
    ExplicitLeft = 317
    ExplicitTop = 181
  end
  object btnCancel: TButton
    Left = 367
    Top = 133
    Width = 75
    Height = 25
    Anchors = [akRight, akBottom]
    Cancel = True
    Caption = 'Cancel'
    ModalResult = 2
    TabOrder = 2
    ExplicitLeft = 398
    ExplicitTop = 181
  end
  object Validator: TTimer
    OnTimer = ValidatorTimer
    Left = 136
    Top = 120
  end
end

Please note that this is only a sketch I did in ten minutes -- in a real app, you'd spend a bit more time on this one.

Appendix 1

type
  TChrTestFcn = function(C: Char): Boolean;

function StrHasChrOfType(const AText: string; ATestFcn: TChrTestFcn): Boolean;
begin
  for var S in AText do
    if ATestFcn(S) then
      Exit(True);
  Result := False;
end;

CodePudding user response：

The easiest and most versatile option is to write your own input dialog and either include the validation code in the dialog or alternatively pass a callback method that does the validation.

CodePudding user response：

No, there is no way. But there are alternatives:

Look up InputQuery's code, write similar code and then make modifications where you want them (e.g. setting an OnChange handler for the TEdit). You'll notice it has been done in a quite simple way.
Design your own form for it, instead of (like InputQuery does) creating one on the fly:
- You can either use your own logic for getting the user's choice and input when the form is closed, or
- you set the form's ModalResult property (via code) anytime, and you can assign a ModalResult to each button (e.g. mrCancel), so it automatically sets the form's ModalResult property. Call your own form just as if it's