Capturing all windows messages to an application - delphi

Is there a global WinProc for all windows in an application or a way to capture all paint messages to the application for a brief period of time? Some of the third party libraries that we use add their own wndproc's to controls (e.g. DevExpress ribbon, Docking Manager).
We have some code that should be run in a background thread but that's not possible at the moment. This code can take a long time to run and obviously the application becomes unresponsive during this time. We can't use things like processmessages because that would result in the code being reentered. To get around this I thought it should be possible to create our own version of ProcessMessages that looks for specific messages. The idea is that I would create a small panel with a progress bar and a cancel button and then only allow messages for the cancel button's windows handle.
The simplified code to process a single message looks something like this:
begin
if PeekMessage(aMsg, 0, 0, 0, PM_NOREMOVE) then
begin
Unicode := (aMsg.hwnd = 0) or IsWindowUnicode(aMsg.hwnd);
if Unicode then
MsgExists := PeekMessageW(aMsg, 0, 0, 0, PM_REMOVE)
else
MsgExists := PeekMessageA(aMsg, 0, 0, 0, PM_REMOVE);
if MsgExists then
begin
Result := True;
if aMsg.hwnd = aButtonWindowsHandle then
begin
TranslateMessage(aMsg);
if Unicode then
DispatchMessageW(aMsg)
else
DispatchMessageA(aMsg);
end
else
begin
// WM_PAINT is a special message. If you don't handle a WM_PAINT
// then windows will just stick it back in the queue again.
if (aMsg.message = WM_PAINT) and (aMsg.hwnd <> 0) then
begin
// Queue this paint message so we do an update when the
// processing is finished.
FQueuedPaintMessages.Add(aMsg);
// Paint nothing here otherwise Windows will send it again and
// insist that we paint it.
if BeginPaint(aMsg.hwnd, paintStruct) <> 0 then
EndPaint(aMsg.hwnd, paintStruct);
end;
end;
end;
end;
end;
This is called as follows:
while ProcessMessage(msg) do {loop};
This appeared to work correctly but during testing I picked up a couple of cases where one of the Windows API calls (PeekMeesage, TranslateMessage, DispatchMessage, or the two painting calls) is triggering a call back to our docking control's WndProc via KiUserCallbackDispatcher in ntdll.dll. The docking control is ultimately triggering a paint which is a problem. I am not sure what Windows API call it is because the stack trace is missing some lines at that point. It only happens on one of our test machines so I can't put in a breakpoint.
I am aware that this is far from an ideal solution and that we would be better off rewriting the code so that it can be run in a background thread but that would be a huge amount of work and is not feasible at this time.
It looks like SetWindowsHookEx with WH_MOUSE_LL might be a solution but that still needs a message loop.

Not so much an answer to your question than maybe a potential solution to your problem...
Instead of having a panel with a "cancel" button, instead display a label saying "Press and hold ESC to cancel process". Then, within your process you can get the status of the ESC key by calling GetAsyncKeyState at regular interval. I did not test it, but I'd expect it to work at least "well enough" for your needs.

The selected answer gave me a solution to my problem but #IInspectable answered the question about catching all of the paint messages. So for other people looking at that question. The answer is this:
"None of this can be made to work reliably with reasonable effort. It's just a clumsy attempt at fighting the system, and the system is going to win that one."
In other words. Don't try and do it.

Related

Delphi - Hide Window By its Title

