0

在 Delphi 11 Alexandria 的 Windows 10 中的 32 位 VCL 应用程序中，我向用户显示了一个 INPUT DIALOG：

  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;

有没有办法在他点击确定按钮之前验证用户的输入？（例如，检查不允许的字符、现有文件夹等）。在用户单击确定后，在输入无效的情况下重复整个输入操作并不是很聪明和高效：

  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;

此外，使用这种方法，对于任何无效输入的具体原因，用户都没有反馈。

4

4 回答 4

4

虽然可以通过使用重复对话来解决这个问题，但我认为从 UX 角度来看，这并不是一个特别优雅的解决方案。

我宁愿制作自己的对话框并执行以下操作：

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;

本次录屏

这是代码：

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.

和 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

请注意，这只是我在十分钟内完成的一个草图——在一个真正的应用程序中，你会花更多的时间在这个上。

附录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;
于 2022-02-06T14:27:21.893 回答
1

最简单和最通用的选择是编写自己的输入对话框，并在对话框中包含验证代码，或者传递一个执行验证的回调方法。

但是要回答您提出的问题：

“有没有办法在用户点击确定按钮之前验证用户的输入？”

不，没有办法，据我所知。

于 2022-02-06T10:22:19.497 回答
1

不，没有办法。但也有替代方案：

  1. 查找InputQuery的代码，编写类似的代码，然后在您想要的地方进行修改（例如为 设置OnChange处理程序TEdit）。你会注意到它是以一种非常简单的方式完成的。

  2. 为它设计自己的表单，而不是（像InputQuery那样）动态创建一个：

    • 您可以使用自己的逻辑在表单关闭时获取用户的选择和输入，或者
    • 您可以随时设置表单的ModalResult属性（通过代码），并且可以ModalResult为每个按钮分配一个（例如mrCancel），因此它会自动设置表单的ModalResult属性。调用您自己的表单，就好像它是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;

  3. 对我来说，只要给出任何形式的反馈，任何形式仍然可见或不可见，这几乎没有什么区别。你可以给它，因为没有什么能阻止你这样做：

    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;
于 2022-02-06T12:01:23.690 回答
0

感谢在用户单击确定之前明确确认没有预先设计的方法来验证输入的用户。现在剩下的问题是：如何向用户提供关于失效原因的有意义且有效的反馈？IMO，显示附加错误对话框不符合这些标准。所以我实现了一个解决方案，其中提示被重新出现的 InputQuery 对话框中的验证错误消息替换：

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;

示例截图：

在此处输入图像描述

在此处输入图像描述

在此处输入图像描述

于 2022-02-06T13:02:56.527 回答