Delphi Multi InputBox

unit uMultiInputBox;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  System.Classes, Vcl.Controls, Vcl.Forms, Vcl.StdCtrls;

type
  TFieldType = ( ftNumber, ftHexNumber, ftFloatNumber, ftText );

  TInputRec = record
    Prompt : string;
    MaxLength : integer;
    FieldType : TFieldType;
    FieldValue : Variant;
  end;

  TInputRecArray = array of TInputRec;

const
  FORM_CAPTION_HEIGHT = 30;
  CLIENT_SPACE = 20;
  BUTTON_HEIGHT = 25;
  BUTTON_WIDTH = 100;
  LABEL_H_EDIT = 10;
  LABEL_V_LEBEL = 35;
  EDIT_PADDED = 10;
  EDIT_MAX_WIDTH = 300;
  EDIT_DELTA_LABEL = 5;

function MultiInputBox( Self : TObject; const ACaption : string;
  InputRecs : TInputRecArray ) : boolean;

implementation

var
  Box : TForm;
  ButtonOK : TButton;
  ButtonCancel : TButton;
  Labels : array of TLabel;
  Edits : array of TEdit;

procedure ButtonCancelClick( Self, Sender : TObject );
begin
  TForm( Self ).ModalResult := mrCancel; // Form will be closed
end;

procedure ButtonOkClick( Self, Sender : TObject );
var
  RecCount : integer;
  InputRecs : TInputRecArray;
  I : integer;
begin
  InputRecs := TInputRecArray( Self );

  RecCount := Length( InputRecs );
  for I := 0 to RecCount - 1 do
  begin
    case InputRecs[ I ].FieldType of
      ftNumber :
        InputRecs[ I ].FieldValue := StrToInt( Edits[ I ].Text );
      ftHexNumber :
        InputRecs[ I ].FieldValue := StrToInt( '$' + Edits[ I ].Text );
      ftFloatNumber :
        InputRecs[ I ].FieldValue := StrToFloat( Edits[ I ].Text );
      ftText :
        InputRecs[ I ].FieldValue := Edits[ I ].Text;
    end;
  end;

  // Form will be closed
  TForm( TButton( Sender ).Parent ).ModalResult := mrOK;
end;

procedure EditKeyPress( Self, Sender : TObject; var Key : Char );
var
  FieldType : TFieldType;
