如何在用戶單擊確定之前驗證InputQuery用戶輸入？

在 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;

此外，使用這種方法，對于任何無效輸入的具體原因，用戶都沒有反饋。

uj5u.com熱心網友回復：

雖然可以通過使用重復對話來解決這個問題，但我不認為從 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

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;

uj5u.com熱心網友回復：

不，沒有辦法。但也有替代方案：

1. 查找InputQuery的代碼，撰寫類似的代碼，然后在需要的地方進行修改（例如為 設定OnChange處理程式TEdit）。你會注意到它是以一種非常簡單的方式完成的。

2. 為它設計自己的表單，而不是（像InputQuery那樣）動態創建一個：

   • 您可以使用自己的邏輯在表單關閉時獲取用戶的選擇和輸入，或者
   • 您可以隨時設定表單的ModalResult屬性（通過代碼），并且可以ModalResult為每個按鈕分配一個（例如mrCancel），因此它會自動設定表單的ModalResult屬性。呼叫您自己的表單，就好像它是

     

     

     轉載請註明出處，本文鏈接：https://www.uj5u.com/yidong/424519.html

     標籤：验证 德尔福 用户输入 delphi-11-亚历山大

     上一篇：VirtualStringTree如何在拖放時禁用alpha混合選擇？

     下一篇：當沒有可用的可見表單時如何在任務欄中始終顯示圖示