如何解决Delphi 7-强制InputBox只能为整数?
| 使用Delphi 7,是否有强制输入框只允许输入0到100的数字? 谢谢!解决方法
您可以轻松编写自己的“超级对话框”,例如
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,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;
此对话框允许输入文本和整数:
v := 55;
if TMultiInputBox.NumInputBox(Self,\'This is the title\',\'Enter a number between 1 and 100:\',1,100,v) then
ShowMessage(IntToStr(v));
要么
s := \'Test\';
if TMultiInputBox.TextInputBox(Self,\'Enter some text:\',s) then
ShowMessage(s);
更新资料
一位评论者指出,自Delphi 7起,尚未引入类过程(等)。如果是这种情况(我真的不记得了...),只需删除所有以下语法糖:
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,FMax);
end;
function NumInputBox(AOwner: TCustomForm; const ATitle,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;
更新2
我写了一个新的更好的对话框版本。现在,它看起来完全像一个“任务对话框”(我详细遵循了Microsoft的指南),并且它提供了许多转换(例如,转换为大写或小写)和验证(许多选项)输入的选项。在整数输入的情况下(它也可以不是自然数),它还会添加一个Up Down控件。
源代码:
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,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,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,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,@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,frm.Handle,HInstance,nil);
SendMessage(spin,UDM_SETRANGE32,FMax);
SendMessage(spin,UDM_SETPOS32,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.
完整的文档(和源代码)将始终在https://specials.rejbrand.se/dev/classes/multiinput/readme.html上找到。
,您可以只允许用户在输入框中输入数字,并在输入框内的“ 5”样式中添加“ 6”值。
检查此样本。
const
InputBoxNumberMessage = WM_USER + 666;// a custom message
type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
procedure InputBoxSetOnlyNumbers(var Msg: TMessage); message InputBoxNumberMessage;
public
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
var
InputString: string;
begin
PostMessage(Handle,InputBoxNumberMessage,0);
InputString := InputBox(\'Input\',\'Enter a number\',\'\');
ShowMessage(InputString);
end;
procedure TForm1.InputBoxSetOnlyNumbers(var Msg: TMessage);
var
hActiveForm : HWND;
hEdit : HWND;
dwLong : Longint;
begin
hActiveForm := Screen.ActiveForm.Handle;
if (hActiveForm <> 0) then
begin
hEdit := FindWindowEx(hActiveForm,\'TEdit\',nil);//determine the handle of the TEdit
dwLong := GetWindowLong(hEdit,GWL_STYLE);//get the current style of the control
SetWindowLong(hEdit,GWL_STYLE,dwLong or ES_NUMBER)//set the new style
end;
end;
注意:很遗憾,此方法不允许验证数字范围。
,您可以使用来自QDialogs单元的InputQuery,该单元的重载版本带有Min和Max参数,用于限制Integer输入的范围。像这样:
var i:Integer;
begin
i:=0; // Initial value to show the user in the textbox
if InputQuery(\'Dialog Caption\',\'Please enter the number between 0 and 100:\',i,100) then ShowMessage(\'Entered: \'+IntToStr(i));
end;
不要忘记将QDialogs添加到uses子句,否则将找不到此版本的函数。
但是此对话框不会阻止用户输入超出范围的值;它将自动“修剪”到最接近的范围。例如,如果用户输入-20,变量\“ i \”将设置为0。如果用户输入200,则\“ i \”将设置为100。我不确定该功能是否适合大家,但这是无需编写任何自定义代码即可实现的一种方法。希望这可以帮助。
,与D6一起工作。函数TryStrToInt来自SysUtils。
procedure TForm.ButtonClick(Sender: TObject);
var vInt:Integer;
vStr:String;
begin
Repeat
Repeat
vStr:=InputBox(\'Some title\',\'Enter integer betwen 0-100\',\'\');
Until TryStrToInt(vStr,vInt);
Until (vInt>=0) and (vInt<=100);
end;
,不,没有办法做到这一点。您应该编写自己的对话框,以验证对编辑控件的输入。
版权声明:本文内容由互联网用户自发贡献,该文观点与技术仅代表作者本人。本站仅提供信息存储空间服务,不拥有所有权,不承担相关法律责任。如发现本站有涉嫌侵权/违法违规的内容, 请发送邮件至 dio@foxmail.com 举报,一经查实,本站将立刻删除。