begin
  // Edits[ I ].Tag := Ord( InputRecs[ I ].FieldType );
  FieldType := TFieldType( TEdit( Sender ).Tag );
  if FieldType = ftNumber then
  begin
    if not CharInSet( Key, [ '0' .. '9', '-', #8 ] ) then
      Key := #0;
  end
  else if FieldType = ftHexNumber then
  begin
    if not CharInSet( Key, [ '0' .. '9', 'A' .. 'F', 'a' .. 'f', #8 ] ) then
      Key := #0;
  end
  else if FieldType = ftFloatNumber then
  begin
    if not CharInSet( Key, [ '0' .. '9', '-', '.', #8 ] ) then
      Key := #0;
  end;
end;

function MultiInputBox( Self : TObject; const ACaption : string;
  InputRecs : TInputRecArray ) : boolean;
var
  RecCount : integer;
  Top : integer;
  Left : integer;
  M : TMethod;
  I : integer;
  MaxLabelWidth, LabelWidth : integer;
  MaxEditWidth, EditWidth : integer;
  Number : uint64;
  FloatNumber : double;
begin
  result := false;

  RecCount := Length( InputRecs );
  if RecCount = 0 then
    raise Exception.Create( 'Error Input Count' );

  SetLength( Labels, RecCount );
  SetLength( Edits, RecCount );

  Box := TForm.Create( TComponent( Self ) ); // Owner : Destroy it
  try
    Box.Parent := TWinControl( Self ); // Parent : Display it
    Box.BorderStyle := bsDialog;
    Box.Position := poOwnerFormCenter;
    Box.Caption := ACaption;
    //
    // Box.Canvas.TextWidth
    Box.Font := TForm( Self ).Font;

    Top := CLIENT_SPACE;
    MaxLabelWidth := 0;
    for I := 0 to RecCount - 1 do
    begin
      Labels[ I ] := TLabel.Create( Box ); // Owner : Destroy by Box
      Labels[ I ].Parent := Box; // Parent : Display in Box
      Labels[ I ].Top := Top;
      Labels[ I ].Caption := InputRecs[ I ].Prompt;
      Top := Top + LABEL_V_LEBEL;
      LabelWidth := Box.Canvas.TextWidth( Labels[ I ].Caption );
      if MaxLabelWidth < LabelWidth then
        MaxLabelWidth := LabelWidth;
    end;

    MaxLabelWidth := MaxLabelWidth + CLIENT_SPACE;
    for I := 0 to RecCount - 1 do
    begin
      Labels[ I ].Left := MaxLabelWidth - Box.Canvas.TextWidth
        ( Labels[ I ].Caption );
    end;

    Left := MaxLabelWidth + LABEL_H_EDIT;

    MaxEditWidth := 0;
    Top := CLIENT_SPACE - EDIT_DELTA_LABEL;
    for I := 0 to RecCount - 1 do
    begin
      Edits[ I ] := TEdit.Create( Box );
      Edits[ I ].Parent := Box;
      Edits[ I ].Left := Left;
      Edits[ I ].Top := Top;
      Edits[ I ].TabStop := TRUE;
      Edits[ I ].TabOrder := I;
      Edits[ I ].MaxLength := InputRecs[ I ].MaxLength;
      Edits[ I ].Tag := Ord( InputRecs[ I ].FieldType );

      if InputRecs[ I ].FieldType <> ftText then
      begin
        M.Data := Box;
        M.Code := @EditKeyPress;
        Edits[ I ].OnKeyPress := TKeyPressEvent( M );
      end;

      EditWidth := 0;

      case InputRecs[ I ].FieldType of
        ftNumber :
          begin
            Number := InputRecs[ I ].FieldValue;
            Edits[ I ].Text := Format( '%*.*d', [ InputRecs[ I ].MaxLength,
              InputRecs[ I ].MaxLength, Number ] );
            Edits[ I ].Width := Box.Canvas.TextWidth( '0' ) * InputRecs[ I ]
              .MaxLength + EDIT_PADDED;
          end;
        ftHexNumber :
          begin
            Number := InputRecs[ I ].FieldValue;
            Edits[ I ].Text := IntToHex( Number, InputRecs[ I ].MaxLength );
            Edits[ I ].Width := Box.Canvas.TextWidth( '0' ) * InputRecs[ I ]
              .MaxLength + EDIT_PADDED;
          end;
        ftFloatNumber :
          begin
            FloatNumber := InputRecs[ I ].FieldValue;
            Edits[ I ].Text := Format( '%-*.2f', [ InputRecs[ I ].MaxLength,
              FloatNumber ] );
            Edits[ I ].Width := Box.Canvas.TextWidth( '0' ) * InputRecs[ I ]
              .MaxLength + EDIT_PADDED;
          end;
        ftText :
          begin
            Edits[ I ].Text := InputRecs[ I ].FieldValue;
            Edits[ I ].Width := Box.Canvas.TextWidth( 'W' ) * InputRecs[ I ]
              .MaxLength + EDIT_PADDED;
            if Edits[ I ].Width > EDIT_MAX_WIDTH then
              Edits[ I ].Width := EDIT_MAX_WIDTH;
          end;
      else
        raise Exception.Create( 'Error Input Type' );
      end;

      if MaxEditWidth < Edits[ I ].Width then
        MaxEditWidth := Edits[ I ].Width;

      Top := Top + LABEL_V_LEBEL;
    end;

    Top := Top + EDIT_DELTA_LABEL;

    Box.Width := Left + MaxEditWidth + CLIENT_SPACE;
    Box.Height := FORM_CAPTION_HEIGHT + Top + BUTTON_HEIGHT + CLIENT_SPACE;

    ButtonOK := TButton.Create( Box );
    ButtonOK.TabStop := false;
    ButtonOK.Parent := Box;
    ButtonOK.Height := BUTTON_HEIGHT;
    ButtonOK.Width := BUTTON_WIDTH;
    ButtonOK.Caption := 'OK';
    M.Data := InputRecs;
    M.Code := @ButtonOkClick;
    ButtonOK.OnClick := TNotifyEvent( M );

    ButtonCancel := TButton.Create( Box );
    ButtonCancel.TabStop := false;
    ButtonCancel.Parent := Box;
    ButtonCancel.Height := BUTTON_HEIGHT;
    ButtonCancel.Width := BUTTON_WIDTH;
    ButtonCancel.Caption := 'Cancel';

    M.Data := Box;
    M.Code := @ButtonCancelClick;
    ButtonCancel.OnClick := TNotifyEvent( M );

    ButtonOK.Left := ( Box.Width - ( BUTTON_WIDTH * 2 ) ) div 3;
    ButtonOK.Top := Top;

    ButtonCancel.Left := Box.Width - BUTTON_WIDTH -
      ( Box.Width - ( BUTTON_WIDTH * 2 ) ) div 3;
    ButtonCancel.Top := Top;

    result := Box.ShowModal = mrOK;
  finally
    FreeAndNil( Box );
  end;
end;

end.