Focus

How do I determine if my form lost its focus to another program?

cheers :)

Try this

Code:

---

WM_KILLFOCUS
The WM_KILLFOCUS message is sent to a window immediately before it loses the keyboard focus.

WM_KILLFOCUS
hwndGetFocus = (HWND) wParam; // handle to window receiving focus
 
Parameters
hwndGetFocus
Value of wParam. Handle to the window that receives the keyboard focus (may be NULL).
Return Values
An application should return zero if it processes this message.

Remarks
If an application is displaying a caret, the caret should be destroyed at this point.

---

understood the principle, but how do I receive that message?
And what type are hwndGetFocus/wParam?Strange thing is that textboxes got that LostFocus event but forms don't

Subclass the form. Hre is a simple example on subclassing

Code:

---

'Create a new project, add a module to it
'Add a command button to Form1
'In the form
Private Sub Form_Load()
    'Subclass this form
    HookForm Me
    'Register this form as a Clipboardviewer
    SetClipboardViewer Me.hwnd
End Sub
Private Sub Form_Unload(Cancel As Integer)
    'Unhook the form
    UnHookForm Me
End Sub
Private Sub Command1_Click()
    'Change the clipboard
    Clipboard.Clear
    Clipboard.SetText "Hello !"
End Sub

'In a module
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
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
Declare Function SetClipboardViewer Lib "user32" (ByVal hwnd As Long) As Long
Public Const WM_DRAWCLIPBOARD = &H308
Public Const GWL_WNDPROC = (-4)
Dim PrevProc As Long
Public Sub HookForm(F As Form)
    PrevProc = SetWindowLong(F.hwnd, GWL_WNDPROC, AddressOf WindowProc)
End Sub
Public Sub UnHookForm(F As Form)
    SetWindowLong F.hwnd, GWL_WNDPROC, PrevProc
End Sub
Public Function WindowProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    WindowProc = CallWindowProc(PrevProc, hwnd, uMsg, wParam, lParam)
    If uMsg = WM_DRAWCLIPBOARD Then
        MsgBox "Clipboard changed ..."
    End If
End Function

---

Quote:

---

Originally posted by Olly
Strange thing is that textboxes got that LostFocus event but forms don't

---

Sadly, this is one of the many bugs in VB :(

:cool:Thank You! What would this forum be without u?:cool:

Vlatko, I viewed you code, and it doesn't subclass the WM_KILLFOCUS message...

Add to a Module

Code:

---

Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Declare Function SetWindowLong& Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long)
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
Const GWL_WNDPROC = (-4)
Private Const WM_KILLFOCUS = &H8

Global WndProcOld As Long

Public Function WindProc(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

    If wMsg = WM_KILLFOCUS Then
      Debug.Print "Lost Focus"
    End If
 
    WindProc = CallWindowProc(WndProcOld&, hwnd&, wMsg&, wParam&, lParam&)
   
End Function

Sub SubClassWnd(hwnd As Long)
    WndProcOld& = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf WindProc)
End Sub

Sub UnSubclassWnd(hwnd As Long)
    SetWindowLong hwnd, GWL_WNDPROC, WndProcOld&
    WndProcOld& = 0
End Sub

---

Add to a Form

Code:

---

Private Sub Form_Load()
    SubClassWnd hwnd
End Sub

Private Sub Form_Unload(Cancel As Integer)
    UnSubclassWnd hwnd
End Sub

---

yeah, megatron, your code is working perfectly
but thx to vlatko as well :D

Quote:

---

Vlatko, I viewed you code, and it doesn't subclass the WM_KILLFOCUS message...

---

I know. It just an example on subclassing from api-guide. Just the message needs to be changed to WM_KILLFOCUS

The EventVB dll avaialable free for download from Merrion Computing Ltd implements this as an event:

ActiveApplicationChanged(ByVal ActivatingThisApp As Boolean, ByVal hThread As Long, Cancel As Boolean)

Where ActivatingThisApp is True if your application is gaining the input focus and hThread is the thread handle of the other application about to gain the input focus if not. You can even override the change of focus by setting Cancel to true.

HTH,
Duncan

Megatron, as soon as I add a control to the form, I can no longer determine when the form has lost focus.

