mirror of
http://gitlab.expertsoft.com.ua/git/expertcad
synced 2026-01-11 17:25:39 +02:00
162 lines
4.0 KiB
ObjectPascal
162 lines
4.0 KiB
ObjectPascal
unit InputForm;
|
|
|
|
interface
|
|
|
|
uses
|
|
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
|
|
StdCtrls, Buttons;
|
|
|
|
type
|
|
TNumFormat = (nfInteger,nfDouble,nfString);
|
|
TfrmInput = class(TForm)
|
|
lbPrompt: TLabel;
|
|
Edit1: TEdit;
|
|
BitBtn1: TBitBtn;
|
|
BitBtn2: TBitBtn;
|
|
procedure BitBtn2Click(Sender: TObject);
|
|
procedure BitBtn1Click(Sender: TObject);
|
|
procedure Edit1KeyPress(Sender: TObject; var Key: Char);
|
|
private
|
|
{ Private declarations }
|
|
Format: TNumFormat;
|
|
public
|
|
{ Public declarations }
|
|
Function InputInteger(xCaption,xPrompt:String; var xValue:Integer):Boolean;
|
|
Function InputDouble(xCaption,xPrompt:String; var xValue:Double):Boolean;
|
|
Function InputString(xCaption,xPrompt:String; var xValue:String):Boolean;
|
|
Procedure SetAsEdit(px,py:Integer);
|
|
end;
|
|
|
|
var
|
|
frmInput: TfrmInput;
|
|
|
|
implementation
|
|
|
|
{$R *.DFM}
|
|
|
|
|
|
{ TfrmInput }
|
|
|
|
Function MakeFloat(str:String;def:Extended):Extended;
|
|
begin
|
|
if not TextToFloat(PChar(str), result, fvExtended) then result := def;
|
|
end;
|
|
|
|
function TfrmInput.InputDouble(xCaption, xPrompt: String;
|
|
var xValue: Double): Boolean;
|
|
var i: Integer;
|
|
sep: Char;
|
|
xstr: String;
|
|
begin
|
|
Result := False;
|
|
Format := nfDouble;
|
|
Caption := xCaption;
|
|
lbPrompt.Caption := xPrompt;
|
|
Edit1.Hint := xPrompt;
|
|
Edit1.Text := floattostrf(xValue,ffFixed,16,3);
|
|
if ShowModal = mrOk then begin
|
|
|
|
result := True;
|
|
sep := DecimalSeparator;
|
|
xstr := '';
|
|
for i := 1 to Length(Edit1.Text) do
|
|
begin
|
|
if (Edit1.Text[i] = ',') or (Edit1.Text[i] = '.')
|
|
then xStr := xstr+sep else
|
|
xstr := xstr+Edit1.Text[i];
|
|
end;
|
|
xValue := MakeFloat(xStr,0);
|
|
end;
|
|
end;
|
|
|
|
function TfrmInput.InputInteger(xCaption, xPrompt: String;
|
|
var xValue: Integer): Boolean;
|
|
begin
|
|
Result := False;
|
|
Format := nfInteger;
|
|
Caption := xCaption;
|
|
lbPrompt.Caption := xPrompt;
|
|
Edit1.Hint := xPrompt;
|
|
Edit1.Text := inttostr(xValue);
|
|
if ShowModal = mrOk then begin
|
|
result := True;
|
|
xValue := StrToIntDef(Edit1.text,0);
|
|
end;
|
|
end;
|
|
|
|
procedure TfrmInput.BitBtn2Click(Sender: TObject);
|
|
begin
|
|
ModalResult := mrCancel;
|
|
end;
|
|
|
|
procedure TfrmInput.BitBtn1Click(Sender: TObject);
|
|
begin
|
|
if Trim(Edit1.text) = '' then
|
|
ModalResult := mrCancel
|
|
else
|
|
ModalResult := mrOk;
|
|
end;
|
|
|
|
procedure TfrmInput.Edit1KeyPress(Sender: TObject; var Key: Char);
|
|
begin
|
|
if Format = nfInteger then
|
|
begin
|
|
if not (((Key >= '0') and (Key <= '9')) or
|
|
(Key = chr(8)) or (key = Chr(13)) or (key = Chr(27)) or (key = '-'))
|
|
then begin
|
|
Key := Chr(0);
|
|
end;
|
|
end else if format = nfDouble then begin
|
|
if (Key = ',') or (Key = '.') then begin
|
|
if Pos(',',Edit1.Text) > 0 then Key := Chr(0);
|
|
if Pos('.',Edit1.Text) > 0 then Key := Chr(0);
|
|
end else if not (((Key >= '0') and (Key <= '9')) or
|
|
(Key = chr(8)) or (key = Chr(13)) or (key = Chr(27)) or (key = '-'))
|
|
then begin
|
|
Key := Chr(0);
|
|
end;
|
|
end;
|
|
if key = Chr(13) then BitBtn1Click(nil);
|
|
if key = Chr(27) then BitBtn2Click(nil);
|
|
end;
|
|
|
|
procedure TfrmInput.SetAsEdit(px, py: Integer);
|
|
begin
|
|
Position := poDesigned;
|
|
if (px < Screen.Width-100) and (px > 0) then Left := px;
|
|
if (py < Screen.Height-100) and (py > 0) then Top := py;
|
|
|
|
BorderStyle := bsNone;
|
|
lbPrompt.Hide;
|
|
BitBtn1.Hide;
|
|
BitBtn2.Hide;
|
|
Edit1.Left := 0;
|
|
Edit1.Top := 0;
|
|
Edit1.Width := 100;
|
|
Edit1.Font.Color := clRed;
|
|
Edit1.Font.Size := 12;
|
|
Edit1.Font.Style := [fsBold];
|
|
Edit1.Ctl3D := False;
|
|
Edit1.ShowHint := True;
|
|
Width := 100;
|
|
Height := 26;
|
|
end;
|
|
|
|
function TfrmInput.InputString(xCaption, xPrompt: String;
|
|
var xValue: String): Boolean;
|
|
begin
|
|
Result := False;
|
|
Format := nfString;
|
|
Caption := xCaption;
|
|
lbPrompt.Caption := xPrompt;
|
|
Edit1.Hint := xPrompt;
|
|
Edit1.Text := (xValue);
|
|
if ShowModal = mrOk then begin
|
|
result := True;
|
|
xValue := (Edit1.text);
|
|
end;
|
|
|
|
end;
|
|
|
|
end.
|