I'm looking for a code that can hide the window (visibility = false ) by its title. (and i'm not looking for killing task)
I've already a code that brings me handle parent, then I can send a Showwindow(number of handle, sw_hide); to the external application.
but now i'm searching for something faster ...
I've a code that can kill a window by its title : if we can modify it to hide the window it will be good.
begin
PID := FindProcessByTitle('Form1');
if PID <> 0 then
begin hProcess := OpenProcess(PROCESS_TERMINATE, FALSE, PID);
if hProcess <> 0 then begin TerminateProcess(hProcess,0); CloseHandle(hProcess);
end;
This is relatively simple. Take the following steps:
Use FindWindow or FindWindowEx or EnumerateWindows to locate your window.
Use ShowWindow to hide the window.
You already know about ShowWindow so presumably the problem is with item 1. But then again you apparently already know how to obtain a PID from a window title which would imply that you have, as part of that process, been able to find the window handle.
So, take your existing code and modify FindProcessByTitle to return a window handle rather than the PID.
You also mention that you want your code to run faster. The process described above should execute extremely quickly. If your code is slow, we can't really advise on how to improve its speed (if indeed that is possible) without sight of the actual code.
In short, I should probably not have answered the question in its current form, and instead asked that you improve the question first.

Delphi 7, Windows 7, event handler, re-entrent code

I've got some very old code (15+yr) that used to run ok, on older slower machines with older software versions. It doesn't work so well now because if fails a race condition. This is a general question: tell me why I should have known and expected the failure in this code, so that I can recognise the pattern in other code:
procedure TMainform.portset(iComNumber:word);
begin
windows.outputdebugstring(pchar('portset ' + inttostr(icomnumber)));
with mainform.comport do
try
if open then open := False; // close port
comnumber:=iComNumber;
baud:=baudrate[baudbox.itemindex];
parity:=pNone;
databits:=8;
stopbits:=1;
open:=true;
flushinbuffer;
flushoutbuffer;
if open then mainform.statusb.Panels[5].text:=st[1,langnum] {Port open}
else mainform.statusb.Panels[5].text:=st[2,langnum]; {port set OK}
except
on E: exception do begin
windows.OutputDebugString('exception in portset');
mainform.statusb.Panels[5].text:=st[3,langnum];
beep;
beep;
end;
end;
windows.outputdebugstring('portset exit');
end;
Note that flushinbuffer is protected with EnterCriticalSection(); AFAIK Nothing else is protected, and AFAIK there are no message handling sections. BUT
When this code is called from a click event, it gets part way through, then is interupted by a paint event.
The only tracing I have done is with outputdebugstring. I can see the first string repeated on entry before the second string is shown on exit. Is that real, or is it an illusion?
The trace looks like this:
4.2595 [4680] graph form click event
4.2602 [4680] portset 1 'from click event handler'
4.2606 [4680] graph form paint event
4.2608 [4680] portset 1 'from paint event handler'
4.2609 [4680] portset exit
4.3373 [4680] portset exit
This is a race condition: The paint event handler of the form is called before the click event handler code finishes, which causes failures. Serial code is AsyncPro. No thread code. Yes, there is more code, no it doesn't do anything in particular before "portset 1" but it does write to a form before it gets there:
with graphform do begin
if not waitlab.Visible then begin
waitlab.visible:=true;
waitprogress.position:=0;
waitprogress.visible:=true;
waitprogress.max:=214;
end;
end;
mainform.Statusb.panels[5].text:=gcap[10,langnum];
Don't hold back: What is it doing wrong, what should I be looking for?
This is expected behaviour - opening or closing a TApdComPort will service the message queue, specifically by calling a function it names SafeYield:
function SafeYield : LongInt;
{-Allow other processes a chance to run}
var
Msg : TMsg;
begin
SafeYield := 0;
if PeekMessage(Msg, 0, 0, 0, PM_REMOVE) then begin
if Msg.Message = wm_Quit then
{Re-post quit message so main message loop will terminate}
PostQuitMessage(Msg.WParam)
else begin
TranslateMessage(Msg);
DispatchMessage(Msg);
end;
{Return message so caller can act on message if necessary}
SafeYield := MAKELONG(Msg.Message, Msg.hwnd);
end;
end;
The TApdComPort is an async component - the com port is managed on background threads and opening or closing the port requires either starting or signaling those threads to stop. While waiting for them to free the component services the message queue in case it takes some time for things to synchronize (for example) :
if Assigned(ComThread) then
begin
{Force the comm thread to wake...}
FSerialEvent.SetEvent;
{... and wait for it to die}
ResetEvent(GeneralEvent);
while (ComThread <> nil) do
SafeYield;
end;
You haven't really show us enough of your own code to say why this is problematic in your case, however. I think David's point about com ports being manipulated in a paint handler is valid... we need to see the broader picture and what, exactly, the problem is that you are having.
A standard paint event cannot happen on its own, it can only be triggered by message retrieval. So the only way the code you showed could be interrupted the way you describe is if either the Serial component itself, or an event handler you have assigned to it, is doing something that pumps the calling thread's message queue for new messages.
Since you are closing the port in the beginning of your event handler, if there is any chance of triggering the event twice (i.e. by calling Application.ProcessMessages anywhere from your code, or calling TMainform.portset() directly from a worker thread), the new instance will close your port while the older one tries to communicate trough it, which will result in an error. AFAIS there are two solutions:
The faster but least bearable one is to protect your entire function with a Mutex (or event which is not a syncronisation object but can be used as one), but this only hides the coding error you have made.
The more pro solution is to find where the race condition gets raised, then fix your code. You can do it by searching all references to Application.ProcessMessages() and TMainform.portset(), and make sure that they won't get called paralelly. If no reference can be found on either mentioned function, the problem could still be caused by running multiple instances of your code ('cause it will not create multiple com ports :) ).
Remy Lebeau gets the credit for answering the question, because, as I asked for, it was a general reply to a general question. But it would have been inadequate without his comments in response to Uwe Raabe.
And what conclusively demonstrated that Remy Lebeau was correct was the exceptional answer from J, pointing out the specific point where the code failed.
Thanks also to David Heffernan for asking "why does code that responds to WM_PAINT call portset", which also makes a general point. And yes, the quick fix was just to block the path from the paint event handler to the comms code, but I'd done that without recognising the more general point.
I'll be having a look at the comms code, to see if there are more problems like this, and I'll be looking at the event handlers, to see if there are more problems like this, so thanks to everyone who read and considered the question.