Is it possible to determine when a form has lost focus while there are controls on it?

It appears the paint event serves to indicate when a form gets the focus back from another app.

In the pure WinNt world, WM_KILLFOCUS and WM_SETFOCUS messages are only applicable for focus changes between windows in one thread. (For example between two text boxes in an application).
To detect the focus changing between threads (i.e. ALT+TAB from your app to a third party application) you need to trap the WM_ACTIVATEAPP message.
It is this message that is used to trigger the ActiveApplicationChanged message in the EventVB DLL and the source code to show you how this is doen is also on that site.

HTH,
D.

That looks great Duncan, but I don't really need all of that code (if only I had a spare couple of weeks!)... I just need to capture when the app loses and gets focus.

I tried this, but with no success:

Code:

---

Function WndProc(ByVal hWnd As Long, ByVal uMsg As Long, _
    ByVal wParam As Long, ByVal lParam As Long) As Long
    WndProc = CallWindowProc(oldProcAddr, hWnd, uMsg, wParam, lParam)
   
    Select Case uMsg
        Case WM_ACTIVATEAPP
            If wParam Then
                msgbox "GotFocus"
            Else
                msgbox "LostFocus"
            End If
    End Select
End Function

---

Yeah, that's cool that it works with that dll but there must be a "normal" way to solve it using just the winapi. If there's none
I will use that eventvb thing but I don't like to overload my program with all these additional stuff. (----> sorry, I didn't notice that it doesn't work with components the first time because I'm currently developing a custom toolbar that needs to be changed in colour when the form loses its focus, so it wasn't necessary for me to use them
:( )

The following works on a form with two text boxes and a command button dropped on it:


Option Explicit

Dim WithEvents apilink As APIFunctions
Dim WithEvents wnd As ApiWindow

Private Sub apilink_ApiError(ByVal Number As Long, ByVal Source As String, ByVal Description As String)

MsgBox Description, vbCritical, Source

End Sub

Private Sub Form_Load()

Set apilink = New APIFunctions
Set wnd = New ApiWindow
wnd.hWnd = Me.hWnd

apilink.SubclassedWindows.Add wnd

End Sub

Private Sub Form_Terminate()

apilink.SubclassedWindows.Remove wnd
Set wnd = Nothing
Set apilink = Nothing

End Sub

Private Sub wnd_ActiveApplicationChanged(ByVal ActivatingThisApp As Boolean, ByVal hThread As Long, Cancel As Boolean)

If ActivatingThisApp Then
MsgBox "Activating me"
Else
MsgBox "hiding me"
End If

End Sub


And this is just a wrapper around subclassing Form1 and checking for the WM_ACTIVATEAPP message.

Note that the messagebox for "hiding me" is behind the application that you have switched to, so perhaps you are not seeing it for that reason? Or perhaps you are using a control that I have not tested for?

Either way, my suggestion would be to try the above. If it works for you then you know that what you wish to do can be done by subclassing the WM_ACTIVATEAPP message.

HTH,
Duncan

wait guys, why not using that?

Private Declare Function GetFocus Lib "user32" () As Long

Private Sub Timer1_Timer()
If GetFocus =0 Then me.backcolor = vbblack else me.backcolor = vbwhite
End Sub

I think it works (I mean you could create a virtual timer as well)
Even though this is probably not very elegant the api timer would be a bit as I already am using it in my program.

'Timer code in module:

Option Explicit

Declare Function SetTimer Lib "user32" _
(ByVal hwnd As Long, _
ByVal nIDEvent As Long, _
ByVal uElapse As Long, _
ByVal lpTimerFunc As Long) As Long

Declare Function KillTimer Lib "user32" _
(ByVal hwnd As Long, _
ByVal nIDEvent As Long) As Long

Global iCounter As Integer



Sub TimerProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal idEvent As Long, ByVal dwTime As Long)
If GetFocus =0 Then me.backcolor = vbblack else me.backcolor = vbwhite
End Sub

'Form code:
'-------------------------------------------------------
Form_Initialize()
BlnTimer = False
lngTimerID = SetTimer(0, 0, 200, AddressOf TimerProc)
BlnTimer = True
End Sub