I am programming a program where you have to enter a password into a InputBox to gain access to the programs min features . But I have a problem if you click on cancel on the inputbox my program gives a error message . So i wanted to know if any one know how I can get that right because with the Messagedlg I know you use IF . But how can I get it right with a InputBox ?
InputBox() returns a blank string if the dialog is canceled, eg:
var
Pass: String;
Pass := InputBox('Password needed', 'Enter the password:');
if Pass <> '' then
begin
// use Pass as needed...
end;
Alternatively, use InputQuery() instead, which returns a Boolean to indicate whether the dialog was canceled or not, eg:
var
Pass: String;
if InputQuery('Password needed', 'Enter the password:', Pass) then
begin
// use Pass as needed...
end;
Many times it is better to have a custom InputQuery
function InputValor(const aCaption: String; APrompt: string; var aValor:
String): Boolean;
var
vForm : TForm;
vLabel : TLabel;
vBtnOk : TBitBtn;
vValor : TEdit;
vBtnCancel : TBitBtn;
begin
Result := False;
vForm := TForm.Create(Application);
vLabel := TLabel.Create(vForm);
vValor := TEdit.Create(vForm);
vBtnOk := TBitBtn.Create(vForm);
vBtnCancel := TBitBtn.Create(vForm);
with vForm do
begin
Name := 'frmValor';
Position := poScreenCenter;
BorderIcons := [biSystemMenu];
BorderStyle := bsDialog;
Caption := aCaption;
ClientHeight := 150;
ClientWidth := 515;
Color := clBtnFace;
OldCreateOrder := False;
Font.Charset := DEFAULT_CHARSET;
Font.Color := clWindowText;
Font.Height := -11;
Font.Name := 'Tahoma';
Font.Style := [];
OldCreateOrder := False;
PixelsPerInch := 96;
Left := 0;
Top := 0;
end;
with vLabel do
begin
Name := 'vLabel';
Parent := vForm;
AutoSize := False;
Left := 18;
Top := 15;
Width := 484;
Height := 41;
Caption := APrompt;
WordWrap := True;
end;
with vValor do
begin
Name := 'vValorEdit';
Parent := vForm;
Left := 18;
Top := 62;
Width := 484;
Height := 21;
Text := '';
end;
with vBtnOk do
begin
Name := 'vBtnOk';
Parent := vForm;
Caption := 'Aceptar';
Left := 335;
Top := 103;
Width := 75;
Height := 25;
TabOrder := 1;
ModalResult := mrOk;
end;
with vBtnCancel do
begin
Name := 'vBtnCancel';
Parent := vForm;
Caption := 'Cancelar';
Left := 427;
Top := 103;
Width := 75;
Height := 25;
TabOrder := 2;
ModalResult := mrCancel;
end;
vForm.ShowModal;
if (vForm.ModalResult = mrOk) and (vValor.Text <> '') then
begin
Result := True;
aValor := vValor.Text;
end else
begin
Result := False;
aValor := '';
end;
FreeAndNil(vForm);
end;
Use in the same way as the Official:
var
vTest : String;
begin
if (InputValor('Title', 'Label text', vTest) = True) then
ShowMessage(vTest);
end;
Related
When I create objects at runtime in FireMonkey, some lines are shown on the sides of the objects.
The image below is a TLayout. When I resize the Form or move the mouse, the lines disappear. This happens with TImage, TRectangle, TLayout, and other components.
Can someone give me a solution for this graphic problem?
TLayout showing the lines:
TLayout after resizing the Form:
var
backRectangle: TRectangle;
category, title: TLabel;
icon: TImage;
bar: TRectangle;
background: TGridPanelLayout;
lay1, layicon: TLayout;
begin
backRectangle := TRectangle.Create(Self);
with backRectangle do
begin
Height := 150;
Align := TAlignLayout.top;
Fill.Color := Talphacolors.White;
Parent := Self;
Stroke.Thickness := 0;
Margins.Left := 20;
Margins.Top := 20;
Name := 'rectangle';
end;
background := TGridPanelLayout.Create(backRectangle);
with background do
begin
Parent := backRectangle;
Align := TAlignLayout.Client;
ColumnCollection.ClearAndResetID;
ColumnCollection.BeginUpdate;
with ColumnCollection.Add do
begin
Value := 100;
SizeStyle := TGridPanelLayout.TSizeStyle.Percent;
end;
ColumnCollection.EndUpdate;
RowCollection.Clear;
end;
lay1 := TLayout.Create(backRectangle);
lay1.Parent := backRectangle;
lay1.Align := TAlignLayout.client;
background.AddObject(lay1);
layicon := TLayout.Create(lay1);
layicon.Parent := lay1;
layicon.Align := TAlignLayout.client;
category := TLabel.Create(backRectangle);
with category do
begin
StyledSettings := [];
AutoSize := true;
Parent := lay1;
Align := TAlignLayout.None;
BeginUpdate;
TextSettings.BeginUpdate;
TextSettings.Font.Family := 'Roboto';
TextSettings.Font.Style := [TFontStyle.fsBold];
TextSettings.Font.Size := 16;
Text := 'category';
TextSettings.EndUpdate;
Margins.Left := 25;
Margins.Right := 0;
Margins.Bottom := 6;
Margins.Top:= 10;
TabOrder := 0;
end;
bar := TRectangle.Create(backRectangle);
bar.Width := 100;
bar.Height := 3;
bar.Fill.Color := $FF518CD2;
bar.Parent := lay1;
bar.Align := TAlignLayout.None;
bar.Stroke.Thickness := 0;
bar.Margins.Right := 20;
icon := timage.Create(layicon);
with icon do
begin
Parent := lay1;
Width := 30;
Margins.Left := 20;
Margins.Right := 20;
Margins.Bottom := 15;
Margins.Top := 45;
WrapMode := TImageWrapMode.fit;
Align := TAlignLayout.FitLeft;
try
Bitmap.LoadFromFile('icon');
except
end;
end;
title := TLabel.Create(layicon);
with title do
begin
StyledSettings := [];
Parent := lay1;
Text := '';
Align := TAlignLayout.Client;
TextSettings.Font.Family := 'Roboto';
TextSettings.Font.Style := [];
TextSettings.Font.Size := 16;
Margins.Left := 10;
TextSettings.VertAlign := TTextAlign.Center;
end;
bar.Align := TAlignLayout.Top;
category.Align := TAlignLayout.Top;
end;
If I create multiple TPanel and TSplitter components at runtime into a TScrollBox, the order of the components is wrong. If I call drawInput() 3 times, the scrollbox contains 3 panels followed by 3 splitters instead of 1 panel followed by 1 splitter (repeated).
How can I force the correct order?
Here is a screenshot
function drawInput(owner: TWinControl): TWinControl;
var
panel: TPanel;
edit: TEdit;
splitter: TSplitter;
begin
panel := TPanel.Create(owner);
panel.Parent := owner;
panel.Align := alTop;
panel.AlignWithMargins := True;
panel.BorderWidth := 0;
panel.Color := clRed;
panel.BorderStyle := bsNone;
panel.ParentBackground := False;
panel.Ctl3D := False;
edit := TEdit.Create(panel);
edit.Parent := panel;
edit.Align := alTop;
edit.AlignWithMargins := True;
edit.Text := 'foo';
edit.Margins.Left := 5;
edit.Margins.top := 5;
edit.Margins.Bottom := 5;
edit.Margins.Right := 5;
splitter := TSplitter.Create(owner);
splitter.Parent := owner;
splitter.Align := alTop;
splitter.Beveled := True;
splitter.Height := 3;
end;
EDIT:
Here is how I call this function:
procedure TForm2.Button1Click(Sender: TObject);
var
form: TForm;
sb: TScrollBox;
begin
form := TForm.Create(Application);
sb := TScrollBox.Create(form);
sb.Parent := form;
sb.Align := alClient;
sb.Color := clBlack;
drawInput(sb);
drawInput(sb);
drawInput(sb);
drawInput(sb);
form.Width := 300;
form.Height := 700;
form.ShowModal;
end;
Position your panel + splitter then set the alignment
You can position you panel below all other components by aligning it to the client
function drawInput(owner: TWinControl): TWinControl;
var
panel: TPanel;
edit: TEdit;
splitter: TSplitter;
begin
panel := TPanel.Create(owner);
panel.Parent := owner;
///
panel.Align := alclient;
///
panel.Align := alTop;
panel.AlignWithMargins := True;
panel.BorderWidth := 0;
panel.Color := clRed;
panel.BorderStyle := bsNone;
panel.ParentBackground := False;
panel.Ctl3D := False;
splitter := TSplitter.Create(owner);
splitter.Parent := owner;
//
splitter.top := panel.top+panel.height;
//
splitter.Align := alTop;
splitter.Beveled := True;
splitter.Height := 3;
end;
Delphi's alignment logic can be hard at times. But the following works. Note the line splitter.Top := -1;
function drawInput(owner: TWinControl): TWinControl;
var
panel: TPanel;
edit: TEdit;
splitter: TSplitter;
begin
splitter := TSplitter.Create(owner);
splitter.Parent := owner;
splitter.Align := alTop;
splitter.Beveled := True;
splitter.Height := 3;
splitter.Top := -1;
panel := TPanel.Create(owner);
panel.Parent := owner;
panel.Align := alTop;
panel.AlignWithMargins := True;
panel.BorderWidth := 0;
panel.Color := clRed;
panel.BorderStyle := bsNone;
panel.ParentBackground := False;
panel.Ctl3D := False;
edit := TEdit.Create(panel);
edit.Parent := panel;
edit.Align := alTop;
edit.AlignWithMargins := True;
edit.Text := 'foo';
edit.Margins.Left := 5;
edit.Margins.top := 5;
edit.Margins.Bottom := 5;
edit.Margins.Right := 5;
end;
Here's the code that works for me on XE5. I still have to solve my problem but at least I fixed yours :)
procedure drawInput(owner: TWinControl; var t: integer);
var
panel: TPanel;
edit: TEdit;
splitter: TSplitter;
begin
panel := TPanel.Create(owner);
panel.Parent := owner;
panel.Align := alTop;
panel.AlignWithMargins := True;
panel.BorderWidth := 0;
panel.Color := clRed;
panel.BorderStyle := bsNone;
panel.ParentBackground := False;
panel.Ctl3D := False;
panel.Top := t;
t := panel.Top + panel.Height + 1;
edit := TEdit.Create(panel);
edit.Parent := panel;
edit.Align := alTop;
edit.AlignWithMargins := True;
edit.Text := 'foo';
edit.Margins.Left := 5;
edit.Margins.top := 5;
edit.Margins.Bottom := 5;
edit.Margins.Right := 5;
splitter := TSplitter.Create(owner);
splitter.Parent := owner;
splitter.Align := alTop;
splitter.Beveled := True;
splitter.Height := 3;
splitter.Top := t;
t := splitter.Top + splitter.Height + 1;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
form: TForm;
sb: TScrollBox;
t: integer;
begin
form := TForm.Create(Application);
sb := TScrollBox.Create(form);
sb.Parent := form;
sb.Align := alClient;
sb.Color := clBlack;
t := 0;
drawInput(sb, t);
drawInput(sb, t);
drawInput(sb, t);
drawInput(sb, t);
form.Width := 300;
form.Height := 700;
form.ShowModal;
end;
In one of my applications, I have a function that creates a TImage and follows it with a TSplitter with the parent and containing control being a TScrollbox (sbScroller). The function is either called by the end user (tied to a TButton OnClick event) when they select an image or when the program starts it loads a previously loaded set of images each divided by a TSplitter.
It works when run alone by itself (creating one TImage + TSplitter pairing) or when run in a continuous loop to create multiple pairings. The key element in getting it to work seems to the positioning of the TSplitter.Top property as the previous answer says:
procedure AddImage(AFilename: string);
var
Image: TImage;
begin
Image := TImage.Create(sbScroller);
with Image do
begin
Image.Parent := sbScroller;
Left := 0;
Top := 0;
Width := 150;
Height := 150;
Constraints.MinHeight := 128;
Align := alTop;
Anchors := [akLeft, akTop, akRight];
Proportional := True;
Stretch := True;
Visible := True;
end;
if sbScroller.ControlCount > 0 then
with TSplitter.Create(sbScroller) do
begin
Parent := sbScroller;
Top := Image.Top;
Align := alTop;
Color := clGray;
end;
end;
So I creat some TEdit components like this
var
lb : TLabel;
topLabel, i: Integer;
dbedit : TEdit;
begin
inherited;
topLabel := 40;
i := 0;
lb := TLabel.Create(nil);
lb.Parent := GroupBox2;
lb.Left := 245;
lb.Top := 20;
lb.Caption := 'ASD';
with DataModule.myStoredProc do begin
Close;
ParamByName('#Param1').AsInteger := 1;
ExecProc;
Open;
SetLength(nrPozitiiDinctionar,RecordCount);
First;
while not Eof do begin
lb := TLabel.Create(nil);
lb.Parent := GroupBox2;
lb.Left := 7;
lb.Top := topLabel ;
lb.Caption := FieldByName('X').AsString;
dbedit := TEdit.Create(nil);
dbedit.Name := 'Edit'+IntToStr(FieldByName('Poz').AsInteger);
dbedit.Text := '';
dbedit.Parent := GroupBox2;
dbedit.Height := 21;
dbedit.Width := 40;
dbedit.Left := 240;
dbedit.Top := lb.Top-3 ;
topLabel := topLabel + 30;
nrPozitiiDinctionar[i] := FieldByName('Poz').AsInteger;
i := i + 1;
Next;
end;
end;
end;
Then after the user add his input I run a function with this code
var
IDPoz, I : Integer;
dbedit : TEdit;
pctj,nume : string;
begin
for I := Low(nrPozitiiDinctionar) to High(nrPozitiiDinctionar) do
begin
nume := 'Edit'+IntToStr(nrPozitiiDinctionar[i]);
pctj := TEdit(FindComponent('Edit'+IntToStr(nrPozitiiDinctionar[i]))).Text;
with DateCOFurnizori.spCOFCmzFurnizoriEvaluarePozitii_Edit do begin
ParamByName('#IDEvaluare').AsInteger := StrToInt(Edit1.Text);
ParamByName('#IDPozitie').AsInteger := IDPoz;
ParamByName('#DictionarID').AsInteger := 9103;
ParamByName('#DictionarPozitiiID').AsInteger := nrPozitiiDinctionar[i];
ParamByName('#Punctaj').AsFloat := 1 ;//StrToFloat(pctj) ;
ParamByName('#DataEvaluare').AsDateTime := Now;
ExecProc;
IDPoz := IDPoz + 1;
end;
end;
This is only a portion of the code but this should relate to my problem.
When I use the debugger there is no value in pctj, what am I doing wrong? I try to get the value of the TEdits based on their names. What am I doing wrong with the FindComponent function?
You are not assigning an Owner to the TEdit controls, so that is why FindComponent() cannot find them. Either assign Self as the Owner (since you are calling Self.FindComponent()), or else store the TEdit pointers in a TList or TObjectList that you can loop through when needed.
I have a problem according to run-time creation of edit components in Delphi 7.
So when I create TEdit components after the program ran for "some" time it perfectly works.
However, when I create TEdit elements at the Forms OnCreate event, they have a wrong height.
Furthermore the (almost) simultaneously created Shapes have the right height.
Edit:
procedure TTPLVisorForm.CreateZeichen(ZShape : TShape; ZEdit : TEdit; VLeft : integer);
begin
with ZShape do
begin
Width := 50;
Height := 50;
Left := VLeft;
Top := 25;
Shape := stRectangle;
Parent := self.Band;
SendToBack();
end;
with ZEdit do
begin
Text := '#';
Left := VLeft+1;
Top := 26;
Parent := self.Band;
Font.Height := 48;
Width := 48;
Height := 48;
SendToBack;
end;
end;
Getting called by:
procedure TZeichen.Anzeigen(Form : TObject; Left : integer);
begin
self.Form := Form;
self.ZShape := TShape.Create(TTPLVisorForm(self.Form).Band);
self.ZEdit := TEdit.Create(TTPLVisorForm(self.Form).Band);
TTPLVisorForm(Form).CreateZeichen(self.ZShape, self.ZEdit, Left);
end;
Getting called by:
procedure TMagnetband.ErweitereRechts;
var
Zeichen : TZeichenKette;
begin
Zeichen := TZeichenKette.Create;
self.LetztesZeichen.Naechstes := TZeichenKette(Zeichen);
Zeichen.Vorheriges := self.LetztesZeichen;
Zeichen.Zeichen.Anzeigen(self.Form,
self.LetztesZeichen.Zeichen.ZShape.Left +
self.LetztesZeichen.Zeichen.ZShape.Width +
self.Padding);
self.LetztesZeichen := Zeichen;
self.Laenge := self.Laenge+1;
end;
Getting again called by:
procedure TTuringmaschine.ZeichenAnfuegen;
begin
self.Magnetband.ErweitereRechts;
end;
Getting called by:
procedure TTuringmaschine.PanelResize(Sender: TObject);
begin
while self.Magnetband.GetRechtsMax < self.Panel.Width do
self.ZeichenAnfuegen;
end;
Finally gets called by:
Constructor TTuringmaschine.Create(Form : TObject);
var
Breite : integer;
begin
self.Zustand := 0;
self.Form := TTPLVisorForm(Form);
self.Panel := TTPLVisorForm(self.Form).Band;
self.Magnetband := TMagnetband.Create(self.Form);
TTPLVisorForm(Form).Band.OnResize := self.PanelResize;
self.PanelResize(Nil);
//self.CreateMagnetkopf;
end;
And the Constructor is either called at the OnCreate event or on another event.
There's a margin around the text in TEdit control, so if you set the Font.Height to 48, the height of the control won't be exactly 48 if the control has the AutoSize property set to True. I would personally decrease height of the font, and for being sure turn the AutoSize off. Your CreateZeichen method would then look like this:
procedure TTPLVisorForm.CreateZeichen(ZShape: TShape; ZEdit: TEdit;
VLeft: Integer);
begin
with ZShape do
begin
Width := 50;
Height := 50;
Left := VLeft;
Top := 25;
Shape := stRectangle;
Parent := Self.Band;
SendToBack;
end;
with ZEdit do
begin
AutoSize := False;
Text := '#';
Left := VLeft + 1;
Top := 26;
Parent := Self.Band;
Font.Height := 40;
Width := 48;
Height := 48;
SendToBack;
end;
end;
I want to create a warning dialog box which asks the users if the information typed during signup was correct, and asks him wether he want to continue or close that dialog and correct his information.
var
td: TTaskDialog;
tb: TTaskDialogBaseButtonItem;
begin
td := TTaskDialog.Create(nil);
try
td.Caption := 'Warning';
td.Text := 'Continue or Close?';
td.MainIcon := tdiWarning;
td.CommonButtons := [];
tb := td.Buttons.Add;
tb.Caption := 'Continue';
tb.ModalResult := 100;
tb := td.Buttons.Add;
tb.Caption := 'Close';
tb.ModalResult := 101;
td.Execute;
if td.ModalResult = 100 then
ShowMessage('Continue')
else if td.ModalResult = 101 then
ShowMessage('Close');
finally
td.Free;
end;
end;
Note: This will only work on Windows Vista or later.
if delphi then
if mrYes=MessageDlg('Continue?',mtwarning,[mbYes, mbNo],0) then
begin
//do somthing
end
else
exit; //go out
var
AMsgDialog: TForm;
abutton: TButton;
bbutton: TButton;
begin
AMsgDialog := CreateMessageDialog('This is a test message.', mtWarning,[]);
abutton := TButton.Create(AMsgDialog);
bbutton := TButton.Create(AMsgDialog);
with AMsgDialog do
try
Caption := 'Dialog Title' ;
Height := 140;
AMsgDialog.Width := 260 ;
with abutton do
begin
Parent := AMsgDialog;
Caption := 'Continue';
Top := 67;
Left := 60;
// OnClick :tnotyfievent ;
end;
with bbutton do
begin
Parent := AMsgDialog;
Caption := 'Close';
Top := 67;
Left := 140;
//OnClick :tnotyfievent ;
end;
ShowModal ;
finally
abutton.Free;
bbutton.Free;
Free;
end;
Based on this:
procedure HookResourceString(rs: PResStringRec; newStr: PChar);
var
oldprotect: DWORD;
begin
VirtualProtect(rs, SizeOf(rs^), PAGE_EXECUTE_READWRITE, #oldProtect);
rs^.Identifier := Integer(newStr);
VirtualProtect(rs, SizeOf(rs^), oldProtect, #oldProtect);
end;
const
SContinue = 'Continue';
SClose = 'Close';
procedure TForm1.Button1Click(Sender: TObject);
begin
HookResourceString(#SMsgDlgOK, SContinue);
HookResourceString(#SMsgDlgCancel, SClose);
if MessageDlg('My Message', mtConfirmation, [mbOK, mbCancel], 0) = mrOK then
begin
// OK...
end;
end;