i was just wondering how to unload a form if the mouse is not on it anymore
any ideas
thanks
Printable View
i was just wondering how to unload a form if the mouse is not on it anymore
any ideas
thanks
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.
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
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.
ya i could probably use it in the future
thanks
Try this:
Code: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
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.
Code: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:
Code: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