I'm doing a form manually, I have what I need but want to control the FormClose event, but can not find information on how to do it, I just want to create the event and FormClose code from the display.
What I have is:
function make_form():bool;
var
frm: TForm;
begin
frm := TForm.Create(nil);
frm.Caption := 'Title';
frm.Width := 500;
frm.Height := 300;
end;
This code is a function in a unit
How can I do this ?
Your functions is useless
Use try..finally when you creating an object.
Start with something like this
type
// Dummy class:
TFrmHandlers = class
// Close handlers:
class procedure FormClose(Sender: TObject; var Action: TCloseAction);
end;
implementation
.....
class procedure TFrmHandlers.FormClose(Sender: TObject; var Action: TCloseAction);
begin
ShowMessage('The form will closed now');
end;
procedure make_form();
var
frm: TForm;
begin
frm := TForm.Create(nil);
try
frm.Caption := 'Title';
frm.Width := 500;
frm.Height := 300;
frm.OnClose := TFrmHandlers.FormClose;
frm.ShowModal;
finally
frm.Free;
end;
end;
You code is not real.
To treat Close event in dynamically created form, you have to assign event handler to event property OnClose:
frm.OnClose := CloseProc;
CloseProc should be a method of some object (for example, of main form) with needed prototype
TFormMain = class(TForm)
...
procedure CloseProc(Sender: TObject; var Action: TCloseAction);
...
implementation
procedure TformMain.CloseProc(Sender: TObject; var Action: TCloseAction);
begin
//use Sender if needed
end;
Related
Before I start I must state that no other stack overflow post on this topic had helped me yet
I have a dynamic button called by btnApply
It is created dynamically on a dynamic form frmSort by a on click event of static button btnSort on static form frmTable
Under the global scope var of frmTable is declared
btnApply: TButton;
Procedure btnApplyClick(Sender:TObject);
//other vars
Under the btnSort on click
//other code
btnApply:= TButton.create(frmSort);
//all its properties
BtnApply.onclick:= btnApplyClick;
//other code
Then later
Procedure btnApplyClick(Sender:TObject);
Begin
//it's code it has to execute
End;
I get an error message at the "BtnApply.onclick:= btnApplyClick;"
Line of incompatible types between method pointer and regular procedure
How do I make this work?
Thanks in advance
Your btnApplyClick needs to be a method of an object. Since the button has to be on a form to be useful anyway, make it a method of the form itself:
type
TfrmSort = class(TForm)
// UI controls listed here
public
procedure btnApplyClick(Sender: TObject);
end;
implementation
procedure TfrmSort.btnApplyClick(Sender: TObject);
begin
(Sender as TButton).Caption := 'You clicked me';
end;
procedure TfrmSort.FormCreate(Sender: TObject);
var
Btn: TButton;
begin
Btn := TButton.Create(Self);
Btn.Parent := Self;
Btn.Top := 100;
Btn.Left := 100;
Btn.OnClick := btnApplyClick;
end;
If for some reason you can't make it a form method (although I can't see how this would be the case for a visual control), you can make it a method of any object, like this:
implementation
// You must use StdCtrls in order to have the types available if
// it's not already in your uses clause
type
TDummyButtonClickObj = class
class procedure ButtonClickHandler(Sender: TObject);
end;
{ TDummyButtonClickObj }
class procedure TDummyButtonClickObj.ButtonClickHandler(Sender: TObject);
begin
(Sender as TButton).Caption := 'You clicked me.';
end;
procedure TForm2.FormCreate(Sender: TObject);
begin
with TButton.Create(Self) do
begin
Parent := Self;
Top := 100;
Left := 100;
Caption := 'Click here';
OnClick := TDummyButtonClickObj.ButtonClickHandler;
end;
end;
As others have stated, the event handler should be a member of a class. That is what the event is expecting. However, it is also possible to use a non-member procedure as the event handler. It just takes a couple of extra steps to set up.
Add an extra explicit parameter to account for the Self pointer:
procedure btnApplyClick(Self: Pointer; Sender: TObject);
Use the TMethod record to assign the procedure to the button:
var
btnApply: TButton;
M: TMethod;
//other vars
Procedure btnApplyClick(Self: Pointer; Sender: TObject);
...
btnApply := TButton.create(frmSort);
//all its properties
M.Code := #btnApplyClick;
M.Data := nil; // can be anything you want passed to the Self parameter
BtnApply.onclick := TNotifyEvent(M);
//other code
...
procedure btnApplyClick(Self: Pointer; Sender: TObject);
Begin
// code to execute
End;
I have this code:
for LSidebarButton in SidebarButtons do
begin
LSidebarOverlay := TPanel(LSidebarButton.Button.Controls[3]);
LSidebarOverlay.OnClick := SetSidebarButtonActive(nil, LSidebarButton);
end;
And then I have a procedure
procedure SetSidebarButtonActive(sender: TObject; btn: TSidebarButton);
begin
btn.SetActive;
//more code
end;
And I'm getting this error:
E2010 Incompatible types: 'TNotifyEvent' and 'procedure, untyped pointer or untyped parameter'
The error is because you are trying to call SetSidebarButtonActive() and then assign its result (which it has none) to the OnClick event. That will not work.
The OnClick event is defined as a TNotifyEvent:
TNotifyEvent = procedure(Sender: TObject) of object;
That means that
the procedure needs to be a member of a class
you have to assign the address of the procedure to OnClick, not call the procedure
the procedure must take only 1 input parameter, which is the TObject that fires the event (in this case, the TPanel that is being clicked on).
So, for what you are attempting, you would need to do something more like this instead:
procedure TMyForm.DoSomething;
var
...
LSidebarButton: TSidebarButton;
LSidebarOverlay: TPanel;
...
begin
...
for LSidebarButton in SidebarButtons do
begin
LSidebarOverlay := TPanel(LSidebarButton.Button.Controls[3]);
LSidebarOverlay.OnClick := SetSidebarButtonActive;
end;
...
end;
procedure TMyForm.SetSidebarButtonActive(Sender: TObject);
var
Pnl: TPanel;
Btn: TSidebarButton;
begin
Pnl := TPanel(Sender);
Btn := (Pnl.Parent as TSidebarButton);
// or maybe (Pnl.Parent.Parent as TSidebarButton)?
// or maybe (Pnl.Owner as TSidebarButton)?
// or maybe (Pnl.Parent.Owner as TSidebarButton)?
// Hard to know with your example. Use whatever you
// need to get back to the TSidebarButton from its
// inner child TPanel...
Btn.SetActive;
...
end;
Alternatively, you can store the TSidebarButton reference in the TPanel.Tag property (assuming you are not using it for something else):
procedure TMyForm.DoSomething;
var
...
LSidebarButton: TSidebarButton;
LSidebarOverlay: TPanel;
...
begin
...
for LSidebarButton in SidebarButtons do
begin
LSidebarOverlay := TPanel(LSidebarButton.Button.Controls[3]);
LSidebarOverlay.Tag := NativeInt(LSidebarButton);
LSidebarOverlay.OnClick := SetSidebarButtonActive;
end;
...
end;
procedure TMyForm.SetSidebarButtonActive(Sender: TObject);
var
Btn: TSidebarButton;
begin
Btn := TSidebarButton(TPanel(Sender).Tag);
Btn.SetActive;
...
end;
Alternatively, you can define a helper class to provide you access to the TSidebarButton without looking at the TPanel at all:
type
TOverlayClickHelper = class(TComponent)
public
Button: TSidebarButton;
procedure OnClick(Sender: TObject);
end;
...
procedure SetSidebarButtonActive(Btn: TSidebarButton);
begin
Btn.SetActive;
//more code
end;
procedure TOverlayClickHelper.OnClick(Sender: TObject);
begin
SetSidebarButtonActive(Button);
end;
procedure TMyForm.DoSomething;
var
...
LSidebarButton: TSidebarButton;
LSidebarOverlay: TPanel;
Helper: TOverlayClickHelper;
...
begin
...
for LSidebarButton in SidebarButtons do
begin
LSidebarOverlay := TPanel(LSidebarButton.Button.Controls[3]);
Helper := TOverlayClickHelper(LSidebarOverlay.FindComponent('MyHelper'));
if Helper = nil then
begin
Helper := TOverlayClickHelper.Create(LSidebarOverlay);
Helper.Name := 'MyHelper';
end;
Helper.Button := LSidebarButton;
LSidebarOverlay.OnClick := Helper.OnClick;
end;
...
end;
Alternatively, if you are creating the TPanel objects yourself inside of TSidebarButton, you could simply derive a new class from TPanel to add a TSidebarButton reference to it:
type
TSidebarButtonPanel = class(TPanel)
public
Button: TSidebarButton;
end;
...
procedure TSidebarButton.CreateOverlay;
var
LOverlay: TSidebarButtonPanel;
begin
LOverlay := TSidebarButtonPanel.Create(Self);
LOverlay.Parent := Self.Button;
LOverlay.Button := Self;
...
end;
...
procedure TMyForm.DoSomething;
var
...
LSidebarButton: TSidebarButton;
LSidebarOverlay: TPanel;
...
begin
...
for LSidebarButton in SidebarButtons do
begin
LSidebarOverlay := TPanel(LSidebarButton.Button.Controls[3]);
LSidebarOverlay.OnClick := SetSidebarButtonActive;
end;
...
end;
procedure TMyForm.SetSidebarButtonActive(Sender: TObject);
var
Btn: TSidebarButton;
begin
Btn := TSidebarButtonPanel(Sender).Button;
Btn.SetActive;
...
end;
There are all kinds of options available to you.
I want to create a procedure to enable or disable button,
can i do it with a single procedure? for example like this:
Procedure MainForm.buttonsEnabled(boolean);
BEGIN
if result=true then
begin
button1.enabled:=True;
button2.enabled:=True;
button3.enabled:=True;
end else
begin
button1.enabled:=false;
button2.enabled:=false;
button3.enabled:=false;
end;
END;
and when I call the procedure to disable or enable the button i can call it like
buttonsEnabled:=True;// to enable button
buttonsEnabled:=False;// to disable button
can I do it like that?
I can't find a way to do that in the simple way
procedure MainForm.buttonsEnabled(AEnabled: Boolean);
begin
button1.Enabled := AEnabled;
button2.Enabled := AEnabled;
button3.Enabled := AEnabled;
end;
buttonsEnabled(True);
//buttonsEnabled(False);
Create a property of the form:
type
TMyForm = class(TForm)
private
procedure SetButtonsEnabled(Value: Boolean);
public // or private perhaps, depending on your usage
property ButtonsEnabled: Boolean write SetButtonsEnabled;
end;
Implement it like this:
procedure TMyForm.SetButtonsEnabled(Value: Boolean);
begin
button1.Enabled := Value;
button2.Enabled := Value;
button3.Enabled := Value;
end;
And then you can use it as you intend:
ButtonsEnabled := SomeBooleanValue;
For multi usage
First Option :
Procedure EnabledDisableControls(Ctrls:Array of TControl; Enabled:Boolean);
var
C:TControl;
begin
for C in Ctrls do
C.Enabled:=Enabled;
end;
//calling example :
procedure TForm1.BtnTestClick(Sender: TObject);
begin
EnabledDisableControls([Button1, Button2, Button3], false {or True});
end;
Second Option :
Recrusivelly (or not) enabling/disabling buttons on a Control :
Procedure EnableDisableButtonsOnControl(C:TControl; Enabled:Boolean; Recrusive:Boolean);
var
i:integer;
begin
if C is TButton {or TBitButton or anything you need} then
C.Enabled:=Enabled
else if C is TWinControl then
for i := 0 to TWinControl(C).ControlCount-1 do
begin
if TWinControl(C).Controls[i] is TButton then
TButton(TWinControl(C).Controls[i]).Enabled:=Enabled
else
if Recrusive then
EnableDisableButtonsOnControl(TWinControl(C).Controls[i],Enabled,true);
end;
end;
//calling example :
procedure TForm1.BtnTestClick(Sender: TObject);
begin
//disable all buttons on Form1:
EnableDisableButtonsOnControl(Self, false, false {or true});
...
//disable all buttons on Panel1:
EnableDisableButtonsOnControl(Panel1, false, false {or true});
...
//disable all buttons on Panel1 recursively:
EnableDisableButtonsOnControl(Panel1, false, true);
end;
I have a form that has a list of useful procedures that I have created, that I often use in every project. I am adding a procedure that makes it simple to add a click-able image over where would be the TAccessory of a TListBoxItem. The procedure intakes the ListBox currently, but I would also need it to intake which procedure to call for the OnClick Event for the image.. Here is my existing code:
function ListBoxAddClick(ListBox:TListBox{assuming I need to add another parameter here!! but what????}):TListBox;
var
i : Integer;
Box : TListBox;
BoxItem : TListBoxItem;
Click : TImage;
begin
i := 0;
Box := ListBox;
while i <> Box.Items.Count do begin
BoxItem := Box.ListItems[0];
BoxItem.Selectable := False;
Click := Timage.Create(nil);
Click.Parent := BoxItem;
Click.Height := BoxItem.Height;
Click.Width := 50;
Click.Align := TAlignLayout.alRight;
Click.TouchTargetExpansion.Left := -5;
Click.TouchTargetExpansion.Bottom := -5;
Click.TouchTargetExpansion.Right := -5;
Click.TouchTargetExpansion.Top := -5;
Click.OnClick := // this is where I need help
i := +1;
end;
Result := Box;
end;
The desired procedure would be defined in the form that is calling this function.
Since the OnClick event is of type TNotifyEvent you should define a parameter of that type. Look at this (I hope self-explaining) example:
type
TForm1 = class(TForm)
Button1: TButton;
ListBox1: TListBox;
procedure Button1Click(Sender: TObject);
private
procedure TheClickEvent(Sender: TObject);
end;
implementation
procedure ListBoxAddClick(ListBox: TListBox; OnClickMethod: TNotifyEvent);
var
Image: TImage;
begin
Image := TImage.Create(nil);
// here is assigned the passed event method to the OnClick event
Image.OnClick := OnClickMethod;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
// here the TheClickEvent event method is passed
ListBoxAddClick(ListBox1, TheClickEvent);
end;
procedure TForm1.TheClickEvent(Sender: TObject);
begin
// do something here
end;
i've an FTP uploader project that uses a form created on run time to start uploading to multiple FTP Servers ( using Indy ) , my issue is as follows ( and i really need your help ) .
On a Form i put an IdFTP Component + an Upload button + public properties named FTPSrvAdrs and SrcFile + TrgFolder like this way :
type
TFtpUploader = class(TForm)
IdFTP: TIdFTP;
StartUpload:TButton;
UploadProgress:TProgressBar;
procedure StartUploadClick(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
FFtpSrvAdrs:String;
FSrcFile:String;
FTargetFtpFld:String;
Procedure StartMyUpload();
procedure SetFtpAdrs(const value:string);
procedure SetSrcFile(const value:string);
procedure SetTargetFtpFld(const value:string);
{ Private declarations }
public
{ Public declarations }
property FtpAdrs:string read FFtpSrvAdrs write SetFtpAdrs;
property SourceFile:string read FSrcFile write SetSrcFile;
property TargetFtpFld:string read FTargetFtpFld write SetTargetFtpFld;
end;
var
FtpUploader: TFtpUploader;
implementation
procedure TFtpUploader.StartUploadClick(Sender: TObject);
begin
StartMyUpload();
end;
procedure TFtpUploader.SetFtpAdrs(const value: string);
begin
FFtpSrvAdrs:=value;
end;
procedure TFtpUploader.SetSrcFile(const value: string);
begin
FSrcFile:=value;
end;
procedure TFtpUploader.SetTargetFtpFld(const value: string);
begin
FTargetFtpFld:=value;
end;
procedure TFtpUploader.StartMyUpload;
var
FtpUpStream: TFileStream;
begin
ftpUpStream:= TFileStream.create(FSrcFile, fmopenread)
try
with IdFTP do begin
Host:= FFtpSrvAdrs;
Username:='MyUserName';
Password:='MyPassword';
end;
IdFTP.Connect(true, 1200)
IdFTP.Passive:= true;
IdFTP.ChangeDir(FTargetFtpFld)
IdFTP.Put(ftpUpStream,FSrcFile, false);
finally
ftpUpStream.Free;
end;
end;
procedure TFtpUploader.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Action:=caFree;
end;
This Form will be created on RunTime ( 4 times = 4 buttons will launch it separately like this way :
in the main form i've this procedure :
Procedure MainForm.UploadTo(FTPSrv,SrcFile,FtpTargetFld:String);
var
FUploadFrm:TFtpUploader;
begin
FUploadFrm:=TFtpUploader.Create(nil);
if assigned(FUploadFrm) then
begin
FUploadFrm.FtpAdrs:=FTPSrv;
FUploadFrm.SourceFile:=SrcFile;
FUploadFrm.TargetFtpFld:=FtpTargetFld;
FUploadFrm.Show;
end;
end;
procedure MainForm.Button1Click(Sender: TObject);
begin
UploadTo('MyFtpSrv_1','MySrcFile_1','MyFtpTargetFld_1');
end;
procedure MainForm.Button2Click(Sender: TObject);
begin
UploadTo('MyFtpSrv_2','MySrcFile_2','MyFtpTargetFld_2');
end;
// same with other 2 buttons
the FtpUploader form is Created / Opened ( 4 instances ) ,The ISSUE IS when i click on StartUpload button the FTP upload process is not started on all these 4 instances , but i've to wait each upload process is done ( finished ) and the other will auto-start , that means not all upload processes are started in same time .
Thank you .
It seems you have to either change Indy library for some non-blocking in-background library (event based or completion port based), or to make your program multi-threading (with it's own bunch of problems like user clicking a button 20 times or closing the form while the process is going, or even closing the program on the run).
Based on http://otl.17slon.com/book/doku.php?id=book:highlevel:async it can look anything like this:
TFtpUploader = class(TForm)
private
CanCloseNow: boolean;
...
procedure TFtpUploader.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if Self.CanCloseNow
then Action := caFree
else Action := caIgnore;
end;
procedure TFtpUploader.MyUploadComplete;
begin
Self.CanCloseNow := True;
Self.Close;
end;
procedure TFtpUploader.StartMyUpload;
begin
Self.CanCloseNow := false;
Self.Enabled := False;
Self.Visible := True;
Application.ProcessMessages;
Parallel.Async(
procedure
var
FtpUpStream: TFileStream;
begin
ftpUpStream:= TFileStream.create(FSrcFile, fmopenread)
try
with IdFTP do begin
Host:= FFtpSrvAdrs;
Username:='MyUserName';
Password:='MyPassword';
Connect(true, 1200)
Passive:= true;
ChangeDir(FTargetFtpFld)
// this does not return until uploaded
// thus would not give Delphi a chance to process buttons
// pressed on other forms.
Put(ftpUpStream,FSrcFile, false);
end;
finally
ftpUpStream.Free;
end;
end
,
Parallel.TaskConfig.OnTerminated(
procedure (const task: IOmniTaskControl)
begin
MyUploadComplete;
end;
);
end;
Or you can use simplier AsyncCalls library http://andy.jgknet.de/blog/bugfix-units/asynccalls-29-asynchronous-function-calls/