Delphi idle handler only fires when I move the mouse

I have an OnIdle handler in my D2006 app. With this code:
procedure TMainForm.ApplicationEvents1Idle(Sender: TObject; var Done: Boolean);
begin
Inc (IdleCalls) ;
Sleep (10) ;
Done := False ;
end ;
the app runs smoothly, the idle handler is called 100 times per second, and the CPU usage is next to zero.
I then added a TActionList and connected up some controls to actions, coded an Execute and Update handler.
procedure TMainForm.ActionNewButtonExecute(Sender: TObject);
begin
DoNewProject ;
end ;
procedure TMainForm.ActionNewButtonUpdate(Sender: TObject);
begin
ActionNewButton.Enabled := AccessLevelIsSupervisor ;
end;
Problem. The OnUpdate event doesn't fire. On a hunch I set Done := true in the OnIdle handler and the OnIdle handler is then only called when I move the mouse. And the Update action still doesn't fire.
Why might the Update handler not be firing, and should I set Done to true or false? Or both?
Use the source, Luke. :)
Look at the Forms unit, specifically TApplication.Idle. It contains, in part, the following:
Done := True;
try
if Assigned(FOnIdle) then FOnIdle(Self, Done);
if Done then
if FActionUpdateDelay <= 0 then
DoActionIdle
// Excluded to avoid copyright violation
// See also the else portion, which contains (in part)
else
if IdleTimerHandle = 0 then
begin
IdleTimerHandle := SetTimer(0, 0, FActionUpdateDelay, IdleTimerDelegate);
if IdleTimerHandle = 0 then
DoActionIdle
end;
finally
// Omitted
end;
As you can see, DoActionIdle is only called when either Done = True and FActionUpdateDelay <= 0 or IdleTimerHandle = 0. DoActionIdle (also part of TApplication) is what calls UpdateAction. So if neither of the above conditions are met, TAction.OnUpdate is never called.
There's a separate method, TApplication.DoMouseIdle, that you may want to peruse as well.
As mentioned in the comments, Sleep in the idle handler will do no good, also the bacground processing will stall if there is no activity on the application.
You can however lower the CPU usage w/o much disturbing effects: After processing all OnIdle events, the application will call WaitMessage (which will sleep while the message queue is empty), if the Done parameter is True - you can just unconditionally set it in your handler.
As for background processing, use either a thread and call back to the main thread via Synchronize or, if you really-really have to, use a timer and don't ever forget to handle reentrancy (both solutions will by the way wake the application even while WaitMessage).
Get rid of that OnIdle event handler, you accepted it is there just in case.
If you later need to perform background tasks, learn how to use threads. To get a specific frequency, you're allowed to use sleep or any other technique within a thread.
My advice is in this way because, as you see, that way of do things is interfering with other parts of your application. If it is a bug in the TApplication, I don't know, maybe it is. If you want to investigate more, make a copy of your project, check everything and if you think this have to work another way, fill a QC entry about that.
I was looking the XE source code and it seems Ok, they set an event to update the actions if the Idle event is not done.. I don't see a bug there. I have no pre-2010 ready installations to check ancient versions.

