unload form on lostfocus

[kovan]

i was just wondering how to unload a form if the mouse is not on it anymore

any ideas
thanks

[V(ery) Basic]

This isn't actually about this, but about a quetion you posted to ask if there was a way to make menu items italic/bold/underlined etc. I've updated a project I had on advanced menus to do this, and I'll e-mail it to you.

PS I think to unload a form when the mouse moves out of it, you'd have to put GetCursorPos in a timer, and test to see if it is on the Form, or unload otherwise.

[kovan]

i hope you got my yesterday's message about saying
dont spend any time on making your menu's work
cus i only doing this for pop up menu'z

so far what i have works great
on right click
i have a customized popup menu appearing(on another form)
and i have the mouse trapped within the menu for
so if someone selects item it does action and disspears
if someone right clicks and doesnt want to do anything
they cant move the mouse out of the form either they click an item or click a little dot i have that cancels the menu out..

but i wanna make it so that its like a regular pop up
if the form moves off the menu (i have to disable the mouse trap) then menu goes away

[V(ery) Basic]

Ah, well, I'll send it to you anyway. I think you'll like it. You might not need it for your current project, but it's good to have.

[kovan]

ya i could probably use it in the future
thanks

Try this:

Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Private Type POINTAPI
        x As Long
        y As Long
End Type

Private Type RECT
        Left As Long
        Top As Long
        Right As Long
        Bottom As Long
End Type

Private Sub Timer1_Timer()

    Dim PT As POINTAPI
    Dim WRECT As RECT
    GetWindowRect hwnd, WRECT
    GetCursorPos PT
    
    If PT.x < WRECT.Left Or PT.x > WRECT.Right Or PT.y < WRECT.Top Or PT.y > WRECT.Bottom Then
        'It's out of the Form
        Unload Me
    End If
    
End Sub

[kovan]

you absolutely deserve the title guru
(and few others here that will be guru's soon)

You can also Subclass to check if your form has lost focus, and if it has, unload it.

Option Explicit

Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal ndx As Long, ByVal newValue As Long) As Long
Private 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

Public Const WM_KILLFOCUS = &H8

Dim saveHWnd As Long        ' The handle of the subclassed window.
Dim oldProcAddr As Long     ' The address of the original window procedure

Sub StartSubclassing(ByVal hWnd As Long)
    saveHWnd = hWnd
    oldProcAddr = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf WndProc)
End Sub

Sub StopSubclassing()
    SetWindowLong saveHWnd, GWL_WNDPROC, oldProcAddr
End Sub

Function WndProc(ByVal hWnd As Long, ByVal uMsg As Long, _
    ByVal wParam As Long, ByVal lParam As Long) As Long
    ' Send the message to the original window procedure, and then
    ' return Windows the return value from the original procedure.
    WndProc = CallWindowProc(oldProcAddr, hWnd, uMsg, wParam, lParam)
    
Select Case uMsg
    Case WM_KILLFOCUS
            Unload Form1
            Set Form1 = Nothing
            End
    End Select
End Function

Private Sub Form_Load()
    StartSubclassing Me.hWnd
End Sub

Private Sub Form_Unload(Cancel As Integer)
    StopSubclassing
End Sub

I'm sorry, the code above crashes VB. Use this instead:

Option Explicit

Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal ndx As Long, ByVal newValue As Long) As Long
Private 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

Public Const WM_KILLFOCUS = &H8

Dim saveHWnd As Long        ' The handle of the subclassed window.
Dim oldProcAddr As Long     ' The address of the original window procedure

Sub StartSubclassing(ByVal hWnd As Long)
    saveHWnd = hWnd
    oldProcAddr = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf WndProc)
End Sub

Sub StopSubclassing()
    SetWindowLong saveHWnd, GWL_WNDPROC, oldProcAddr
End Sub

Function WndProc(ByVal hWnd As Long, ByVal uMsg As Long, _
    ByVal wParam As Long, ByVal lParam As Long) As Long
    ' Send the message to the original window procedure, and then
    ' return Windows the return value from the original procedure.
    WndProc = CallWindowProc(oldProcAddr, hWnd, uMsg, wParam, lParam)
    
Select Case uMsg
    Case WM_KILLFOCUS
            Unload Form1
    End Select
End Function

Private Sub Form_Load()
    StartSubclassing Me.hWnd
End Sub

Private Sub Form_Unload(Cancel As Integer)
    StopSubclassing
End Sub