Basta ya de indagar por otras páginas ya que estás al espacio indicado, tenemos la solución que necesitas encontrar sin problemas.
Solución:
Podrías escribir fácilmente tu propio ‘super diálogo’ como
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;
Este cuadro de diálogo permite la entrada de texto y números enteros:
v := 55;
if TMultiInputBox.NumInputBox(Self, 'This is the title', 'Enter a number between 1 and 100:', 1, 100, v) then
ShowMessage(IntToStr(v));
o
s := 'Test';
if TMultiInputBox.TextInputBox(Self, 'This is the title', 'Enter some text:', s) then
ShowMessage(s);
Actualizar
Un comentarista comentó que los procedimientos de clase (etc.) aún no se habían introducido en Delphi 7. Si este es el caso (realmente no recuerdo …), simplemente elimine todo este azúcar sintáctico:
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;
Actualización 2
He escrito una versión nueva y mucho mejor del diálogo. Ahora se ve exactamente como un cuadro de diálogo de tareas (seguí las pautas de Microsoft en detalle) y ofrece muchas opciones para transformar (por ejemplo, a mayúsculas o minúsculas) y verificar (muchas opciones) la entrada. También agrega un control Up Down en caso de entrada de números enteros (no es necesario que sean números naturales para ese).
Código fuente:
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.
La documentación completa (y el código fuente) siempre se encontrará en https://specials.rejbrand.se/dev/classes/multiinput/readme.html.
Puede permitir que el usuario ingrese solo números en el cuadro de entrada, lo que se agrega al estilo de la TEdit dentro de la caja de entrada el ES_NUMBER valor.
revisa esta muestra.
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, 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, 0, '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;
Nota : lamentablemente este método no permite validar el rango de los números.
Puede usar InputQuery de la unidad QDialogs, que tiene una versión sobrecargada con parámetros Min y Max para limitar el rango de entrada Integer. Algo como esto:
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, 0, 100) then ShowMessage('Entered: '+IntToStr(i));
end;
No olvide agregar QDialogs al usos cláusula, de lo contrario no se encontrará esta versión de la función.
PERO este diálogo no evitará que el usuario ingrese un valor que está fuera de los límites; lo “recortará” silenciosamente hasta el límite más cercano. Por ejemplo, si el usuario ingresa -20, la variable “i” se establecerá en 0. Y si ingresa 200, “i” se establecerá en 100. No estoy seguro de si esa funcionalidad sería adecuada para todos, pero es una manera de lograrlo sin escribir ningún código personalizado. Espero que esto ayude.
Puntuaciones y reseñas
¡Haz clic para puntuar esta entrada!
(Votos: 0 Promedio: 0)