Get window to refresh (etc) without calling Application.ProcessMessages?

I've got a legacy app here that has a few 'time-consuming' loops that get fired off as a result of various user interaction. The time-consuming code periodically updates something on the screen with progress information (typically a label) and then, seemingly to persuade the visual refresh to happen there-and-then, the code calls Application.ProcessMessages (argh!).
We all know now what kind of trouble this can introduce to a GUI app (being charitable, it was a more innocent time back then) and we're finding that sure as eggs, from time to time we get users achieving the impossible with the program because they're clicking on controls while the program is 'busy'.
What's the best way of periodically refreshing the visuals of the form without taking-on other events/messages etc?
My thoughts were to either;
- disable all of the controls before doing anything time-consuming, and leaving the '...ProcessMessages' calls in place to 'force' the refresh, or
- find another way to refresh a control periodically
I can do the former but it left me wondering - is there a better solution?
example code from legacy;
i:=0;
while FJobToBeDone do
begin
DoStepOfLoop;
inc(i);
if i mod 100 = 0 then
begin
UpdateLabelsEtc;
Application.ProcessMessages;
end;
end;
I can already hear you all fainting, at the back. :-)
If you call Update() on the controls after you have changed properties you will force them to redraw. Another way is to call Repaint() instead of Refresh(), which implies a call to Update().
You may need to call Update() on parent controls or frames as well, but this could allow you to eliminate the ProcessMessages() call completely.
The solution I use for long updates is by doing the calculations in a separate thread. That way, the main thread stays very responsive. Once the thread is done, it sends a Windows message to the main thread, indicating the main thread can process the results.
This has some other, severe drawbacks though. First of all, while the other thread is active, you'll have to disable a few controls because they might restart the thread again.
A second drawback is that your code needs to become thread-safe. This can be a real challenge sometimes. If you're working with legacy code, it's very likely that your code won't be thread-safe.
Finally, multi-threaded code is harder to debug and should be done by experienced developers.
But the big advantage of multi-threading is that your application stays responsive and the user can just continue to do some other things until the thread is done. Basically, you're translating a synchronous method into an asynchronous function. And the thread can fire several messages indicating certain controls to refresh their own data, which would be updated immediately, on the fly. (And at the moment when you want them to be updated.)
I've used this technique myself quite a few times, because I think it's much better. (But also more complex.)
Do not call Application.Processmessages, This is slow and might generate unlimited recursion.
For example, to update everything in Panel1 without flick, we can use this method:
procedure TForm1.ForceRepaint;
var
Cache: TBitmap;
DC: HDC;
begin
Cache := TBitmap.Create;
Cache.SetSize(Panel1.Width, Panel1.Height);
Cache.Canvas.Lock;
DC := GetDC(Panel1.Handle);
try
Panel1.PaintTo(Cache.Canvas.Handle, 0, 0);
BitBlt(DC, 0, 0, Panel1.Width, Panel1.Height, Cache.Canvas.Handle, 0, 0, SRCCOPY);
finally
ReleaseDC(Panel1.Handle, DC);
Cache.Canvas.Unlock;
Cache.Free;
end;
end;
For better performance, the cache bitmap should be created at first and free when the process has finished
The technique you're looking for is called threading. It is a diffucult technique in programming. The code should be handled with care, because it is harder to debug. Whether you go with threading or not, you should definitely disable the controls that users should not mess with (I mean the controls that can effect the ongoing process). You should consider using actions to enable/disable buttons etc...
Rather than disable the controls, we have a boolean var in the form FBusy, then simply check this when the user presses a button, we introduced it for the exact reasons you mention, users clicking buttons while they wait for long running code to run (it scary how familiar your code sample is).
So you end up with something like
procedure OnClick(Sender:TObejct);
begin
if (FBusy) then
begin
ShowMessage('Wait for it!!');
Exit;
end
else FBusy := True;
try
//long running code
finally
FBusy := False;
end;
end;
Its impotent to remember to rap the long running code up in a try-finally block in case of exits or exception, as you would end up with a form that will not work.
As suggested we do use threads if its for code that will not affect the data, say running a report or data analysis, but some things this is not an options, say if we are updating 20,000 product records, then we don't want anyone trying to sell or other wise altering the records mid flight, so we have to block the application until it is done.

