I have 2 MDI ChildForms and the Child1 has a TButton to open the Child2. I do not have any issue opening it at the same time disable the TButton to prevent Child2 from recreating again using TButton.
Now, the challenge comes when I want the TButton of Child1 back to "enabled" when I closed the Child2.
I am getting access error when doing these code:
procedure TfrmChild2.FormClose(Sender: TObject; var Action: TCloseAction);
begin
child1_u.frmChild1.btnOpenChild2Form.Enabled := True;
Action := caFree;
end;
I understand there is somehow a different approach when dealing with MDI. I figured it out when I did the code for disabling the TButton during opening at runtime below:
procedure TfrmMain.btnOpenChild2(Sender: TObject);
begin
TfrmChild2.Create(frmMain);
btnOpenChild2.Enabled := False;
end;
But to enable it back when the Child2 form is closed is a challenge.
I tried to create a procedure in the MainForm (Owner) to trigger the enable of TButton in the Child1:
procedure TfrmMain.EnableButtonAtChild1();
begin
child1_u.frmChild1.btnOpenChild1Form.Enabled := True;
end;
and called at runtime during OnClose of Child2:
procedure TfrmChild2.FormClose(Sender: TObject; var Action: TCloseAction);
begin
EnableButtonAtChild1();
end;
I am new to MDI and I need to understand how accessing components works particular this simple case. I will appreciate any help here.
I would take a different approach - assign the 2nd child's OnClose event dynamically when the 1st child creates the 2nd child. Don't have the 2nd child try to find and access the 1st child directly:
procedure TfrmChild1.btnOpenChild2FormClick(Sender: TObject);
var
child: TfrmChild2;
begin
child := TfrmChild2.Create(Application.MainForm);
child.OnClose := Child2Closed;
btnOpenChild2Form.Enabled := False;
end;
procedure TfrmChild1.Child2Closed(Sender: TObject; var Action: TCloseAction);
begin
btnOpenChild2.Enabled := True;
Action := caFree;
end;
Just make sure the 2nd child is always closed before the 1st child is freed, otherwise you will have trouble. If you need to, you can solve that like this:
procedure TfrmChild1.FormDestroy(Sender: TObject);
var
I: Integer;
child: TForm;
event: TCloseEvent;
begin
for I := 0 to Application.MainForm.MDIChildCount-1 do
begin
child := Application.MainForm.MDIChildren[I];
event := child.OnClose;
if Assigned(event) and (TMethod(event).Data = Self) then
child.OnClose := nil;
end;
end;
I have an application that restores windows on startup but this results in a potential flicker as each window is created and positioned.
To get around this I have the splash screen (stretched to the full size of the screen) set to "StayOnTop" and close it after the OnShow event using a TTask. The problem is that occasionally the splash screen gets stuck. If you click where buttons should be they redraw and show correctly.
I have tried to "invalidate" all WinControls but this problem still shows up.
I have never seen the problem in the debugger.
Are there any other tricks anyone can suggest to forcing a full repaint of the screen?
Here is my code to close the splash - This is in the OnShow of the main form.
aTask := TTask.Create(procedure()
begin
Sleep(800);
TThread.Synchronize(nil, procedure()
begin
fSplash.Close;
FreeAndNil(fSplash);
DoInvalidate(self);
end);
end);
aTask.Start;
Here is my attempt to invalidate everything...
Procedure DoInvalidate( aWinControl: TWInControl );
var
i: Integer;
ctrl: TControl;
begin
for i:= 0 to aWinControl.Controlcount-1 do
begin
ctrl:= aWinControl.Controls[i];
if ctrl Is TWinControl then
DoInvalidate( TWincontrol( ctrl ));
end;
aWinControl.Invalidate;
end;
Martin
You don't need to recursively invalidate everything, just invalidating the Form itself is sufficient.
If you upgrade to 10.2 Tokyo, you can now use TThread.ForceQueue() instead of TThread.Synchronize() in a TTask:
procedure TMainForm.FormShow(Sender: TObject);
begin
TThread.ForceQueue(nil, procedure
begin
FreeAndNil(fSplash);
Application.MainForm.Invalidate;
end
);
end;
If you stick with TTask, you should at least use TThread.Queue() instead:
procedure TMainForm.FormShow(Sender: TObject);
begin
TTask.Create(procedure
begin
TThread.Queue(nil, procedure
begin
FreeAndNil(fSplash);
Application.MainForm.Invalidate;
end;
end
).Start;
end;
Or, you could just use a short TTimer, like zdzichs suggested:
procedure TMainForm.FormShow(Sender: TObject);
begin
Timer1.Enabled := True;
end;
procedure TMainForm.Timer1Timer(Sender: TObject);
begin
Timer1.Enabled := False;
FreeAndNil(fSplash);
Invalidate;
end;
Or, you could assign an OnClose event handler to the splash form to invalidate the MainForm, and then PostMessage() a WM_CLOSE message to the splash form:
procedure TMainForm.FormCreate(Sender: TObject);
begin
fSplash := TSplashForm.Create(nil);
fSplash.OnClose := SplashClosed;
fSplash.Show;
end;
procedure TMainForm.FormShow(Sender: TObject);
begin
if fSplash <> nil then
PostMessage(fSplash.Handle, WM_CLOSE, 0, 0);
end;
procedure TMainForm.SplashClosed(Sender: TObject; var Action: TCloseAction);
begin
fSplash := nil;
Action := caFree;
Invalidate;
end;
Or, use the OnDestroy event instead:
procedure TMainForm.FormCreate(Sender: TObject);
begin
fSplash := TSplashForm.Create(nil);
fSplash.OnDestroy := SplashDestroyed;
fSplash.Show;
end;
procedure TMainForm.FormShow(Sender: TObject);
begin
if fSplash <> nil then
fSplash.Release; // <-- delayed free
end;
procedure TMainForm.SplashDestroyed(Sender: TObject);
begin
fSplash := nil;
Invalidate;
end;
I have a PopupMenu in my Application which pops up when a user right clicks on my App's Notification Area icon.
When I right click on this icon, pop up the menu, and do nothing, my App behaves like resuming its work because it looks like it is waiting until I click on a Menu Item.
I want to remove this behavior. I tried fixing the PopupMenu by adding an Auto-Close procedure when no response comes from the user and when the Mouse Pointer leaves the PopupMenu.
I also tried adding a TTimer that closes my TPopUpMenu after a specified time, but it closes after the time I specified without looking if the Mouse Pointer is inside or outside the PopupMenu.
Two Scenarios I want to Achieve are:
I want the TPopUpMenu to close when the user moves the Mouse Pointer out of it for more than two or three seconds.
When the user moves the Mouse Pointer inside of it, the TPopupMenu should be closed after five minutes, because ANY USER should respond to a PopupMenu within five minutes.
I tried adding the following code with a TTimer to my App's Event Handler that opens the PopupMenu when the user right-clicks on the Tray Icon, but the PopupMenu always closes after two seconds:
procedure TMainForm_1.SysTrayIconMessageHandler(var Msg: TMessage);
var
SysTrayTimer: TTimer;
PT: TPoint;
begin
case Msg.LParam of
WM_.....:;
WM_RBUTTONDOWN:
begin
GetCursorPos(PT);
SysTrayTimer.Enabled := True;
SysTrayTimer.Interval := 2500;
SystemTrayPopUpMenu.PopUp(PT.X, PT.Y);
SystemTrayPopUpMenu.AutoLineReduction := maAutomatic;
end;
end;
end;
procedure TMainForm_1.OnSysTrayTimer(Sender: TObject);
begin
SysTrayTimer.Enabled := False;
SendMessage(PopupList.Window, WM_CANCELMODE, 0, 0);
end;
I also read this, but after I added the code, nothing changed.
At least, I must be able to do this: close the PopupMenu after the user opens it by right clicking and moves the Mouse Pointer outside of it.
This is how I added new code to achieve this:
unit MainForm_1;
interface
uses
Windows, SysUtils, Messages, Classes, Graphics, Controls,
Forms, Dialogs, StdCtrls, ExtCtrls, Menus, ImgList;
type
TMainForm_1 = class(TForm);
SystemTrayPopUpMenu: TPopUpMenu;
ExitTheProgram: TMenuItem;
RestoreFromSystemTray: TMenuItem;
ReadTheInstructions: TMenuItem;
Separator1: TMenuItem;
TrackSysTrayMenuTimer: TTimer;
CloseSysTrayMenuTimer: TTimer;
procedure OnTrackSysTrayMenuTimer(Sender: TObject);
procedure OnCloseSysTrayMenuTimer(Sender: TObject);
procedure SysTrayPopUpMenuPopUp(Sender: TObject);
private
MouseInSysTrayPopUpMenu: Boolean;
IconData: TNotifyIconData;
procedure SysTrayIconMsgHandler(var Msg: TMessage); message TRAY_CALLBACK;
procedure AddSysTrayIcon;
procedure DisplayBalloonTips;
procedure ApplySystemTrayIcon;
procedure DeleteSysTrayIcon;
public
IsSystemTrayIconShown: Boolean;
end;
var
MainForm_1: TMainForm_1;
implementation
uses
ShlObj, MMSystem, ShellAPI, SHFolder,.....;
procedure TMainForm_1.SysTrayIconMsgHandler(var Msg: TMessage);
var
PT: TPoint;
begin
case Msg.LParam of
WM_MOUSEMOVE:;
WM_LBUTTONUP:;
WM_LBUTTONDBLCLK:;
WM_RBUTTONUP:;
WM_RBUTTONDBLCLK:;
WM_LBUTTONDOWN:;
NIN_BALLOONSHOW:;
NIN_BALLOONHIDE:;
NIN_BALLOONTIMEOUT:;
NIN_BALLOONUSERCLICK:;
WM_RBUTTONDOWN:
begin
GetCursorPos(PT);
SetForegroundWindow(Handle);
SystemTrayPopUpMenu.OnPopup := SysTrayPopUpMenuPopUp;
SystemTrayPopUpMenu.PopUp(Pt.X, Pt.Y);
PostMessage(Handle, WM_NULL, 0, 0);
TrackSysTrayMenuTimer.Enabled := False;
CloseSysTrayMenuTimer.Enabled := False;
end;
end;
end;
procedure TMainForm_1.SysTrayPopUpMenuPopup(Sender: TObject);
begin
MouseInSysTrayMenu := True;
TrackSysTrayMenuTimer.Interval := 100;
TrackSysTrayMenuTimer.OnTimer := OnTrackSysTrayMenuTimer;
TrackSysTrayMenuTimer.Enabled := True;
CloseSysTrayMenuTimer.Interval := 300000;
CloseSysTrayMenuTimer.OnTimer := OnCloseSysTrayMenuTimer;
CloseSysTrayMenuTimer.Enabled := True;
end;
procedure TMainForm_1.OnTrackSysTrayMenuTimer(Sender: TObject);
var
hPopupWnd: HWND;
R: TRect;
PT: TPoint;
begin
hPopupWnd := FindWindow('#32768', nil);
if hPopupWnd = 0 then Exit;
GetWindowRect(hPopupWnd, R);
GetCursorPos(Pt);
if PtInRect(R, Pt) then begin
if not MouseInSysTrayMenu then begin
MouseInSysTrayMenu := True;
CloseSysTrayMenuTimer.Interval := 300000;
end;
end else begin
if MouseInSysTrayMenu then begin
MouseInSysTrayMenu := False;
CloseSysTrayMenuTimer.Interval := 2500;
end;
end;
end;
procedure TMainForm_1.OnCloseSysTrayMenuTimer(Sender: TObject);
begin
CloseSysTrayMenuTimer.Enabled := False;
SendMessage(PopupList.Window, WM_CANCELMODE, 0, 0);
end;
How two TTimers are used in the App's MainForm:
How I assigned TrackSysTrayMenuTimer's property values.....
How I assigned CloseSysTrayMenuTimer's property values.....
I also got an Exception Message like this.....
It is a message I wrote like this to check what is failing in the Code..... So with that I can identify if FindWindow is failing or not.....
...
hPopupWnd := FindWindow('#32768', nil);
if hPopupWnd = 0 then
begin
TrackSysTrayMenuTimer.Enabled := False;
if ShowErrors = True and TestingMode = True then
Application.MessageBox('The PopUp Menu "SystemTrayPopUpMenu" could not be found.' +
' FindWindow will abort.', ' Exception Message', MB_ICONSTOP or MB_OK);
exit;
The Last Error I received is:
Thanks in Advance.
A standard popup menu is not supposed to auto-close when the user moves the mouse outside of it. The user is meant to click somewhere to dismiss it.
If you really want to auto-close a popup menu when the mouse moves outside of it, you have to manually implement your own tracking to know when the mouse is outside of the menu's current display coordinates.
That being said, there is also a bug in your code that you need to fix. Per MSDN documentation:
To display a context menu for a notification icon, the current window must be the foreground window before the application calls TrackPopupMenu or TrackPopupMenuEx. Otherwise, the menu will not disappear when the user clicks outside of the menu or the window that created the menu (if it is visible). If the current window is a child window, you must set the (top-level) parent window as the foreground window.
This is further discussion by Microsoft Support:
PRB: Menus for Notification Icons Do Not Work Correctly
When you display a context menu for a notification icon (see Shell_NotifyIcon), clicking anywhere besides the menu or the window that created the menu (if it is visible) doesn't cause the menu to disappear. When this behavior is corrected, the second time this menu is displayed, it displays and then immediately disappears.
To correct the first behavior, you need to make the current window the foreground window before calling TrackPopupMenu or TrackPopupMenuEx. If the current window is a child window, set the (top-level) parent window as the foreground window.
The second problem is caused by a problem with TrackPopupMenu. It is necessary to force a task switch to the application that called TrackPopupMenu at some time in the near future. This can be accomplished by posting a benign message to the window or thread.
Try something more like this:
var
SysTrayMenuTicks: DWORD;
MouseInSysTrayMenu: Boolean;
// drop a TTimer on the TForm at design-time, set its Interval
// property to 100, its Enabled property to false, and assign
// on OnTimer event handler...
procedure TMainForm_1.SysTrayIconMessageHandler(var Msg: TMessage);
var
Pt: TPoint;
begin
case Msg.LParam of
...
WM_RBUTTONDOWN:
begin
// FYI, the `WM_RBUTTONDOWN` notification provides you with
// screen coordinates where the popup menu should be displayed,
// you don't need to use `GetCursorPos()` to figure it out...
GetCursorPos(Pt);
SetForegroundWindow(Handle); // <-- bug fix!
SystemTrayPopUpMenu.PopUp(Pt.X, Pt.Y);
PostMessage(Handle, WM_NULL, 0, 0); // <-- bug fix!
SysTrayTimer.Enabled := False;
end;
...
end;
end;
procedure TMainForm_1.SystemTrayPopUpMenuPopup(Sender: TObject);
begin
MouseInSysTrayMenu := True;
SysTrayMenuTicks := GetTickCount;
SysTrayTimer.Enabled := True;
end;
procedure TMainForm_1.SysTrayTimerTimer(Sender: TObject);
var
hPopupWnd: HWND;
R: TRect;
Pt: TPoint;
begin
// get the HWND of the current active popup menu...
hPopupWnd := FindWindow('#32768', nil);
if hPopupWnd = 0 then Exit;
// get the popup menu's current position and dimensions...
GetWindowRect(hPopupWnd, R);
// get the mouse's current position...
GetCursorPos(Pt);
if PtInRect(R, Pt) then
begin
// mouse is over the menu...
if not MouseInSysTrayMenu then
begin
// just entered, reset timeout...
MouseInSysTrayMenu := True;
SysTrayMenuTicks := GetTickCount;
Exit;
end;
// has the mouse been over the menu for < 5 minutes?
if (GetTickCount - SysTrayMenuTicks) < 300000 then
Exit; // yes...
end else
begin
// mouse is not over the menu...
if MouseInSysTrayMenu then
begin
// just left, reset timeout...
MouseInSysTrayMenu := False;
SysTrayMenuTicks := GetTickCount;
Exit;
end;
// has the mouse been outside the menu for < 2.5 seconds?
if (GetTickCount - SysTrayMenuTicks) < 2500 then
Exit; // yes...
end;
// timeout! Close the popup menu...
SendMessage(PopupList.Window, WM_CANCELMODE, 0, 0);
end;
Alternatively:
var
MouseInSysTrayMenu: Boolean;
// drop two TTimers on the TForm at design-time, set their Enabled
// properties to false, and assign OnTimer event handlers...
procedure TMainForm_1.SysTrayIconMessageHandler(var Msg: TMessage);
var
Pt: TPoint;
begin
case Msg.LParam of
...
WM_RBUTTONDOWN:
begin
// FYI, the `WM_RBUTTONDOWN` notification provides you with
// screen coordinates where the popup menu should be displayed,
// you don't need to use `GetCursorPos()` to figure it out...
GetCursorPos(Pt);
SetForegroundWindow(Handle); // <-- bug fix!
SystemTrayPopUpMenu.PopUp(Pt.X, Pt.Y);
PostMessage(Handle, WM_NULL, 0, 0); // <-- bug fix!
TrackSysTrayMenuTimer.Enabled := False;
CloseSysTrayMenuTimer.Enabled := False;
end;
...
end;
end;
procedure TMainForm_1.SystemTrayPopUpMenuPopup(Sender: TObject);
begin
MouseInSysTrayMenu := True;
TrackSysTrayMenuTimer.Interval := 100;
TrackSysTrayMenuTimer.Enabled := True;
CloseSysTrayMenuTimer.Interval := 300000; // 5 minutes
CloseSysTrayMenuTimer.Enabled := True;
end;
procedure TMainForm_1.TrackSysTrayMenuTimerTimer(Sender: TObject);
var
hPopupWnd: HWND;
R: TRect;
Pt: TPoint;
begin
// get the HWND of the current active popup menu...
hPopupWnd := FindWindow('#32768', nil);
if hPopupWnd = 0 then Exit;
// get the popup menu's current position and dimensions...
GetWindowRect(hPopupWnd, R);
// get the mouse's current position...
GetCursorPos(Pt);
if PtInRect(R, Pt) then
begin
// mouse is over the menu...
if not MouseInSysTrayMenu then
begin
// just entered, reset timeout...
MouseInSysTrayMenu := True;
CloseSysTrayMenuTimer.Interval := 300000; // 5 minutes
end;
end else
begin
// mouse is not over the menu...
if MouseInSysTrayMenu then
begin
// just left, reset timeout...
MouseInSysTrayMenu := False;
CloseSysTrayMenuTimer.Interval := 2500; // 2.5 seconds
end;
end;
end;
procedure TMainForm_1.CloseSysTrayMenuTimerTimer(Sender: TObject);
begin
// timeout! Close the popup menu...
CloseSysTrayMenuTimer.Enabled := False;
SendMessage(PopupList.Window, WM_CANCELMODE, 0, 0);
end;
Try like this:
.....
hPopupWnd := FindWindow('#32768', SystemTrayPopUpMenu);
if hPopupWnd = 0 then Exit;
.....
GetWindowRect(SystemTrayPopUpMenu.Handle, R);
in delphi mdi application there is need to show a child window with its caption in Mainform client area when maximize button is pressed using
Win32Check(Windows.GetClientRect(ClientHandle, aTRect));
MDIChild1.BoundsRect := aTRect;
functions.
So, how we can prevent a MDI child from being maximized when maximize button is pressed?
I've tried to do it using
procedure TChildText.WMSYSCOMMAND(var Message: TWMSYSCOMMAND);
var
aTRect:TRect;
begin
inherited;
case message.CmdType of
SC_MAXIMIZE:
begin
Win32Check(Windows.GetClientRect(MainForm.ClientHandle, aTRect));
BoundsRect := aTRect;
end;
end;
end;
with no result.
procedure TChildText.WMSYSCOMMAND(var Message: TWMSYSCOMMAND);
var
aTRect:TRect;
begin
if message.CmdType = SC_MAXIMIZE then
begin
Win32Check(Windows.GetClientRect(MainForm.ClientHandle, aTRect));
BoundsRect := aTRect;
message.CmdType := SC_RESTORE;
end;
inherited;
end;
Basically, I'm using a TTimer event to close all the open forms and bring the user back to the main form.
I could iterate through Screen.Forms:
for i := 0 to Screen.Formcount - 1 do
Screen.Forms[i].close;
The problem is the OnCloseQuery events on some of those forms - they pop up MessageDlg's which interrupt this process :(
You can use a flag in your main form that your other forms would check before asking the user whether to proceed or not. Something like this:
unit1
type
TForm1 = class(TForm)
..
public
UnconditinalClose: Boolean;
end;
..
procedure TForm1.Timer1Timer(Sender: TObject);
begin
UnconditinalClose := True;
end;
unit 2:
implementation
uses
unit1;
procedure TForm2.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
CanClose := unit1.Form1.UnconditinalClose;
if not CanClose then
// ask the user if he/she's sure he/she wants to close
end;
One other solution could be detaching OnCloseQuery event handlers of other forms. This would only be practical if these other forms are released (freed) when closing, not hidden (edited to reflect Rob's comment):
procedure TForm1.Timer1Timer(Sender: TObject);
var
i: Integer;
SaveHandler: TCloseQueryEvent;
begin
for i := 0 to Screen.Formcount - 1 do
if Screen.Forms[i] <> Self then begin
SaveHandler := Screen.Forms[i].OnCloseQuery;
Screen.Forms[i].OnCloseQuery := nil;
Screen.Forms[i].Close;
Screen.Forms[i].OnCloseQuery := SaveHandler;
end;
end;
for i := 1 to Screen.Formcount - 1 do
Screen.Forms[i].close;
Initial the value i with 1, not 0.