I have a project with one FadeIn Timer and One FadeOut Timer. My form is created by FadeIn Timer and is closed by FadeOut Timer. Initially FadeIn Timer is enabled and FadeOut Timer is disabled. FadeIn Timer Code :
if MainForm.AlphaBlendValue >= 235 then
Timer01.Enabled := false
else
MainForm.AlphaBlendValue := MainForm.AlphaBlendValue + 5;
FadeOut Timer Code :
if MainForm.AlphaBlendValue <= 0 then
Timer02.Enabled := false
else
MainForm.AlphaBlendValue := MainForm.AlphaBlendValue - 5;
close;
My requirement is that the FadeOut Timer will be active if I click on the "X" Button of the Caption Bar. So I defined
if Msg.Result=htClose then
FadeOutTimer.Enabled:=true;
But it not working. Please help me.
If the form just closes immediately, then you need a global form variable like FAllowClose that you set to False when the form is created. Then you need to write code for the Form.CloseQuery event. Something simple like this should work:
procedure Form.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
if FAllowClose then
Exit;
CanClose := False;
FadeOut.Enabled := True;
end;
procedure Form.FadeOutOnTimer(Sender: TObject);
begin
// do fade out
FAllowClose := True;
Self.Close
end;
<<< 2012/07/17 Edit >>>
When the user clicks the "X" button on the form, the only one way to stop the form from closing is to cancel it in the OnCloseQuery event. Then when you are done fading out the form, you close the form. You'll need a global variable like FAllowClose to signal the OnCloseQuery event that you are close the form instead of the user. This code is a little more illustrative, and should handle the situation where a user clicks the "X" again while it is fading out.
interface
type TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure FadeOutTimer(Sender: TObject);
private
FAllowClose: Boolean;
public
end;
implementation
procedure TForm1.FormCreate(Sender: TObject);
begin
FAllowClose := False;
end;
procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
if FAllowClose then // <- is 'False' when user clicks "X"
Exit;
CanClose := False; // <- cancels close when user clicks "X"
FadeOut.Enabled := True;
end;
procedure TForm1.FadeOutTimer(Sender: TObject);
begin
if Form1.AlphaBlendValue > 0 then
Form1.AlphaBlendValue := Form1.AlphaBlendValue - 5
else
begin
FadeOut.Enabled := False;
FAllowClose := True;
Self.Close;
end;
end;
I think this is the proper fade out code for James L's answer:
procedure Form.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
if FAllowClose then
begin
CanClose := True;
Exit;
end;
CanClose := False;
FadeOut.Enabled := True;
end;
procedure Form.FadeOutOnTimer(Sender: TObject);
begin
if MainForm.AlphaBlendValue <= 0 then
begin
FadeOut.Enabled := false
FAllowClose := True;
Self.Close
end
else
MainForm.AlphaBlendValue := MainForm.AlphaBlendValue - 5;
end;
Related
I have a TScrollBox with a bunch of TPanels with some TButtons generated at runtime.
I need to delete the TPanel when one TButton is clicked but doing that in OnClick end in an access violation...
procedure TMainForm.ButanClick(Sender: TObject);
var
vParentPanel: TPanel;
begin
if (string(TButton(Sender).Name).StartsWith('L')) then
begin
TButton(Sender).Caption := 'YARE YARE DAZE';
end
else
begin
vParentPanel := TPanel(TButton(Sender).GetParentComponent());
TheScrollBox.RemoveComponent(vParentPanel);
vParentPanel.Destroy();
// access violation but the panel is removed
end;
end;
procedure TMainForm.Button3Click(Sender: TObject);
var
i: Integer;
vPanel: TPanel;
vButton: TButton;
begin
for i := 0 to 20 do
begin
vPanel := TPanel.Create(TheScrollBox);
vPanel.Align := alTop;
vPanel.Parent := TheScrollBox;
vButton := TButton.Create(vPanel);
vButton.Align := alLeft;
vButton.Parent := vPanel;
vButton.Name := 'L_butan' + IntToStr(i);
vButton.OnClick := ButanClick;
vButton := TButton.Create(vPanel);
vButton.Align := alRight;
vButton.Parent := vPanel;
vButton.Name := 'R_butan' + IntToStr(i);
vButton.OnClick := ButanClick;
end;
end;
You cannot safely destroy the parent TPanel (or the TButton itself) from inside the TButton's OnClick event. The VCL still needs access to the TPanel/TButton for a beat after the event handler exits. So, you need to delay the destruction until after the handler exits. The easiest way to do that is to use TThread.ForceQueue() to call TObject.Free() on the TPanel, eg:
procedure TMainForm.ButanClick(Sender: TObject);
var
vButton: TButton;
begin
vButton := TButton(Sender);
if vButton.Name.StartsWith('L') then
begin
vButton.Caption := 'YARE YARE DAZE';
end
else
begin
TThread.ForceQueue(nil, vButton.Parent.Free);
end;
end;
The TPanel will remove itself from the TScrollBox during its destruction. You do not need to handle that step manually.
Solved with Renate Schaaf answer:
...
const
WM_REMOVEPANEL = WM_USER + 9001;
procedure ButanClick(Sender: TObject);
procedure OnCustomMessage(var Msg: TMessage); message WM_REMOVEPANEL;
...
procedure TMainForm.ButanClick(Sender: TObject);
var
vParentPanel: TPanel;
begin
if (string(TButton(Sender).Name).StartsWith('L')) then
begin
TButton(Sender).Caption := 'YARE YARE DAZE';
end
else
begin
// SendMessage = access violation again because it wait the return
// while PostMessage return istantly
PostMessage(Handle, WM_REMOVEPANEL, 0, THandle(#Sender));
end;
end;
procedure TMainForm.OnCustomMessage(var Msg: TMessage);
var
vButton: TButton;
begin
if (Msg.Msg = WM_REMOVEPANEL) then
begin
vButton := TButton(Pointer(Msg.LParam)^);
ShowMessage(vButton.Name);
TheScrollBox.RemoveComponent(vButton.GetParentComponent());
TPanel(vButton.GetParentComponent()).Destroy();
Msg.Result := 1;
end
else
Msg.Result := 0;
end;
I have created following abstract code where the user has 2 buttons:
One button is starting some kind of process. The global variable PleaseStop will tell the running process that it should stop its work.
The other button sets the global variable PleaseStop which will tell the procedure to stop.
-
var
PleaseStop: boolean;
IsRunning: boolean;
procedure TForm1.RunActionClick(Sender: TObject);
var
rnd: integer;
tic: Cardinal;
begin
try
IsRunning := true;
rnd := Random(100);
while not PleaseStop do
begin
tic := GetTickCount;
while (GetTickCount-tic < 1000) and not PleaseStop do
begin
Application.ProcessMessages;
Sleep(10);
end;
Memo1.Lines.Add(IntToStr(rnd));
end;
finally
IsRunning := false;
PleaseStop := false;
end;
end;
procedure TForm1.StopBtnClick(Sender: TObject);
begin
PleaseStop := true;
end;
Everything works as expected.
Now there will be problems if the user doesn't click the Stop button, but instead clicks the Run button again (which should be allowed).
I have now modified my code like this:
var
PleaseStop: boolean;
IsRunning: boolean;
procedure TForm1.Button1Click(Sender: TObject);
var
rnd: integer;
tic: Cardinal;
begin
// ---- BEGIN NEW ----
if IsRunning then
begin
PleaseStop := true; // End the previous actions
while PleaseStop do // Wait until the previous actions are done
begin
// TODO: this loop goes forever. PleaseStop will never become false
Application.ProcessMessages;
Sleep(10);
end;
// Now we can continue
end;
// ---- END NEW ----
try
IsRunning := true;
rnd := Random(100);
while not PleaseStop do
begin
tic := GetTickCount;
while (GetTickCount-tic < 1000) and not PleaseStop do
begin
Application.ProcessMessages;
Sleep(10);
end;
Memo1.Lines.Add(IntToStr(rnd));
end;
finally
IsRunning := false;
PleaseStop := false;
end;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
PleaseStop := true;
end;
Clicking the Start button again will cause a deadlock.
I assume the compiler thinks that while PleaseStop do is equal to while true do since I just set PleaseStop to true earlier. But in fact, this variable should be monitored...
I also tried putting [volatile] in front of the variables, and make them member of TForm1, but that doesn't work either.
Why didn't I use threads?
The code is heavily VCL dependent.
The run button will start a dia show. Every time, the run button is clicked, a random picture folder will be chosen.
So, when the user doesn't like the pictures, he will click "Run" again to switch to a new folder and start the new dia show automatically. The previous run should be stoppped therefore.
Your diagnosis is not exactly accurate, ProcessMessages, simply, cannot cause a previously retrieved message's processing to continue. You have to stop processing and let the execution continue from where re-entrancy occurred. Re-entrancy is the primary avoidance reason of Application.ProcessMessages, and you're doing it on purpose. Hard to work it out...
If you don't want to use synchronization and threading, you can use a timer instead. The code will be much simpler too.
procedure TForm1.FormCreate(Sender: TObject);
begin
Timer1.Enabled := False;
Randomize;
end;
var
rnd: Integer;
procedure TForm1.StartClick(Sender: TObject);
begin
rnd := Random(100);
Timer1.Enabled := True;
end;
procedure TForm1.StopClick(Sender: TObject);
begin
Timer1.Enabled := False;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
Memo1.Lines.Add(IntToStr(rnd));
end;
Try to rewrite your event handler like this:
var Needtorestart:Boolean = false;
procedure TForm1.Button1Click(Sender: TObject);
var
rnd: integer;
tic: Cardinal;
begin
// ---- BEGIN NEW ----
if IsRunning then
begin
PleaseStop := true; // End the previous action
Needtorestart := true;
Exit;
// Now we can continue
end;
// ---- END NEW ----
try
repeat
IsRunning := true;
rnd := Random(100);
while not PleaseStop do
begin
Tic := GetTickCount;
while (GetTickCount-tic < 1000) and not PleaseStop do
begin
Application.ProcessMessages;
Sleep(10);
end;
Memo1.Lines.Add(IntToStr(rnd));
end;
PleaseStop := false;
until not Needtorestart;
finally
IsRunning := false;
PleaseStop := false;
Needtorestart := false;
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);
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;