Delphi 7-仅将InputBox强制为整数？ [英] Delphi 7 - Force InputBox to integer only?
本文介绍了Delphi 7-仅将InputBox强制为整数？的处理方法，对大家解决问题具有一定的参考价值，需要的朋友们下面随着小编来一起学习吧！
问题描述
是否使用Delphi 7强制输入框只允许输入0到100之间的数字？
谢谢！
解决方案
您可以轻松地编写自己的超级对话框，例如
类型
TMultiInputBox =类
严格私有
类var
frm：TForm;
lbl：TLabel；
edt：TEdit；
btnOK，
btnCancel：TButton；
shp：TShape;
FMin，FMax：整数;
FTitle，FText：字符串；
类过程SetupDialog;
类过程ValidateInput（Sender：TObject）;
public
类函数TextInputBox（AOwner：TCustomForm; const ATitle，
AText：string; var Value：string）：boolean;
类函数NumInputBox（AOwner：TCustomForm; const ATitle，
AText：string; AMin，AMax：integer; var Value：integer）：boolean;
结尾；
类过程TMultiInputBox.SetupDialog;
开始
frm。标题：= FTitle;
frm.Width：= 512;
frm.Position：= poOwnerFormCenter;
frm.BorderStyle：= bsDialog;
lbl：= TLabel.Create（frm）;
lbl.Parent：= frm;
lbl.Left：= 8;
lbl.Top：= 8;
lbl.Width：= frm.ClientWidth-16;
lbl.Caption：= FText;
edt：= TEdit.Create（frm）;
edt.Parent：= frm;
edt.Top：= lbl.Top + lbl.Height + 8;
edt.Left：= 8;
edt.Width：= frm.ClientWidth-16;
btnOK：= TButton.Create（frm）;
btnOK.Parent：= frm;
btnOK.Default：= true;
btnOK.Caption：='确定';
btnOK.ModalResult：= mrOk;
btnCancel：= TButton.Create（frm）;
btnCancel.Parent：= frm;
btnCancel.Cancel：= true;
btnCancel.Caption：=‘取消’；
btnCancel.ModalResult：= mrCancel;
btnCancel.Top：= edt.Top + edt.Height + 16;
btnCancel.Left：= frm.ClientWidth-btnCancel.Width-8;
btnOK.Top：= btnCancel.Top;
btnOK.Left：= btnCancel.Left-btnOK.Width-4;
frm.ClientHeight：= btnOK.Top + btnOK.Height + 8;
shp：= TShape.Create（frm）;
shp.Parent：= frm;
shp.Brush.Color：= clWhite;
shp.Pen.Style：= psClear;
shp.Shape：= stRectangle;
shp.Align：= alTop;
shp.Height：= btnOK.Top-8;
shp.SendToBack;
结尾；
类函数TMultiInputBox.TextInputBox（AOwner：TCustomForm; const ATitle，
AText：string; var Value：string）：boolean;
开始
FTitle：= ATitle;
FText：= AText;
frm：= TForm.Create（AOwner）;
尝试
SetupDialog；
edt.NumbersOnly：= false;
edt.Text：=值;
结果：= frm.ShowModal = mrOK;
如果结果则为value：= edt.Text;
最终
frm。免费；
结尾；
结尾；
类过程TMultiInputBox.ValidateInput（Sender：TObject）;
var
n：整数；
开始
btnOK.Enabled：= TryStrToInt（edt.Text，n）和InRange（n，FMin，FMax）;
结尾；
类函数TMultiInputBox.NumInputBox（AOwner：TCustomForm; const ATitle，
AText：string; AMin，AMax：integer; var Value：integer）：boolean;
开始
FMin：= AMin;
FMax：= AMax;
FTitle：= ATitle;
FText：= AText;
frm：= TForm.Create（AOwner）;
尝试
SetupDialog；
edt.NumbersOnly：= true;
edt.Text：= IntToStr（value）;
edt.OnChange：= ValidateInput;
结果：= frm.ShowModal = mrOK;
如果结果为value：= StrToInt（edt.Text）;
最终
frm。免费；
结尾；
结尾；
此对话框允许输入文本和整数：
v：= 55;
，如果TMultiInputBox.NumInputBox（Self，‘This is the title’，‘输入1到100之间的数字：’，1、100，v），然后
ShowMessage（IntToStr（v））;
或
s：='测试';
，如果TMultiInputBox.TextInputBox（Self，这是标题，输入一些文本：，s），则
ShowMessage（s）;
更新
评论者评论了类过程（等）。在Delphi 7中尚未引入。如果是这种情况（我真的不记得...），只需删除所有以下语法糖：
var
frm：TForm;
lbl：TLabel；
edt：TEdit；
btnOK，
btnCancel：TButton；
shp：TShape;
FMin，FMax：整数;
FTitle，FText：字符串；
过程SetupDialog;
开始
frm。标题：= FTitle;
frm.Width：= 512;
frm.Position：= poOwnerFormCenter;
frm.BorderStyle：= bsDialog;
lbl：= TLabel.Create（frm）;
lbl.Parent：= frm;
lbl.Left：= 8;
lbl.Top：= 8;
lbl.Width：= frm.ClientWidth-16;
lbl.Caption：= FText;
edt：= TEdit.Create（frm）;
edt.Parent：= frm;
edt.Top：= lbl.Top + lbl.Height + 8;
edt.Left：= 8;
edt.Width：= frm.ClientWidth-16;
btnOK：= TButton.Create（frm）;
btnOK.Parent：= frm;
btnOK.Default：= true;
btnOK.Caption：='确定';
btnOK.ModalResult：= mrOk;
btnCancel：= TButton.Create（frm）;
btnCancel.Parent：= frm;
btnCancel.Cancel：= true;
btnCancel.Caption：=‘取消’；
btnCancel.ModalResult：= mrCancel;
btnCancel.Top：= edt.Top + edt.Height + 16;
btnCancel.Left：= frm.ClientWidth-btnCancel.Width-8;
btnOK.Top：= btnCancel.Top;
btnOK.Left：= btnCancel.Left-btnOK.Width-4;
frm.ClientHeight：= btnOK.Top + btnOK.Height + 8;
shp：= TShape.Create（frm）;
shp.Parent：= frm;
shp.Brush.Color：= clWhite;
shp.Pen.Style：= psClear;
shp.Shape：= stRectangle;
shp.Align：= alTop;
shp.Height：= btnOK.Top-8;
shp.SendToBack;
结尾；
函数TextInputBox（AOwner：TCustomForm; const ATitle，
AText：string; var Value：string）：boolean;
开始
FTitle：= ATitle;
FText：= AText;
frm：= TForm.Create（AOwner）;
尝试
SetupDialog；
edt.NumbersOnly：= false;
edt.Text：=值;
结果：= frm.ShowModal = mrOK;
如果结果则为value：= edt.Text;
最终
frm。免费；
结尾；
结尾；
类型
TInputValidator =类
过程ValidateInput（Sender：TObject）;
结尾；
过程TInputValidator.ValidateInput（Sender：TObject）;
var
n：整数；
开始
btnOK.Enabled：= TryStrToInt（edt.Text，n）和InRange（n，FMin，FMax）;
结尾；
函数NumInputBox（AOwner：TCustomForm; const ATitle，
AText：string; AMin，AMax：integer; var Value：integer）：boolean;
var
iv：TInputValidator;
开始
FMin：= AMin;
FMax：= AMax;
FTitle：= ATitle;
FText：= AText;
frm：= TForm.Create（AOwner）;
尝试
SetupDialog；
edt.Text：= IntToStr（value）;
iv：= TInputValidator.Create;
试试
edt.OnChange：= iv.ValidateInput;
结果：= frm.ShowModal = mrOK;
如果结果为value：= StrToInt（edt.Text）;
最终
iv。免费；
结尾；
最终
frm。免费；
结尾；
结尾；
更新2
我写了一个对话框的新版本和更好版本。现在，它看起来就像一个任务对话框（我详细遵循了Microsoft的指南），并且它提供了许多选项来转换（例如，转换为大写或小写）并验证（许多选项）输入。在整数输入的情况下，它还添加了一个Up Down控件（该输入不需要是自然数）。
源代码：
单位MultiInput;
界面
使用
Windows，SysUtils，类型，控件，图形，窗体，StdCtrls，ExtCtrls，
CommCtrl;
类型
TAllowOnlyOption =（aoCapitalAZ，aoSmallAZ，aoAZ，aoLetters，aoDigits，aoSpace，
aoPeriod，aoComma，aoSemicolon，aoHyphenMinus，aoPlus，aoUnderscore，aoAster）;
TAllowOnlyOptions = TAllowOnlyOption的集合；
TInputVerifierFunc =对函数的引用（const S：字符串）：boolean;
TMultiInputBox =类
严格私有
类var
frm：TForm;
edt：TEdit；
btnOK，
btnCancel：TButton；
FMin，FMax：整数;
FFloatMin，FFloatMax：真实；
FAllowEmptyString：布尔值；
FAllowOnly：TAllowOnlyOptions；
FInputVerifierFunc：TInputVerifierFunc;
旋转：HWND；
FTitle，FText：字符串；
lineat：整数；
R：TRect；
类过程Paint（Sender：TObject）;
类过程FormActivate（Sender：TObject）;
类过程SetupDialog;
类过程ValidateIntInput（Sender：TObject）;
类过程ValidateRealInput（Sender：TObject）;
类过程ValidateStrInput（Sender：TObject）;
私有
类过程ValidateStrInputManual（Sender：TObject）;
public
类函数TextInputBox（AOwner：TCustomForm; const ATitle，
AText：string; var Value：string; ACharCase：TEditCharCase = ecNormal;
AAllowEmptyString：boolean = true; AAllowOnly ：TAllowOnlyOptions = []）：布尔值；
类函数CharInputBox（AOwner：TCustomForm; const ATitle，
AText：string; var Value：char; ACharCase：TEditCharCase = ecNormal;
AAllowOnly：TAllowOnlyOptions = []）：布尔值;
类函数TextInputBoxEx（AOwner：TCustomForm; const ATitle，
AText：string; var Value：string; ACharCase：TEditCharCase = ecNormal;
AInputVerifierFunc：TInputVerifierFunc = nil）：布尔值;
类函数NumInputBox（AOwner：TCustomForm; const ATitle，
AText：字符串; var值：整数; AMin：整数= -MaxInt + 1;
AMax：整数= MaxInt）：布尔值;
类函数FloatInputBox（AOwner：TCustomForm; const ATitle，
AText：string; var Value：real; AMin：real; AMax：real）：boolean;
结尾；
实现
使用数学，消息，字符；
类过程TMultiInputBox.Paint（Sender：TObject）;
以frm开始
.Canvas do
开始
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或DT_WORDBREAK）;
结尾；
结尾；
类过程TMultiInputBox.SetupDialog;
开始
{* =指标来自}
{https://msdn.microsoft.com/en-us/windows/desktop/dn742486}
{和}
{https://msdn.microsoft.com/zh-cn/windows/desktop/dn742478}
frm.Font.Name：='Segoe UI';
frm.Font.Size：= 9 {*};
frm.Caption：= FTitle;
frm.Width：= 400;
frm.Position：= poOwnerFormCenter;
frm.BorderStyle：= bsDialog;
frm.OnPaint：=绘画;
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或DT_NOPREFIX或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：='确定';
btnOK.ModalResult：= mrOk;
btnCancel：= TButton.Create（frm）;
btnCancel.Parent：= frm;
btnCancel.Height：= 23 {*};
btnCancel.Cancel：= true;
btnCancel.Caption：=‘取消’；
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 {*};
结尾；
类过程TMultiInputBox.ValidateStrInputManual（Sender：TObject）;
开始
btnOK.Enabled：=（未分配（FInputVerifierFunc））或FInputVerifierFunc（edt.Text）;
结尾；
类函数TMultiInputBox.TextInputBoxEx（AOwner：TCustomForm; const ATitle，
AText：string; var Value：string; ACharCase：TEditCharCase;
AInputVerifierFunc：TInputVerifierFunc）：布尔值;
开始
FTitle：= ATitle;
FText：= AText;
FInputVerifierFunc：= AInputVerifierFunc;
frm：= TForm.Create（AOwner）;
尝试
SetupDialog；
edt.Text：=值;
edt.CharCase：= ACharCase;
edt.OnChange：= ValidateStrInputManual;
ValidateStrInputManual（nil）;
结果：= frm.ShowModal = mrOK;
如果结果则为value：= edt.Text;
最终
frm。免费；
结尾；
结尾；
类过程TMultiInputBox.ValidateStrInput（Sender：TObject）;
函数IsValidStr：布尔值；
var
S：字符串；
i：整数；
开始
S：= edt.Text;
结果：=（Length（S）> 0）或FAllowEmptyString;
，如果没有结果，则退出；
如果FAllowOnly = []，则退出；
如果aOLetters在FAllowOnly中，则
包括（FAllowOnly，aoAZ）；
如果aoAZ在FAllowOnly中，则
开始
包含（FAllowOnly，aoCapitalAZ）；
Include（FAllowOnly，aoSmallAZ）;
结尾；
结果：= true; i的
：= 1到Length（S），在
的情况下
'a'..'z'的
情况：
如果不存在（FAllowOnly中的aoSmallAZ）则
Exit（false）;
'A'.. Z'：
否（FAllowOnly中的aoCapitalAZ），然后
Exit（false）;
'0'..'9'：
否（在FAllowOnly中为aoDigits），然后
Exit（false）;
’’：
否（FAllowOnly中的aoSpace），然后
Exit（false）;
’。：
否（在FAllowOnly中为aoPeriod），然后
Exit（false）;
’，’：
否（FAllowOnly中的aoComma），然后
Exit（false）;
’；’：
否（FAllowOnly中的aoSemicolon），然后
Exit（false）;
’-’：
否（FAllowOnly中的aoHyphenMinus），然后
Exit（false）;
‘+’：
否（在FAllowOnly中为aoPlus），然后
退出（假）；
’_’：
否（在FAllowOnly中为aoUnderscore），然后
Exit（false）;
‘*’：
否（在FAllowOnly中为aoAsterisk），然后
Exit（false）;
否则为
（TCharacter.IsLetter（S [i]）和（FAllowOnly中的aoLetters）），然后
Exit（false）;
结尾；
结尾；
开始
btnOK.Enabled：= IsValidStr;
结尾；
类函数TMultiInputBox.TextInputBox（AOwner：TCustomForm; const ATitle，
AText：string; var Value：string; ACharCase：TEditCharCase = ecNormal;
AAllowEmptyString：boolean = true; AAllowOnly：TAllowOnlyOptions = []）：布尔值；
开始
FTitle：= ATitle;
FText：= AText;
FAllowEmptyString：= AAllowEmptyString;
FAllowOnly：= AAllowOnly;
frm：= TForm.Create（AOwner）;
尝试
SetupDialog；
edt.Text：=值;
edt.CharCase：= ACharCase;
edt.OnChange：= ValidateStrInput;
ValidateStrInput（nil）;
结果：= frm.ShowModal = mrOK;
如果结果则为value：= edt.Text;
最终
frm。免费；
结尾；
结尾；
类过程TMultiInputBox.ValidateIntInput（Sender：TObject）;
var
n：整数；
开始
btnOK.Enabled：= TryStrToInt（edt.Text，n）和InRange（n，FMin，FMax）;
结尾；
类过程TMultiInputBox.ValidateRealInput（Sender：TObject）;
var
x：双;
开始
btnOK.Enabled：= TryStrToFloat（edt.Text，x）和InRange（x，FFloatMin，FFloatMax）;
结尾；
类函数TMultiInputBox.CharInputBox（AOwner：TCustomForm; const ATitle，
AText：string; var Value：char; ACharCase：TEditCharCase;
AAllowOnly：TAllowOnlyOptions）：布尔值;
开始
FTitle：= ATitle;
FText：= AText;
FAllowEmptyString：=假;
FAllowOnly：= AAllowOnly;
frm：= TForm.Create（AOwner）;
尝试
SetupDialog；
edt.Text：=值;
edt.CharCase：= ACharCase;
edt.OnChange：= ValidateStrInput;
edt.MaxLength：= 1;
ValidateStrInput（nil）;
结果：= frm.ShowModal = mrOK;
如果结果为真，则值：= edt.Text [1];
最终
frm。免费；
结尾；
结尾；
类函数TMultiInputBox.FloatInputBox（AOwner：TCustomForm; const ATitle，
AText：string; var Value：real; AMin，AMax：real）：boolean;
开始
FFloatMin：= AMin;
FFloatMax：= AMax;
FTitle：= ATitle;
FText：= AText;
frm：= TForm.Create（AOwner）;
尝试
SetupDialog；
edt.Text：= FloatToStr（Value）;
edt.OnChange：= ValidateRealInput;
ValidateRealInput（nil）;
结果：= frm.ShowModal = mrOK;
如果结果为真，则值：= StrToFloat（edt.Text）;
最终
frm。免费；
结尾；
结尾；
类过程TMultiInputBox.FormActivate（Sender：TObject）;
var
b：布尔值；
如果SystemParametersInfo（SPI_GETSNAPTODEFBUTTON，0，@b，0）和b然后
用btnOK做
用ClientToScreen（Point（Width div 2，Height div 2））做
SetCursorPos（x，y）;
frm.OnActivate：=无;
结尾；
类函数TMultiInputBox.NumInputBox（AOwner：TCustomForm; const ATitle，
AText：string; var Value：integer; AMin：integer = -MaxInt + 1;
AMax：integer = MaxInt）：布尔值；
const
UDM_SETPOS32 = WM_USER + 113;
var
ICCX：TInitCommonControlsEx;
开始
FMin：= AMin;
FMax：= AMax;
FTitle：= ATitle;
FText：= AText;
frm：= TForm.Create（AOwner）;
尝试
SetupDialog；
ICCX.dwSize：= sizeof（ICCX）;
ICCX.dwICC：= ICC_UPDOWN_CLASS;
InitCommonControlsEx（ICCX）;
spin：= CreateWindowEx（0，PChar（UPDOWN_CLASS），nil，
WS_CHILDWINDOW或WS_VISIBLE或UDS_NOTHOUSANDS或UDS_SETBUDDYINT或
UDS_ALIGNRIGHT或UDS_ARROWKEYS或UDS_HOTTRACK，0，0，0， Handle，
0，HInstance，nil）;
SendMessage（spin，UDM_SETRANGE32，FMin，FMax）;
SendMessage（spin，UDM_SETPOS32，0，Value）;
SendMessage（spin，UDM_SETBUDDY，edt.Handle，0）;
如果FMin> = 0，则
edt.NumbersOnly：= true;
edt.Text：= IntToStr（value）;
edt.OnChange：= ValidateIntInput;
ValidateIntInput（nil）;
结果：= frm.ShowModal = mrOK;
如果结果为value：= StrToInt（edt.Text）;
最终
frm。免费；
结尾；
结尾；
结尾。
完整的文档（和源代码）始终位于 https://specials.rejbrand.se/dev/classes/multiinput/readme.html 。
Using Delphi 7, is there anyway to force inputbox to allow only numbers entry from 0 to 100 ?
Thanks!
解决方案
You could easily write your own 'super dialog' like
type
TMultiInputBox = class
strict private
class var
frm: TForm;
lbl: TLabel;
edt: TEdit;
btnOK,
btnCancel: TButton;
shp: TShape;
FMin, FMax: integer;
FTitle, FText: string;
class procedure SetupDialog;
class procedure ValidateInput(Sender: TObject);
public
class function TextInputBox(AOwner: TCustomForm; const ATitle,
AText: string; var Value: string): boolean;
class function NumInputBox(AOwner: TCustomForm; const ATitle,
AText: string; AMin, AMax: integer; var Value: integer): boolean;
end;
class procedure TMultiInputBox.SetupDialog;
begin
frm.Caption := FTitle;
frm.Width := 512;
frm.Position := poOwnerFormCenter;
frm.BorderStyle := bsDialog;
lbl := TLabel.Create(frm);
lbl.Parent := frm;
lbl.Left := 8;
lbl.Top := 8;
lbl.Width := frm.ClientWidth - 16;
lbl.Caption := FText;
edt := TEdit.Create(frm);
edt.Parent := frm;
edt.Top := lbl.Top + lbl.Height + 8;
edt.Left := 8;
edt.Width := frm.ClientWidth - 16;
btnOK := TButton.Create(frm);
btnOK.Parent := frm;
btnOK.Default := true;
btnOK.Caption := 'OK';
btnOK.ModalResult := mrOk;
btnCancel := TButton.Create(frm);
btnCancel.Parent := frm;
btnCancel.Cancel := true;
btnCancel.Caption := 'Cancel';
btnCancel.ModalResult := mrCancel;
btnCancel.Top := edt.Top + edt.Height + 16;
btnCancel.Left := frm.ClientWidth - btnCancel.Width - 8;
btnOK.Top := btnCancel.Top;
btnOK.Left := btnCancel.Left - btnOK.Width - 4;
frm.ClientHeight := btnOK.Top + btnOK.Height + 8;
shp := TShape.Create(frm);
shp.Parent := frm;
shp.Brush.Color := clWhite;
shp.Pen.Style := psClear;
shp.Shape := stRectangle;
shp.Align := alTop;
shp.Height := btnOK.Top - 8;
shp.SendToBack;
end;
class function TMultiInputBox.TextInputBox(AOwner: TCustomForm; const ATitle,
AText: string; var Value: string): boolean;
begin
FTitle := ATitle;
FText := AText;
frm := TForm.Create(AOwner);
try
SetupDialog;
edt.NumbersOnly := false;
edt.Text := Value;
result := frm.ShowModal = mrOK;
if result then Value := edt.Text;
finally
frm.Free;
end;
end;
class procedure TMultiInputBox.ValidateInput(Sender: TObject);
var
n: integer;
begin
btnOK.Enabled := TryStrToInt(edt.Text, n) and InRange(n, FMin, FMax);
end;
class function TMultiInputBox.NumInputBox(AOwner: TCustomForm; const ATitle,
AText: string; AMin, AMax: integer; var Value: integer): boolean;
begin
FMin := AMin;
FMax := AMax;
FTitle := ATitle;
FText := AText;
frm := TForm.Create(AOwner);
try
SetupDialog;
edt.NumbersOnly := true;
edt.Text := IntToStr(value);
edt.OnChange := ValidateInput;
result := frm.ShowModal = mrOK;
if result then Value := StrToInt(edt.Text);
finally
frm.Free;
end;
end;
This dialog allows both text and integer input:
v := 55;
if TMultiInputBox.NumInputBox(Self, 'This is the title', 'Enter a number between 1 and 100:', 1, 100, v) then
ShowMessage(IntToStr(v));
or
s := 'Test';
if TMultiInputBox.TextInputBox(Self, 'This is the title', 'Enter some text:', s) then
ShowMessage(s);
Update
A commenter remarked that class procedures (etc.) had not been introduced yet as of Delphi 7. If this is the case (I don't really remember...), simply remove all this syntactic sugar:
var
frm: TForm;
lbl: TLabel;
edt: TEdit;
btnOK,
btnCancel: TButton;
shp: TShape;
FMin, FMax: integer;
FTitle, FText: string;
procedure SetupDialog;
begin
frm.Caption := FTitle;
frm.Width := 512;
frm.Position := poOwnerFormCenter;
frm.BorderStyle := bsDialog;
lbl := TLabel.Create(frm);
lbl.Parent := frm;
lbl.Left := 8;
lbl.Top := 8;
lbl.Width := frm.ClientWidth - 16;
lbl.Caption := FText;
edt := TEdit.Create(frm);
edt.Parent := frm;
edt.Top := lbl.Top + lbl.Height + 8;
edt.Left := 8;
edt.Width := frm.ClientWidth - 16;
btnOK := TButton.Create(frm);
btnOK.Parent := frm;
btnOK.Default := true;
btnOK.Caption := 'OK';
btnOK.ModalResult := mrOk;
btnCancel := TButton.Create(frm);
btnCancel.Parent := frm;
btnCancel.Cancel := true;
btnCancel.Caption := 'Cancel';
btnCancel.ModalResult := mrCancel;
btnCancel.Top := edt.Top + edt.Height + 16;
btnCancel.Left := frm.ClientWidth - btnCancel.Width - 8;
btnOK.Top := btnCancel.Top;
btnOK.Left := btnCancel.Left - btnOK.Width - 4;
frm.ClientHeight := btnOK.Top + btnOK.Height + 8;
shp := TShape.Create(frm);
shp.Parent := frm;
shp.Brush.Color := clWhite;
shp.Pen.Style := psClear;
shp.Shape := stRectangle;
shp.Align := alTop;
shp.Height := btnOK.Top - 8;
shp.SendToBack;
end;
function TextInputBox(AOwner: TCustomForm; const ATitle,
AText: string; var Value: string): boolean;
begin
FTitle := ATitle;
FText := AText;
frm := TForm.Create(AOwner);
try
SetupDialog;
edt.NumbersOnly := false;
edt.Text := Value;
result := frm.ShowModal = mrOK;
if result then Value := edt.Text;
finally
frm.Free;
end;
end;
type
TInputValidator = class
procedure ValidateInput(Sender: TObject);
end;
procedure TInputValidator.ValidateInput(Sender: TObject);
var
n: integer;
begin
btnOK.Enabled := TryStrToInt(edt.Text, n) and InRange(n, FMin, FMax);
end;
function NumInputBox(AOwner: TCustomForm; const ATitle,
AText: string; AMin, AMax: integer; var Value: integer): boolean;
var
iv: TInputValidator;
begin
FMin := AMin;
FMax := AMax;
FTitle := ATitle;
FText := AText;
frm := TForm.Create(AOwner);
try
SetupDialog;
edt.Text := IntToStr(value);
iv := TInputValidator.Create;
try
edt.OnChange := iv.ValidateInput;
result := frm.ShowModal = mrOK;
if result then Value := StrToInt(edt.Text);
finally
iv.Free;
end;
finally
frm.Free;
end;
end;
Update 2
I have written a new and much nicer version of the dialog. It now looks exactly like a Task Dialog (I followed Microsoft's guidelines in detail), and it offers many options to transform (e.g., to upper or lower case) and verify (many options) the input. It also adds an Up Down control in case of integer input (need not be natural numbers for that one).
Source code:
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 }
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 (TCharacter.IsLetter(S[i]) 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: boolean;
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.
Full documentation (and source code) will always be found at https://specials.rejbrand.se/dev/classes/multiinput/readme.html.
这篇关于Delphi 7-仅将InputBox强制为整数？的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
查看全文
