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.
