MultiInput.pas

{******************************************************************************}
{                                                                              }
{ Rejbrand Input Dialog Box                                                    }
{                                                                              }
{ Copyright © 2015-2016 Andreas Rejbrand                                       }
{                                                                              }
{ http://english.rejbrand.se/                                                  }
{                                                                              }
{******************************************************************************}

unit MultiInput;

interface

uses
  Windows, SysUtils, Types, Controls, Graphics, Forms, StdCtrls, ExtCtrls,
  CommCtrl;

type
  TAllowOnlyOption = (aoCapitalAZ, aoSmallAZ, aoAZ, aoLetters, aoDigits, aoSpace,
    aoPeriod, aoComma, aoSemicolon, aoHyphenMinus, aoPlus, aoUnderscore, aoAsterisk);
  TAllowOnlyOptions = set of TAllowOnlyOption;
  TInputVerifierFunc = reference to function(const S: string): boolean;
  TMultiInputBox = class
  strict private
    class var
      frm: TForm;
      edt: TEdit;
      btnOK,
      btnCancel: TButton;
      FMin, FMax: integer;
      FFloatMin, FFloatMax: real;
      FAllowEmptyString: boolean;
      FAllowOnly: TAllowOnlyOptions;
      FInputVerifierFunc: TInputVerifierFunc;
      spin: HWND;
      FTitle, FText: string;
      lineat: integer;
      R: TRect;
    class procedure Paint(Sender: TObject);
    class procedure FormActivate(Sender: TObject);
    class procedure SetupDialog;
    class procedure ValidateIntInput(Sender: TObject);
    class procedure ValidateRealInput(Sender: TObject);
    class procedure ValidateStrInput(Sender: TObject);
  private
    class procedure ValidateStrInputManual(Sender: TObject);
  public
    class function TextInputBox(AOwner: TCustomForm; const ATitle,
      AText: string; var Value: string; ACharCase: TEditCharCase = ecNormal;
      AAllowEmptyString: boolean = true; AAllowOnly: TAllowOnlyOptions = []): boolean;
    class function CharInputBox(AOwner: TCustomForm; const ATitle,
      AText: string; var Value: char; ACharCase: TEditCharCase = ecNormal;
      AAllowOnly: TAllowOnlyOptions = []): boolean;
    class function TextInputBoxEx(AOwner: TCustomForm; const ATitle,
      AText: string; var Value: string; ACharCase: TEditCharCase = ecNormal;
      AInputVerifierFunc: TInputVerifierFunc = nil): boolean;
    class function NumInputBox(AOwner: TCustomForm; const ATitle,
      AText: string; var Value: integer; AMin: integer = -MaxInt + 1;
      AMax: integer = MaxInt): boolean;
    class function FloatInputBox(AOwner: TCustomForm; const ATitle,
      AText: string; var Value: real; AMin: real; AMax: real): boolean;
  end;

implementation

uses Math, Messages, Character;

class procedure TMultiInputBox.Paint(Sender: TObject);
begin
  with frm.Canvas do
  begin
    Pen.Style := psSolid;
    Pen.Width := 1;
    Pen.Color := $00DFDFDF;
    Brush.Style := bsSolid;
    Brush.Color := clWhite;
    FillRect(Rect(0, 0, frm.ClientWidth, lineat));
    MoveTo(0, lineat);
    LineTo(frm.ClientWidth, lineat);
    DrawText(frm.Canvas.Handle, FText, Length(FText), R,
      DT_NOPREFIX or DT_WORDBREAK);
  end;
end;

class procedure TMultiInputBox.SetupDialog;
begin
  { * = Metrics from                                                           }
  { https://msdn.microsoft.com/en-us/windows/desktop/dn742486                  }
  {            and                                                             }
  { https://msdn.microsoft.com/en-us/windows/desktop/dn742478%28v=vs.85%29     }
  frm.Font.Name := 'Segoe UI';
  frm.Font.Size := 9{*};
  frm.Caption := FTitle;
  frm.Width := 400;
  frm.Position := poOwnerFormCenter;
  frm.BorderStyle := bsDialog;
  frm.OnPaint := Paint;
  frm.OnActivate := FormActivate;

  frm.Canvas.Font.Size := 12; { 'MainInstruction' }
  frm.Canvas.Font.Color := $00993300;
  R := Rect(11{*}, 11{*}, frm.Width - 11{*}, 11{*} + 2);
  DrawText(frm.Canvas.Handle, FText, Length(FText),
    R, DT_CALCRECT or DT_NOPREFIX or DT_WORDBREAK);

  edt := TEdit.Create(frm);
  edt.Parent := frm;
  edt.Top := R.Bottom + 5{*};
  edt.Left := 11{*};
  edt.Width := frm.ClientWidth - 2*11{*};
  lineat := edt.Top + edt.Height + 11{*};
  btnOK := TButton.Create(frm);
  btnOK.Parent := frm;
  btnOK.Height := 23{*};
  btnOK.Default := true;
  btnOK.Caption := 'OK';
  btnOK.ModalResult := mrOk;
  btnCancel := TButton.Create(frm);
  btnCancel.Parent := frm;
  btnCancel.Height := 23{*};
  btnCancel.Cancel := true;
  btnCancel.Caption := 'Cancel';
  btnCancel.ModalResult := mrCancel;
  btnCancel.Top := edt.Top + edt.Height + 11{*} + 1{*} + 11{*};
  btnCancel.Left := frm.ClientWidth - btnCancel.Width - 11{*};
  btnOK.Top := btnCancel.Top;
  btnOK.Left := btnCancel.Left - btnOK.Width - 7{*};
  frm.ClientHeight := btnOK.Top + btnOK.Height + 11{*};
end;

class procedure TMultiInputBox.ValidateStrInputManual(Sender: TObject);
begin
  btnOK.Enabled := (not Assigned(FInputVerifierFunc)) or FInputVerifierFunc(edt.Text);
end;

class function TMultiInputBox.TextInputBoxEx(AOwner: TCustomForm; const ATitle,
  AText: string; var Value: string; ACharCase: TEditCharCase;
  AInputVerifierFunc: TInputVerifierFunc): boolean;
begin
  FTitle := ATitle;
  FText := AText;
  FInputVerifierFunc := AInputVerifierFunc;

  frm := TForm.Create(AOwner);
  try
    SetupDialog;
    edt.Text := Value;
    edt.CharCase := ACharCase;
    edt.OnChange := ValidateStrInputManual;
    ValidateStrInputManual(nil);
    result := frm.ShowModal = mrOK;
    if result then Value := edt.Text;
  finally
    frm.Free;
  end;
end;

class procedure TMultiInputBox.ValidateStrInput(Sender: TObject);

  function IsValidStr: boolean;
  var
    S: string;
    i: integer;
  begin
    S := edt.Text;

    result := (Length(S) > 0) or FAllowEmptyString;
    if not result then Exit;

    if FAllowOnly = [] then Exit;

    if aoLetters in FAllowOnly then
      Include(FAllowOnly, aoAZ);

    if aoAZ in FAllowOnly then
    begin
      Include(FAllowOnly, aoCapitalAZ);
      Include(FAllowOnly, aoSmallAZ);
    end;

    result := true;
    for i := 1 to Length(S) do
      case S[i] of
        'a'..'z':
          if not (aoSmallAZ in FAllowOnly) then
            Exit(false);
        'A'..'Z':
          if not (aoCapitalAZ in FAllowOnly) then
            Exit(false);
        '0'..'9':
          if not (aoDigits in FAllowOnly) then
            Exit(false);
        ' ':
          if not (aoSpace in FAllowOnly) then
            Exit(false);
        '.':
          if not (aoPeriod in FAllowOnly) then
            Exit(false);
        ',':
          if not (aoComma in FAllowOnly) then
            Exit(false);
        ';':
          if not (aoSemicolon in FAllowOnly) then
            Exit(false);
        '-':
          if not (aoHyphenMinus in FAllowOnly) then
            Exit(false);
        '+':
          if not (aoPlus in FAllowOnly) then
            Exit(false);
        '_':
          if not (aoUnderscore in FAllowOnly) then
            Exit(false);
        '*':
          if not (aoAsterisk in FAllowOnly) then
            Exit(false);
      else
        if not (S[i].IsLetter and (aoLetters in FAllowOnly)) then
          Exit(false);
      end;

  end;

begin
    btnOK.Enabled := IsValidStr;
end;

class function TMultiInputBox.TextInputBox(AOwner: TCustomForm; const ATitle,
  AText: string; var Value: string; ACharCase: TEditCharCase = ecNormal;
  AAllowEmptyString: boolean = true; AAllowOnly: TAllowOnlyOptions = []): boolean;
begin
  FTitle := ATitle;
  FText := AText;
  FAllowEmptyString := AAllowEmptyString;
  FAllowOnly := AAllowOnly;

  frm := TForm.Create(AOwner);
  try
    SetupDialog;
    edt.Text := Value;
    edt.CharCase := ACharCase;
    edt.OnChange := ValidateStrInput;
    ValidateStrInput(nil);
    result := frm.ShowModal = mrOK;
    if result then Value := edt.Text;
  finally
    frm.Free;
  end;
end;

class procedure TMultiInputBox.ValidateIntInput(Sender: TObject);
var
  n: integer;
begin
  btnOK.Enabled := TryStrToInt(edt.Text, n) and InRange(n, FMin, FMax);
end;

class procedure TMultiInputBox.ValidateRealInput(Sender: TObject);
var
  x: double;
begin
  btnOK.Enabled := TryStrToFloat(edt.Text, x) and InRange(x, FFloatMin, FFloatMax);
end;

class function TMultiInputBox.CharInputBox(AOwner: TCustomForm; const ATitle,
  AText: string; var Value: char; ACharCase: TEditCharCase;
  AAllowOnly: TAllowOnlyOptions): boolean;
begin
  FTitle := ATitle;
  FText := AText;
  FAllowEmptyString := false;
  FAllowOnly := AAllowOnly;

  frm := TForm.Create(AOwner);
  try
    SetupDialog;
    edt.Text := Value;
    edt.CharCase := ACharCase;
    edt.OnChange := ValidateStrInput;
    edt.MaxLength := 1;
    ValidateStrInput(nil);
    result := frm.ShowModal = mrOK;
    if result then Value := edt.Text[1];
  finally
    frm.Free;
  end;
end;

class function TMultiInputBox.FloatInputBox(AOwner: TCustomForm; const ATitle,
  AText: string; var Value: real; AMin, AMax: real): boolean;
begin
  FFloatMin := AMin;
  FFloatMax := AMax;
  FTitle := ATitle;
  FText := AText;

  frm := TForm.Create(AOwner);
  try
    SetupDialog;
    edt.Text := FloatToStr(Value);
    edt.OnChange := ValidateRealInput;
    ValidateRealInput(nil);
    result := frm.ShowModal = mrOK;
    if result then Value := StrToFloat(edt.Text);
  finally
    frm.Free;
  end;
end;

class procedure TMultiInputBox.FormActivate(Sender: TObject);
var
  b: BOOL;
begin
  if SystemParametersInfo(SPI_GETSNAPTODEFBUTTON, 0, @b, 0) and b then
    with btnOK do
      with ClientToScreen(Point(Width div 2, Height div 2)) do
        SetCursorPos(x, y);
  frm.OnActivate := nil;
end;

class function TMultiInputBox.NumInputBox(AOwner: TCustomForm; const ATitle,
  AText: string; var Value: integer; AMin: integer = -MaxInt + 1;
  AMax: integer = MaxInt): boolean;
const
  UDM_SETPOS32 = WM_USER + 113;
var
  ICCX: TInitCommonControlsEx;
begin
  FMin := AMin;
  FMax := AMax;
  FTitle := ATitle;
  FText := AText;

  frm := TForm.Create(AOwner);
  try
    SetupDialog;

    ICCX.dwSize := sizeof(ICCX);
    ICCX.dwICC := ICC_UPDOWN_CLASS;
    InitCommonControlsEx(ICCX);
    spin := CreateWindowEx(0, PChar(UPDOWN_CLASS), nil,
      WS_CHILDWINDOW or WS_VISIBLE or UDS_NOTHOUSANDS or UDS_SETBUDDYINT or
      UDS_ALIGNRIGHT or UDS_ARROWKEYS or UDS_HOTTRACK, 0, 0, 0, 0, frm.Handle,
      0, HInstance, nil);
    SendMessage(spin, UDM_SETRANGE32, FMin, FMax);
    SendMessage(spin, UDM_SETPOS32, 0, Value);
    SendMessage(spin, UDM_SETBUDDY, edt.Handle, 0);

    if FMin >= 0 then
      edt.NumbersOnly := true;
    edt.Text := IntToStr(value);
    edt.OnChange := ValidateIntInput;
    ValidateIntInput(nil);
    result := frm.ShowModal = mrOK;
    if result then Value := StrToInt(edt.Text);
  finally
    frm.Free;
  end;
end;

end.