问如何在用户单击“确定”之前验证InputQuery用户输入？

EN

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.

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

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;

- 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()`](https://docwiki.embarcadero.com/Libraries/Sydney/en/Vcl.Forms.TApplication.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;