I need to detect when a form is minimized (to hide overlay form). I intercept WM_SYSCOMMAND message and it works fine if I click the form's minimize button, but this event seems not to be fired if I use [Windows] + [M]. Also, WM_ACTIVATE and WM_ACTIVATEAPP are not triggered in this case.
What event could I use and are there any other situations that I would have to detect?
As explained here, How to detect when the form is being maximized?, listen to the WM_SIZE messages.
Declare in your form:
procedure WMSize(var Msg: TMessage); message WM_SIZE;
And implementation:
procedure TForm1.WMSize(var Msg: TMessage);
begin
Inherited;
if Msg.WParam = SIZE_MINIMIZED then
ShowMessage('Minimized');
end;
Update
See also the answer by #bummi where there is a solution when Application.MainFormOnTaskbar = false.
Since WM_SIZE will not be called on a mainform of a project not using the setting Application.MainFormOnTaskbar := True; I'd suggest an approach, inspired by inspired by #kobik 's answer on , How to detect when the form is being maximized?.
WM_WINDOWPOSCHANGING will be called independed from MainFormOnTaskbar with different signatures on Message.WindowPos^.flags and respond on WIN + M too.
procedure TForm3.WMWindowPosChanging(var Message: TWMWindowPosChanging);
const
Hide1=(SWP_NOCOPYBITS or SWP_SHOWWINDOW or SWP_FRAMECHANGED or SWP_NOACTIVATE);
Hide2=((SWP_HIDEWINDOW or SWP_NOACTIVATE or SWP_NOZORDER or SWP_NOMOVE or SWP_NOSIZE));
begin
inherited;
if ((Message.WindowPos^.flags AND Hide1) = Hide1)
or ((Message.WindowPos^.flags AND Hide2) = Hide2) then
begin
Memo1.Lines.Add('Window got minimized');
end;
end;
Listen for WM_SIZE notification messages with a wParam parameter of SIZE_MINIMIZED.
Related
Has anyone found a way to detect the mouse back and forward buttons in a Delphi FMX form in Windows (and only Windows)?
I understand this works fine in a VCL application, using
procedure WMAppCommand(var Msg: Winapi.Messages.TMessage); message WM_APPCOMMAND;
but this has no effect in an FMX application.
If anyone already has worked out a solution to this, would very much appreciate a hint (or the code they used, of course).
FMX heavily filters window messages, only dispatching the few messages it actually uses for itself. WM_APPCOMMAND is not one of them, which is why a simple message handler does not work in FMX, like it does in VCL.
So, you are going to have to manually subclass the TForm's Win32 HWND directly, via SetWindowLongPtr(GWLP_WNDPROC) or SetWindowSubclass(), in order to intercept window messages before FMX sees them. See Subclassing controls.
An ideal place to do that subclassing is to override the TForm.CreateHandle() method. You can use FMX's FormToHWND() function to get the TForm's HWND after it has been created.
protected
procedure CreateHandle; override;
...
uses
FMX.Platform.Win, Winapi.Windows, Winapi.CommCtrl;
function MySubclassProc(hWnd: HWND; uMsg: UINT; wParam: WPARAM; lParam: LPARAM;
uIdSubclass: UINT_PTR; dwRefData: DWORD_PTR): LRESULT; stdcall;
begin
case uMsg of
WM_APPCOMMAND: begin
// use TMyForm(dwRefData) as needed...
end;
WM_NCDESTROY:
RemoveWindowSubclass(hWnd, #MySubclassProc, uIdSubclass);
end;
Result := DefSubclassProc(hWnd, uMsg, wParam, lParam);
end;
procedure TMyForm.CreateHandle;
begin
inherited;
SetWindowSubclass(FormToHWND(Self), #MySubclassProc, 1, DWORD_PTR(Self));
end;
procedure InitStandardClasses;
var
ICC: TInitCommonControlsEx;
begin
ICC.dwSize := SizeOf(TInitCommonControlsEx);
ICC.dwICC := ICC_STANDARD_CLASSES;
InitCommonControlsEx(ICC);
end;
initialization
InitStandardClasses;
I want to wait for a WebBrowser control to finish navigation. So i create an Event, and then i want to wait for it to be set:
procedure TContoso.NavigateToEmpty(WebBrowser: IWebBrowser2);
begin
FEvent.ResetEvent;
WebBrowser.Navigate2('about:blank'); //Event is signalled in the DocumentComplete event
Self.WaitFor;
end;
And then i set the event in the DocumentComplete event:
procedure TContoso.DocumentComplete(ASender: TObject; const pDisp: IDispatch; const URL: OleVariant);
var
doc: IHTMLDocument2;
begin
if (pDisp <> FWebBrowser.DefaultInterface) then
begin
//This DocumentComplete event is for another frame
Exit;
end;
//Set the event that it's complete
FEvent.SetEvent;
end;
The problem comes in how to wait for this event to happen.
WaitFor it
First reaction would be to wait for the event to become triggered:
procedure TContoso.WaitFor;
begin
FEvent.WaitFor;
end;
The problem with that is that the DocumentComplete event can never fire, because the application never goes idle enough to allow the COM event to get through.
Busy Sleep Wait
My first reaction was to do a busy sleep, waiting for a flag:
procedure TContoso.NavigateToEmpty(WebBrowser: IWebBrowser2);
begin
FIsDocumentComplete := False;
WebBrowser.Navigate2('about:blank'); //Flag is set in the DocumentComplete event
Self.WaitFor;
end;
procedure TContoso.WaitFor;
var
n: Iterations;
const
MaxIterations = 25; //100ms each * 10 * 5 = 5 seconds
begin
while n < MaxIterations do
begin
if FIsDocumentComplete then
Exit;
Inc(n);
Sleep(100); //100ms
end;
end;
The problem with a Sleep, is that it doesn't allow the application to do idle enough to allow the COM event messages to get through.
Use CoWaitForMultipleHandles
After research, it seems that COM folks created a function created exactly for this situation:
While a thread in a Single-Threaded Apartment (STA) blocks, we will pump certain messages for you. Message pumping during blocking is one of the black arts at Microsoft. Pumping too much can cause reentrancy that invalidates assumptions made by your application. Pumping too little causes deadlocks. Starting with Windows 2000, OLE32 exposes CoWaitForMultipleHandles so that you can pump “just the right amount.”
So i tried that:
procedure TContoso.WaitFor;
var
hr: HRESULT;
dwIndex: DWORD;
begin
hr := CoWaitForMultipleHandles(0, 5000, 1, #FEvent.Handle, {out}dwIndex);
OleCheck(hr);
end;
The problem is that just doesn't work; it doesn't allow the COM event to appear.
Use UseCOMWait wait
i could also try Delphi's own mostly secret feature of TEvent: UseCOMWait
Set UseCOMWait to True to ensure that when a thread is blocked and waiting for the object, any STA COM calls can be made back into this thread.
Excellent! Lets use that:
FEvent := TEvent.Create(True);
function TContoso.WaitFor: Boolean;
begin
FEvent.WaitFor;
end;
Except that doesn't work; because the callback event never gets fired.
MsgWaitForMultipleBugs
So now i start to delve into the awful, awful, awful, awful, buggy, error-prone, re-entrancy inducing, sloppy, requires a mouse nudge, sometimes crashes world of MsgWaitForMultipleObjects:
function TContoso.WaitFor: Boolean;
var
// hr: HRESULT;
// dwIndex: DWORD;
// msg: TMsg;
dwRes: DWORD;
begin
// hr := CoWaitForMultipleHandles(0, 5000, 1, #FEvent.Handle, {out}dwIndex);
// OleCheck(hr);
// Result := (hr = S_OK);
Result := False;
while (True) do
begin
dwRes := MsgWaitForMultipleObjects(1, #FEvent.Handle, False, 5000, QS_SENDMESSAGE);
if (dwRes = WAIT_OBJECT_0) then
begin
//Our event signalled
Result := True;
Exit;
end
else if (dwRes = WAIT_TIMEOUT) then
begin
//We waited our five seconds; give up
Exit;
end
else if (dwRes = WAIT_ABANDONED_0) then
begin
//Our event object was destroyed; something's wrong
Exit;
end
else if (dwRes = (WAIT_OBJECT_0+1)) then
begin
GetMessage(msg, 0, 0, 0);
if msg.message = WM_QUIT then
begin
{
http://blogs.msdn.com/oldnewthing/archive/2005/02/22/378018.aspx
PeekMessage will always return WM_QUIT. If we get it, we need to
cancel what we're doing and "re-throw" the quit message.
The other important thing about modality is that a WM_QUIT message
always breaks the modal loop. Remember this in your own modal loops!
If ever you call the PeekMessage function or The GetMessage
function and get a WM_QUIT message, you must not only exit your
modal loop, but you must also re-generate the WM_QUIT message
(via the PostQuitMessage message) so the next outer layer will
see the WM_QUIT message and do its cleanup as well. If you fail
to propagate the message, the next outer layer will not know that
it needs to quit, and the program will seem to "get stuck" in its
shutdown code, forcing the user to terminate the process the hard way.
}
PostQuitMessage(msg.wParam);
Exit;
end;
TranslateMessage(msg);
DispatchMessage(msg);
end;
end;
The above code is wrong because:
i don't know what kind of message to wake up for (are com events sent?)
i don't know i don't want to call GetMessage, because that gets messages; i only want to get the COM message (see point one)
i might should be using PeekMessage (see point 2)
i don't know if i have to call GetMessage in a loop until it returns false (see Old New Thing)
I've been programming long enough to run away, far away, if i'm going to pump my own messages.
The questions
So i have four questions. All related. This post is one of the four:
How to make WebBrower.Navigate2 synchronous?
How to pump COM messages?
Does pumping COM messages cause COM events to callback?
How to use CoWaitForMultipleHandles
I am writing in, and using Delphi. But obviously any native code would work (C, C++, Assembly, Machine code).
See also
MSDN Blog: Managed Blocking - Chris Brumme
CoWaitForMultipleHandles API doesn't behave as documented
Visual Studio Forums: How to use "CoWaitForMultipleHandles" ?
MSDN: CoWaitForMultipleHandles function
MSDN Blog: Apartments and Pumping in the CLR - Chris Brumme
Which blocking operations cause an STA thread to pump COM messages?
The short and long of it is that you have to pump ALL messages normally, you can't just single out COM messages by themselves (and besides, there is no documented messages that you can peek/pump by themselves, they are known only to COM's internals).
How to make WebBrower.Navigate2 synchronous?
You can't. But you don't have to wait for the OnDocumentComplete event, either. You can busy-loop inside of NavigateToEmpty() itself until the WebBrowser's ReadyState property is READYSTATE_COMPLETE, pumping the message queue when messages are waiting to be processed:
procedure TContoso.NavigateToEmpty(WebBrowser: IWebBrowser2);
begin
WebBrowser.Navigate2('about:blank');
while (WebBrowser.ReadyState <> READYSTATE_COMPLETE) and (not Application.Terminated) do
begin
// if MsgWaitForMultipleObjects(0, Pointer(nil)^, False, 5000, QS_ALLINPUT) = WAIT_OBJECT_0 then
// if GetQueueStatus(QS_ALLINPUT) <> 0 then
Application.ProcessMessages;
end;
end;
How to pump COM messages?
You can't, not by themselves anyway. Pump everything, and be prepared to handle any reentry issues that result from that.
Does pumping COM messages cause COM events to callback?
Yes.
How to use CoWaitForMultipleHandles
Try something like this:
procedure TContoso.NavigateToEmpty(WebBrowser: IWebBrowser2);
var
hEvent: THandle;
dwIndex: DWORD;
hr: HRESULT;
begin
// when UseCOMWait() is true, TEvent.WaitFor() does not wait for, or
// notify, when messages are pending in the queue, so use
// CoWaitForMultipleHandles() directly instead. But you have to still
// use a waitable object, just don't signal it...
hEvent := CreateEvent(nil, True, False, nil);
if hEvent = 0 then RaiseLastOSError;
try
WebBrowser.Navigate2('about:blank');
while (WebBrowser.ReadyState <> READYSTATE_COMPLETE) and (not Application.Terminated) do
begin
hr := CoWaitForMultipleHandles(COWAIT_INPUTAVAILABLE, 5000, 1, hEvent, dwIndex);
case hr of
S_OK: Application.ProcessMessages;
RPC_S_CALLPENDING, RPC_E_TIMEOUT: begin end;
else
RaiseLastOSError(hr);
end;
end;
finally
CloseHandle(hEvent);
end;
end;
Starting from Way of getting control handle from TMessage question, I've created my own implementation in order to replace the Windowproc with my own one, in order to make some processing when mouse left button is pressed.
TOverrideMessage = class
public
FControl: TWinControl;
FOldWndProc: TWndMethod;
procedure OverrideWindowProc(var Message: TMessage);
end;
implementation:
procedure TOverrideMessage.OverrideWindowProc(var Message: TMessage);
begin
if Message.Msg = WM_NCLBUTTONDOWN then
begin
FOldWndProc(Message);
if FControl is TSomeCustomControl then
ShowMessage(TSomeCustomControl(FControl).Caption);//this property exists
end
else
Dispatch(Message);
end;
And replace the windowprocs of each of the controls I want with an instance of my class:
LOverrideMessage := TOverrideMessage.Create;
LOverrideMessage.FControl := TSomeCustomControl(lControl4);
LOverrideMessage.FOldWndProc := TWinControl(lControl4).WindowProc;
TWinControl(lControl4).WindowProc := LOverrideMessage.OverrideWindowProc;
The problem I have is that the messages are not dispatched correctly further to the controls so the controls are not drawing correctly,etc. Also I'm not receiving the WM_NCLBUTTONDOWN message in the class implementation. What's wrong?
Your main problem is the failure to call FOldWndProc. You need to call that rather than Dispatch. When you call Dispatch you will get the base TObject handling, which does nothing.
procedure TOverrideMessage.OverrideWindowProc(var Message: TMessage);
begin
FOldWndProc(Message);
if Message.Msg = WM_NCLBUTTONDOWN then
if FControl is TSomeCustomControl then
ShowMessage(TSomeCustomControl(FControl).Caption);//this property exists
end;
If WM_NCLBUTTONDOWN doesn't arrive, then the message is not being sent to your control.
I am concerned by your casting. When you write:
LOverrideMessage.FControl := TSomeCustomControl(lControl4);
LOverrideMessage.FOldWndProc := TWinControl(lControl4).WindowProc;
TWinControl(lControl4).WindowProc := LOverrideMessage.OverrideWindowProc;
why do you need any of those casts? If lControl4 was derived from TWinControl then you would not need those casts. If lControl4 has a compile time type that is less derived, then at least include an is check.
When I try to use the Windows SetTimer function, it generate a IDEvent for the timer even if I have specified one!
This:
SetTimer(0,999,10000,#timerproc);
In:
procedure timerproc(hwnd: HWND; uMsg: UINT; idEvent: UINT_PTR;dwTime: DWORD); stdcall;
begin
KillTimer(0, idEvent);
showmessage(inttostr(idevent));
end;
Return:
Random Number!
Is it possible to manage my timers by myself instead of Windows choosing for me?
Thank you very much!
If you want to handle multiple timer events in a single routine, then handle it by specific window rather then by specific routine:
type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
private
FTimerWindow: HWND;
procedure TimerProc(var Msg: TMessage);
end;
...
procedure TForm1.FormCreate(Sender: TObject);
begin
FTimerWindow := Classes.AllocateHWnd(TimerProc);
SetTimer(FTimerWindow, 999, 10000, nil);
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
Classes.DeallocateHWnd(FTimerWindow);
end;
procedure TForm1.TimerProc(var Msg: TMessage);
begin
if Msg.Msg = WM_TIMER then
with TWMTimer(Msg) do
case TimerID of
999:
//
else:
//
end;
end;
SetTimer will work differently, depending upon whether you are passing a window handle to it or not.
Timer_Indentifier := SetTimer(0, MyIdentifier, Time, #myproc);
In the above instance, Timer_Identifier does NOT equal MyIdentifier.
Timer_Indentifier := SetTimer(handle, MyIdentifier, Time, #myproc);
In the second example, Timer_Identifier = MyIdentifier.
This is because in the second example, your windows loop will need to use "MyIdentifier" to find out which timer is sending a "WM_Timer" message to it.
Using a specific Timer function, with no Window Handle, is different. The short answer is that in your scenario, use the value that Windows gives you.
http://msdn.microsoft.com/en-us/library/windows/desktop/ms644906%28v=vs.85%29.aspx
Multimedia Timer solved my problem!
I can pass whatever I want to them with dwUser:)
MMRESULT timeSetEvent(
UINT uDelay,
UINT uResolution,
LPTIMECALLBACK lpTimeProc,
DWORD_PTR dwUser,
UINT fuEvent
);
From MSDN : dwUser -> User-supplied callback data.
They have a TIME_ONESHOT option which is exactly what I use timers for!
I Delphi, I need a function which determinates if the system menu (resp. window menu, the menu that appears when the icon is clicked) is opened. The reason is that I am writing a anti-keylogger functionality which sends garbage to the current active editcontrol (this also prevents keylogger which read WinAPI messages to read the content). But if system-menu is opened, the editcontrol STILL has the focus, so the garbage will invoke shortcuts.
If I use message WM_INITMENUPOPUP in my TForm1, I can determinate when the system menu opens, but I wish that I do not have to change the TForm, since I want to write a non visual component, which does not need any modifications at the TForm-derivate-class itself.
//I do not want that solution since I have to modify TForm1 for that!
procedure TForm1.WMInitMenuPopup(var Message: TWMInitMenuPopup);
begin
if message.MenuPopup=getsystemmenu(Handle, False) then
begin
SystemMenuIsOpened := true;
end;
end;
TApplicaton.HookMainWindow() does not send the WM_INITMENUPOPUP to my hook function.
function TForm1.MessageHook(var Msg: TMessage): Boolean;
begin
Result := False;
if (Msg.Msg = WM_INITMENUPOPUP) then
begin
// Msg.Msg IS NEVER WM_INITMENUPOPUP!
if LongBool(msg.LParamHi) then
begin
SystemMenuIsOpened := true;
end;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Application.HookMainWindow(MessageHook);
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
Application.UnhookMainWindow(MessageHook);
end;
Even after very long research I did not found any information about how to query if the system-menu is opened or not. I do not find any way to determinate the opening+closing of that menu.
Has someone a solution for me please?
Regards
Daniel Marschall
Application.HookMainWindow doesn't do what you seem to think. It hooks the hidden application window, not the main form. To intercept WM_INITMENUPOPUP on a specific form, all you need to do is write a handler for it, as you have seen.
To do this generically for any owner form of a component, you could assign WindowProc property of the form to place the hook:
unit FormHook;
interface
uses
Windows, Classes, SysUtils, Messages, Controls, Forms;
type
TFormMessageEvent = procedure(var Message: TMessage; var Handled: Boolean) of object;
TFormHook = class(TComponent)
private
FForm: TCustomForm;
FFormWindowProc: TWndMethod;
FOnFormMessage: TFormMessageEvent;
protected
procedure FormWindowProc(var Message: TMessage); virtual;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property OnFormMessage: TFormMessageEvent read FOnFormMessage write FOnFormMessage;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Test', [TFormHook]);
end;
procedure TFormHook.FormWindowProc(var Message: TMessage);
var
Handled: Boolean;
begin
if Assigned(FFormWindowProc) then
begin
Handled := False;
if Assigned(FOnFormMessage) then
FOnFormMessage(Message, Handled);
if not Handled then
FFormWindowProc(Message);
end;
end;
constructor TFormHook.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FFormWindowProc := nil;
FForm := nil;
while Assigned(AOwner) do
begin
if AOwner is TCustomForm then
begin
FForm := TCustomForm(AOwner);
FFormWindowProc := FForm.WindowProc;
FForm.WindowProc := FormWindowProc;
Break;
end;
AOwner := AOwner.Owner;
end;
end;
destructor TFormHook.Destroy;
begin
if Assigned(FForm) and Assigned(FFormWindowProc) then
begin
FForm.WindowProc := FFormWindowProc;
FFormWindowProc := nil;
FForm := nil;
end;
inherited Destroy;
end;
end.
You could then use this component on a form:
procedure TForm1.FormHook1FormMessage(var Message: TMessage; var Handled: Boolean);
begin
case Message.Msg of
WM_INITMENUPOPUP:
...
end;
end;
The problem might be that if the form has any other components which do the same thing then you need to make sure that unhooking happens in reverse order (last hooked, first unhooked). The above example hooks in the constructor and unhooks in the destructor; this seems to work even with multiple instances on the same form.
If you don't want any modifications to TForm-derivate-class, why don't try pure Windows API way to implement your current solution, that is, use SetWindowLongPtr() to intercept the WM_INITMENUPOPUP message. Delphi VCL style to intercept messages is just a wrapper of this Windows API function actually.
For that purpose, use SetWindowLongPtr() to set a new address for the window procedure and to get the original address of the window procedure, both at one blow. Remember to store the original address in a LONG_PTR variable. In 32-bit Delphi, LONG_PTR was Longint; supposing 64-bit Delphi will have been released in the future, LONG_PTR should be Int64; you can use $IFDEF directive to distinguish them as follows:
Type
{$IFDEF WIN32}
PtrInt = Longint;
{$ELSE}
PtrInt = Int64;
{$ENDIF}
LONG_PTR = PtrInt;
The value for nIndex parameter to be used for this purpose is GWLP_WNDPROC. Also, pass the new address for the window procedure to dwNewLong parameter, e.g. LONG_PTR(NewWndProc). The NewWndProc is a WindowProc Callback Function that processes messages, it is where your put your intercept criteria and override the default handling of the message you are going to intercept. The callback function can be any name, but the parameters must follow the WindowProc convention.
Note that you must call CallWindowProc() to pass any messages not processed by the new window procedure to the original window procedure.
Finally, you should call SetWindowLongPtr() again somewhere in your code to set the address of modified/new window procedure handler back to the original address. The original address has been saved before as mentioned above.
There was a Delphi code example here. It used SetWindowLong(), but now Microsoft recommends to use SetWindowLongPtr() instead to make it compatible with both 32-bit and 64-bit versions of Windows.
SetWindowLongPtr() didn't exist in Windows.pas of Delphi prior to Delphi 2009. If you use an older version of Delphi, you must declare it by yourself, or use JwaWinUser unit of JEDI API Library.
Not tried this myself, but give this a shot:
Use GetMenuItemRect to get the rect for item 0 of the menu returned by GetSystemMenu.
I (assume!) GetMenuItemRect should return 0 if the system menu is not open (because system could not know the rect of the menu item unless it is open?) If the result is non-zero, check if the coords returned are possible for the given screen resolution.
If you have the time, you could look into AutoHotKey's source code to see how to monitor when system menu is open/closed.