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

Question

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.

Answer 1

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;

Answer 2

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 MessageBox():
case MyForm.ShowModal() of
IDOK: begin
// User wants to proceed AND no error was found
end;
IDCANCEL: begin
// User gave up
end;
else
// Unexpected result
end;
For me it would make nearly no difference if any feedback is given with any form still visible or not, as long as it is given. And you can give it, because nothing keeps you from doing so:
var
aNewFolderName,
sErrorMsg: String;
begin
repeat
aNewFolderName:= 'New Project Folder';
// User cancelled: leaving loop
if not Vcl.Dialogs.InputQuery( 'New project folder', 'Enter the name of the new project folder:', aNewFolderName ) then break;
// Already errors before the attempt?
sErrorMsg:= CheckInput( aNewFolderName );
// Actual attempt, which may still go wrong for various reasons
if sErrorMsg= '' then sErrorMsg:= CreateTheFolder( aNewFolderName );
// Anything to report?
if sErrorMsg<> '' then begin
sErrorMsg:= sErrorMsg+ #13#10
+ 'Click "Retry" to try a different new project name.'+ #13#10
+ 'Click "Cancel" to not create any new project.';
if MessageBox( sErrorMsg, 'Error', MB_RETRYCANCEL )= IDCANCEL then break;
end else begin
break; // Otherwise we're done (CreateTheFolder was successful)
end;
until FALSE;
end;

Answer 3

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.
But to answer the question as you asked it:
"Is there a way to VALIDATE the user's input BEFORE he clicks the OK button?"
No, there is no way, as far as I know.

Answer 4

Thanks to the users who explicitly confirmed that there is no predesigned way to validate the input before the user clicks OK. Now the remaining question is: How to provide a meaningful and efficient feedback about the invalidation cause to the user? IMO, showing an ADDITIONAL error dialog does not meet these criteria. So I implemented a solution where the prompt is replaced by the validation error message in the reappearing InputQuery dialog:
procedure TformMain.menuitemCreateASubProjectGroupClick(Sender: TObject);
begin
var aNewFolderName: string := 'New Project Group';
var InputIsValid: Boolean;
var InputPrompt: string := 'Enter the name of the new Project Group:';
repeat
if Vcl.Dialogs.InputQuery('New Project Group', InputPrompt, aNewFolderName) then
begin
var NewPrompt: string;
InputIsValid := CheckInput(aNewFolderName, NewPrompt);
if not InputIsValid then
InputPrompt := NewPrompt
else
begin
CreateNewFolder(aNewFolderName);
end;
end
else
BREAK;
until InputIsValid;
end;
function PAIsFilenameValid(const AFilename: string; var errorchar: Char): Boolean;
begin
Result := True;
for var i := 1 to Length(AFilename) do
begin
if not System.IOUtils.TPath.IsValidFileNameChar(AFilename[i]) then
begin
errorchar := AFilename[i];
Result := False;
BREAK;
end;
end;
end;
function TformMain.CheckInput(const aNewFolderName: string; out aNewPrompt: string): Boolean;
begin
Result := True;
var errorchar: Char;
if Trim(aNewFolderName) = '' then
begin
aNewPrompt := 'Error: You must enter a Group name:';
Result := False;
end
else if not PAIsFilenameValid(aNewFolderName, errorchar) then
begin
aNewPrompt := 'Error: No illegal characters (' + errorchar + '):';
Result := False;
end;
// Todo: else...
end;
Example screenshots: