You might be able to use the paint event for your form(s) but this will only work if the form is not completely visible when it is reactivated so it's probably not what you're looking for. JHall
there is a mousecursor api that can do this
it worked for me
just check the code in the first timer
it picks up the form only
'This project needs
'a Form, called 'Form1'
'a Picture Box, called 'ExplButton' (50x50 pixels)
'a Picture Box with an icon in it, called 'picIcon'
'two timers (Timer1 and Timer2), both with interval 100
'Button, called 'Command1'
'In general section
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Type POINTAPI
X As Long
Y As Long
End Type
'Declare the API-Functions
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function SetCursorPos Lib "user32" (ByVal X As Long, ByVal Y As Long) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Sub DrawButton(Pushed As Boolean)
Dim Clr1 As Long, Clr2 As Long
If Pushed = True Then
'If Pushed=True then clr1=Dark Gray
Clr1 = &H808080
'If Pushed=True then clr1=White
Clr2 = &HFFFFFF
ElseIf Pushed = False Then
'If Pushed=True then clr1=White
Clr1 = &HFFFFFF
'If Pushed=True then clr1=Dark Gray
Clr2 = &H808080
End If
With Form1.ExplButton
' Draw the button
Form1.ExplButton.Line (0, 0)-(.ScaleWidth, 0), Clr1
Form1.ExplButton.Line (0, 0)-(0, .ScaleHeight), Clr1
Form1.ExplButton.Line (.ScaleWidth - 1, .ScaleHeight - 1)-(.ScaleWidth - 1, 0), Clr2
Form1.ExplButton.Line (.ScaleWidth - 1, .ScaleHeight - 1)-(0, .ScaleHeight - 1), Clr2
End With
End Sub
Private Sub Command1_Click()
Dim Rec As RECT
'Get Left, Right, Top and Bottom of Form1
GetWindowRect Form1.hwnd, Rec
'Set Cursor position on X
SetCursorPos Rec.Right - 15, Rec.Top + 15
End Sub
Private Sub ExplButton_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
DrawButton True
End Sub
Private Sub ExplButton_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
DrawButton False
End Sub
Private Sub ExplButton_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
DrawButton False
End Sub
Private Sub Form_Load()
'KPD-Team 1998
'URL:
Dim Stretched As Boolean
'picIcon.Visible = False
'API uses pixels
picIcon.ScaleMode = vbPixels
'No border
ExplButton.BorderStyle = 0
'API uses pixels
ExplButton.ScaleMode = vbPixels
'Set graphic mode te 'persistent graphic'
ExplButton.AutoRedraw = True
'API uses pixels
Me.ScaleMode = vbPixels
'Set the button's caption
Command1.Caption = "Set Mousecursor on X"
' If you set Stretched to true then stretch the icon to te Height and Width of the button
' If Stretched=False, the icon will be centered
Stretched = False
If Stretched = True Then
' Stretch the Icon
ExplButton.PaintPicture picIcon.Picture, 1, 1, ExplButton.ScaleWidth - 2, ExplButton.ScaleHeight - 2
ElseIf Stretched = False Then
' Center the picture of the icon
ExplButton.PaintPicture picIcon.Picture, (ExplButton.ScaleWidth - picIcon.ScaleWidth) / 2, (ExplButton.ScaleHeight - picIcon.ScaleHeight) / 2
End If
' Set icon as picture
ExplButton.Picture = ExplButton.Image
End Sub
Private Sub Timer1_Timer()
Dim Rec As RECT, Point As POINTAPI
' Get Left, Right, Top and Bottom of Form1
GetWindowRect Me.hwnd, Rec
' Get the position of the cursor
GetCursorPos Point
' If the cursor is located above the form then
If Point.X >= Rec.Left And Point.X <= Rec.Right And Point.Y >= Rec.Top And Point.Y <= Rec.Bottom Then
Me.Caption = "MouseCursor is on form."
Else
' The cursor is not located above the form
Me.Caption = "MouseCursor is not on form."
End If
End Sub
Private Sub Timer2_Timer()
Dim Rec As RECT, Point As POINTAPI
' Get Left, Right, Top and Bottom of ExplButton
GetWindowRect ExplButton.hwnd, Rec
' Get the position of the cursor
GetCursorPos Point
' If the cursor isn't located above ExplButton then
If Point.X < Rec.Left Or Point.X > Rec.Right Or Point.Y < Rec.Top Or Point.Y > Rec.Bottom Then ExplButton.Cls
End Sub
I had thought about the mouse move event as well, the problem was it wouldn't activate if you tabbed from 1 app to the other. Craig, mailto:sander@cogeco.ca
"Procrastination is the art of keeping up with yesterday."
Have not yet tried the above answer, but will have a look at it some time. The Paint event works fine for my app. I wonder if there is an API for finding which is the active application? Returns the pID?
You could have a timer event on that function.
Actually, speaking of that, is there any way to put programatic "Watches" on variables without using a timer? For example.
IF Changes(X) THEN RaiseEvent
???
This is something that I have found lacking in VB and wondered whether it is something I'm missing. The current User Event system in VB6 is not much more than a different way of calling a sub routine.
Public Declare Function GetActiveWindow Lib "user32" Alias "GetActiveWindow" () As Long
That will tell you which is the active window. The only problem is how are you then going to trigger this code. You could set it on a timer, though this may have sstem resources overhead. Craig, mailto:sander@cogeco.ca
"Procrastination is the art of keeping up with yesterday."
One way of doing this is to consider subclassing. Here is some example code that I've put together. Drop it into a module: [tt]
Option Explicit
Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
' Private copy of original windows procedure
Private lpPrevWndProc As Long
Public Sub Hook(hWnd As Long)
' Begin hooking into messages. Warning: never try and debug application
' whilst hook is in place as IDE will terminate.
lpPrevWndProc = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf WindowProc)
End Sub
Public Sub Unhook(hWnd As Long)
'Cease hooking into messages.
SetWindowLong hWnd, GWL_WNDPROC, lpPrevWndProc
End Sub
Public Function WindowProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
' Check whether form/application is activating or deactivating
Select Case uMsg
Case WM_ACTIVATEAPP
If wParam = WINDOW_ACTIVATING Then
Debug.Print "Activated" ' You use whatever code you want here
ElseIf wParam = WINDOW_DEACTIVATING Then
Debug.Print "Deactivated" ' You use whatever code you want here
End If
Case Else
End Select
' Now pass the message to Windows for normal processing.
WindowProc = CallWindowProc(lpPrevWndProc, hWnd, uMsg, wParam, lParam)
End Function [/tt]
Now add a form to your project and drop in the following code: [tt]
Option Explicit
Private Sub Form_Load()
' Hook for this form only
'Hook Me.hwnd
' Hook for whole VB application, using fact that ALL windows in a vb application
' are actually owned by a tiny hidden window
Hook GetWindowLong(Me.hWnd, GWL_HWNDPARENT)
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
' Unhook for this form only
'Unhook Me.hwnd
' Unhook for application
Unhook GetWindowLong(Me.hWnd, GWL_HWNDPARENT)
End Sub
Windows is fundamentally a message-based operating system. What we mean by this is that when the operating system wishes to communicate with an application (or even when two applications wish to communicate with each other) it does so by sending messages using the SendMessage API. Obviously developers may implement additional methods of communication between their applications, but at the OS level this is how things work.
Each window (in principal every widget you get on the screen from lowly labels to more complex things such as treeviews is at its core merely a window) and the OS itself has its own message queue to which messages are sent, and a default windows procedure which extracts messages sequentially from that queue, figures out whether it needs to respond to the message and takes the appropriate action that has been coded for that message (incidentally, the sequential nature of the message queue is one of the reasons that you cannot absolutely rely on Timer control events actually occurring at the interval you specify; what actually happens is that the Timer posts a Timer event message in the hosting form's message queue. If there are a pile of messages already in the queue that Timer event message won't get processed until all the ones in front of it have ben dealt with).
Now, one of the design goals in VB was to hide away all this nasty message sending and processing from the VB developer; it all happens in the background. Some of these background messages are exposed to you as VB events, but only ones that Microsoft felt disposed to expose, and often only in a limited sense.
Okey dokey, so what happens if we really, really want to deal with the underlying messages that the OS is throwing about?Essentially what we need to do is somehow hook into a window's message processing, prefererably inserting that hook prior to the default processing so we can intercept and act on messages before the window we are hooking has a chance to. This technique is known as subclassing.
But how do we do it? Well, each window is represented in memory by a standard structure (a bit like a VB Type). Part of that structure contains the address of that window's WindowProcedure, which is what recieves and processes the messages the window is sent. So we need to somehow change that address so that it points to a procedure of our own. Of course we probably don't want to handle every single possible message, so we also want to make sure that we remember the original WindowProcedure address so that we can pass on all those messages we are not interested in (often we will also want to pass on the message or messages we were interested in as well, since we may just be adding some functionality but still want the default procesing to occur as well).
This used to be rather tricky to achieve in VB, as there was no way to get the address of a VB procedure or function. We used to have to rely on 3rd party DLLs written in C or C++ (The one I used to use was called MessageHook, which pretty much describes exactly what it did). But the introduction of the unary AddressOf operator, introduced in VB 5, changed all that. Whilst the VB documentation implies that Microsoft were expecting people to use it for working with callbacks (a related area that we won't cover here), it is ideal for natively hooking a window's WindowProcedure.
Right, with all that background we can now do a walkthrough of the code: [tt]
Option Explicit
Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
' Along with the declaration of GWL_WNDPROC below, these are the calls necessary to read and write
' the address of a given window's WindowProcedure Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
' WindowLong constants Private Const GWL_WNDPROC = -4 ' We can use the following as a parameter to getWindow long to determine a given window's owner Public Const GWL_HWNDPARENT = (-8)
' Activation constants Private Const WM_ACTIVATEAPP = &H1C ' The message sent by the OS to all windows belonging to an application that is being activated or deactivated ' These are our own constants representing whether the WM_ACTIVATEAPP message is a result of activation or deactivation Private Const WINDOW_ACTIVATING = 1&
Private Const WINDOW_DEACTIVATING = 0&
' Private copy of original windows procedure
' Remember that we will want to defer to the window's WindowProcedure for messages that we are not
' interested in. In fact, in this particular example we also want to pass on the WM_ACTIVATING message
' once we have responded to it. Private lpPrevWndProc As Long
' Here's where we use AddressOf to place the address of our own WindowProcedure (called WindowProc)
' in the window structure. SetWindowLong handily returns the previous contents of the structure entry, in
' this case the address of the original WindowProcedure (which we save) Public Sub Hook(hWnd As Long) ' Begin hooking into messages. Warning: never try and debug application
' whilst hook is in place as IDE will terminate. lpPrevWndProc = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf WindowProc)
End Sub
' This just removes our hook by popping the original WindowProcedure back into the window structure.
' it is essential that we unhook before returning to the IDE, else it will become unstable (generally
' crashing) since the window will still exist but the window structure will contain an invalid address
' once we stop our code running. Unhooking is not so essential in a compiled application Public Sub Unhook(hWnd As Long) ' Cease hooking into messages. SetWindowLong hWnd, GWL_WNDPROC, lpPrevWndProc
End Sub
' This is our WindowProc, which, once we have hooked it into a window will be called everytime a new
' message arrives for that window. Note that the function declaration for a WindowProc HAS to follow
' the format show here, or your program will crash.
' Note that in the Case statement we only trap the WM_ACTIVATEAPP message since that is the
' only one we are currently interested in. However you can if you want trap whatever messages
' you like here. Public Function WindowProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
' Check whether form/application is activating or deactivating Select Case uMsg
Case WM_ACTIVATEAPP
If wParam = WINDOW_ACTIVATING Then
Debug.Print "Activated" ' You use whatever code you want here ElseIf wParam = WINDOW_DEACTIVATING Then
Debug.Print "Deactivated" ' You use whatever code you want here End If
Case Else
End Select
' In this example we now pass all messages on to the original WindowProcedure for normal processing.
' There may be occassions, however, where you don't want the default
' processing to occur for a given message, so you wouldn't pass it on. WindowProc = CallWindowProc(lpPrevWndProc, hWnd, uMsg, wParam, lParam)
End Function [/tt]
I'm not going to bother walking through the form code. All it does is insert the hook when the form loads and remove it when the form unloads
Excellent code and description, and the message hook certainly has a lot of useful applications.
Quick question: for this application, since the activation message is only one of interest, couldn't you simply use the _Activate event handler?
Good Luck
------------
Select * from Users where Clue > 0
0 rows returned
That was the whole point of the original question! Because, as JNeave pointed out, it doesn't work. Specifically, if you examine the VB documentation:
"The Activate and Deactivate events occur only when moving the focus within an application. Moving the focus to or from an object in another application doesn't trigger either event. The Deactivate event doesn't occur when unloading an object."
In other words, you don't get either an Activate or Deactivate event if you are switching to or from other applications.
As discussed in the walkthrough, Microsoft chose to only expose some of the messages as events, and often in a limited sense. This is an example of the latter.
Nice explaination and nice of you to take the time for these guys!
I use the following in the Hook/UnHook as an extra safeguard (I learned it that way).
Hook:
If lpPrevWndProc = Gc0 Then
lpPrevWndProc = SetWindowLong hWnd,GWL_WNDPROC, AddressOf WindowProc)
End If
UnHook:
If lpPrevWndProc <> Gc0 Then
lpPrevWndProc = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf WindowProc)
End If
And in the WindowProc I check to see if the hWnd is the same as the hWnd of the form or Object that I am using the hook on, either using If/Else or Select Case - of course this would't be needed when using a hWnd for a specific object, but for a parent object I would need this.
Yep, there are several improvements that could be made (including error checking, which I always rather naughtily leave out in most of the examples I post to tek-tips).
I actually use almost exactly the same code as you do in my production hooking and unhooking routines.
As for the WindowProc, I likewise often check against the hWnd.
In other words I agree completely with your comments
This site uses cookies to help personalise content, tailor your experience and to keep you logged in if you register.
By continuing to use this site, you are consenting to our use of cookies.