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.
转载于:https://www.cnblogs.com/shangdawei/archive/2013/04/30/3052538.html
相关资源：数据结构—成绩单生成器