Detect if an application is not in use

How can I detect if an application is not used for more than x minutes in DELPHI
If you write Windows app take a look at GetLastInputInfo function.
Here is some code that looks for mouse and keybord activity with the applicatin
procedure TUserActivity.AppMessage(var Msg: TMsg; var Handled: Boolean);
begin
Handled := False;
case Msg.message Of
WM_KEYDOWN,
WM_LBUTTONDOWN,
WM_MBUTTONDOWN,
WM_RBUTTONDOWN:
Activity := TRUE;
WM_MOUSEMOVE:
begin
if (LastXYPos <> Msg.lParam) then
Activity := True;
LastXYPos := Msg.lParam;
end;
end;
end;
Use the Application.OnIdle event:
Write an OnIdle event handler to perform special processing when an application is idle. An application is idle when it is not processing code. For example, an application is idle when it is waiting for input from the user. 
OnIdle is called only once, as the application transitions into an idle state. It is not called continuously unless Done is set to false. Applications that set Done to false consume an inordinate amount of CPU time, which affects overall system performance.
Use either a timer or GetLastInputInfo as #aku suggests in this event to determine if you can start your maintenance without interrupting the user
Use the applications OnDeactivate and onActive events..
That way you can abort the longrunning job if the user activates your program again.
ex:
Application.OnDeactivate = yourDeactivProcedure;
procedure mainform.YourDecativateProcedure (sender : tObject);
begin
// do your job..
end;
To handle the activate event to abort you either have to do it a bad way with a sleep and after the sleep check if i global vairable has been set.
Or you can have a theared object that does the loongrunning job.
Which I would say is much better. You can set the loongrunningjobs priority to low and it wont affect your program as much,
Depends on how you're defining "used" -- if you were monitoring yourself, you could look at the last time you responded to user interaction by logging it when it happened (mouse move/key pressed/menu event fired/etc.). Monitoring another application is tricky as it'll be harder to define that it is "in use".
That really depends on the application and what it does. While users may not interact with it in the sense of new input, they certainly might be viewing the client area that is visible.
Also - you don't say if you want to detect this internal to the app or external to the app.
Simple methods
see if it has current focus.
check if the window is visible
lots of others too, but they rely on the app itself.
You must define what you mean by "used" as well. It could mean different things and that would make significant changes to how you determine whether it met your criteria or not.

Resources