[RESOLVED] [VB6] - Disable the mouse

[joaquim]

i'm bulding a sub for block the mouse. testing every controls, but can't block in 1 control, if is choosed.

Option Explicit

Private Declare Function SetCapture Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function ReleaseCapture Lib "user32" () As Long

Public Sub BlockMouse(MainForm As Form, Optional ExceptControl As String)
    Dim ctlTemp As Control
    For Each ctlTemp In MainForm.Controls
        If ctlTemp.Name = ExceptControl Then
            ReleaseCapture
        Else
            SetCapture MainForm.hwnd
        End If
    Next ctlTemp
End Sub

and heres the form code:

Option Explicit

Private Sub Command1_Click()
    MsgBox Command1.Name
End Sub

Private Sub Command2_Click()
    MsgBox Command2.Name
End Sub

Private Sub Form_Load()

End Sub

Private Sub Timer1_Timer()
    BlockMouse Form1, Command1.Name
End Sub

(these sub is for block the mouse in every controls, except if we choose 1 that can't be blocked... i'm doing these because, in same programs we don't need the mouse, but if we use we lose the focus)
it seems working, but isn't ignored in that control... can anyone advice-me?

[LaVolpe]

SetCapture & ReleaseCapture are not control-specific. When SetCapture is called, any control that had the mouse captured previously is released. When ReleaseCapture is called, any control that had the mouse captured is released. If you want to block mouse events to a control, disable the control.

[joaquim]

SetCapture & ReleaseCapture are not control-specific. When SetCapture is called, any control that had the mouse captured previously is released. When ReleaseCapture is called, any control that had the mouse captured is released. If you want to block mouse events to a control, disable the control.

i create these sub by these page: http://fordemand.blogspot.com/2008/0...se-events.html

[LaVolpe]

If you noticed that example, only one control can be handled at one time.
When the mouse moves over the control, the SetCapture moves capture to the form. The textbox no longer knows if mouse is over itself or not. The form, which has the mouse captured, then compares the mouse X,Y coordinates and if its no longer over the textbox, then it releases capture. That code can only work when the mouse first moves over the textbox and has logic flaws. Place the textbox in middle of a picturebox & you'll see it is possible to get mouse events. This is because the code tests for Text1.Left and Text1.Left is measured from the picturebox, not the form.

To simulate this with your control, maybe 1 of these 3

1) Disable the control
- or -
1) Create a flag the control will use to determine if it should ignore mouse messages
2) When mouse moves over your control, and that flag is set, then SetCapture to the container hWnd
3) Now you'll have to monitor the mousemove messages for the container hWnd so you can release capture. If you don't do this, the ReleaseCapture will only occur when the user clicks on something else besides the container hWnd & if not clicked on the container, they'll have to click twice!
- or -
1) Create a mouse hook when mouse first enters your control
2) Whenever a mouse message is for your usercontrol, don't pass the message
3) Whenever the mouse leaves the control (targeted for another hWnd), remove the hook

[RobDog888]

i would also suggest disabling the controls and leaving only the control(s) that you want enabled. Much easier IMO

[joaquim]

i would also suggest disabling the controls and leaving only the control(s) that you want enabled. Much easier IMO

see these situation: i have the player(the keyboard events are code in these control), if the player loses the focus, i can't use the keyboard... that's way e need these sub. or you have another sugestion?

[LaVolpe]

So you only want 2 controls enabled? All others disabled? Disable the other controls
Also is this code meant for a usercontrol or is it to be used in an exe? I think more details may help.

[joaquim]

So you only want 2 controls enabled? All others disabled? Disable the other controls
Also is this code meant for a usercontrol or is it to be used in an exe? I think more details may help.

thanks, but i found a simple solution:

Private Sub sprPlayer_LostFocus()
    If blnShowRestartGame = False Then sprPlayer.SetFocus
End Sub

i use the if, because i use 1 modal form

[joaquim]

with these code:

' ///////////////////////////////////////////////
'  Return MouseWheel Over Multiple UserControls
'  Ed Wilk/Edgemeal
'  Example UPDATED September 18, 2008
' ///////////////////////////////////////////////
'
' ****************************************************
' IMPORTANT NOTICE:
'   To stop the hook from sending messages to a
'   window handle set the variable MouseOverControl
'   to zero!
' ****************************************************
Option Explicit
Private PrevWin2 As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong 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
Private Const GWL_WNDPROC = (-4)
Private Const WM_MOUSEWHEEL = &H20A
Public MouseOverControl As Long ' Handle for User Control (mouse move)
Private Const WM_KEYDOWN = &H100
Private Const WM_MOUSEHWHEEL = &H20E

Private Function Proc2(ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    
    ' Pass mouse wheel as arrow keys to a window handle(user controls).
    
    If Msg = WM_MOUSEWHEEL Then  ' the mouse wheel rotated
        
        If MouseOverControl > 0 Then
            If wParam / 65536 > 0 Then
                SendMessage MouseOverControl, WM_KEYDOWN, 1000, 0
            Else
                SendMessage MouseOverControl, WM_KEYDOWN, 1001, 0
            End If
        End If
    ElseIf Msg = WM_MOUSEHWHEEL Then
        If MouseOverControl > 0 Then
            If wParam / 65536 > 0 Then
                SendMessage MouseOverControl, WM_KEYDOWN, 1002, 0
            Else
                SendMessage MouseOverControl, WM_KEYDOWN, 1003, 0
            End If
        End If
    End If
        
    Proc2 = CallWindowProc(PrevWin2, hWnd, Msg, wParam, lParam)
    
End Function

Public Sub Hook2(Handle As Long)
    If PrevWin2 = 0 Then
        PrevWin2 = SetWindowLong(Handle, GWL_WNDPROC, AddressOf Proc2)
    End If
End Sub

Public Sub Unhook2(Handle As Long)
    If PrevWin2 Then
        Call SetWindowLong(Handle, GWL_WNDPROC, PrevWin2)
        PrevWin2 = 0
    End If
End Sub

is possible block the mouse?

[joaquim]

finnaly i found 1 code for block the mouse,but block in system and not in that form

'module
Option Explicit

Public Declare Function SetWindowsHookEx _
 Lib "user32" Alias "SetWindowsHookExA" _
 (ByVal idHook As Long, ByVal lpfn As Long, _
 ByVal hmod As Long, ByVal dwThreadId As Long) As Long
Public Declare Function UnhookWindowsHookEx _
 Lib "user32" (ByVal hHook As Long) As Long
Public Const WH_MOUSE_LL As Long = 14
Private Declare Function CallNextHookEx _
 Lib "user32" (ByVal hHook As Long, _
 ByVal nCode As Long, ByVal wParam As Long, _
 lParam As Any) As Long
Private Declare Sub CopyMemory Lib "kernel32" _
 Alias "RtlMoveMemory" (Destination As Any, _
 Source As Any, ByVal Length As Long)
Private Const HC_ACTION = 0
Private Const WM_RBUTTONDOWN As Long = &H204
Private Const WM_RBUTTONUP As Long = &H205
Private Const WM_RBUTTONDBLCLK As Long = &H206
Private Const WM_MOUSEMOVE As Long = &H200
Private Const WM_LBUTTONDOWN As Long = &H201
Private Const WM_LBUTTONUP As Long = &H202
Private Const WM_MBUTTONDOWN As Long = &H207
Private Const WM_MBUTTONUP As Long = &H208
Private Const WM_SCROLL As Long = &H20A
Private Type POINTAPI
 x As Long
 y As Long
End Type
Private Type MOUSELLHOOKSTRUCT
 point As POINTAPI
 data As Long
 flags As Long
 time As Long
 extra As Long
End Type
Private mousedata As MOUSELLHOOKSTRUCT

Public Function MouseProc(ByVal nCode As Long, _
  ByVal wParam As Long, ByVal lParam As Long) As Long
Dim eatMouse As Boolean
If (nCode = HC_ACTION) Then
 ' Mouse data not used in this example, but useful
 CopyMemory mousedata, ByVal lParam, Len(mousedata)
 '
 If wParam = WM_RBUTTONDOWN Or wParam = WM_RBUTTONUP Then
   eatMouse = True
 End If
End If
If eatMouse Then
 MouseProc = -1
Else
 MouseProc = -1 'CallNextHookEx _
   (0, nCode, wParam, ByVal lParam)
End If
End Function
' *** END OF MODULE CODE ***
'in form
Private Sub Form_Load()
mouseHook = SetWindowsHookEx(WH_MOUSE_LL, _
 AddressOf MouseProc, App.hInstance, 0)
End Sub

Private Sub Form_Unload(Cancel As Integer)
If mouseHook <> 0 Then
 UnhookWindowsHookEx mouseHook
End If
End Sub

these code block in system. but i need that works only the form have the focus.

[joaquim]

what is the api message for the form lose the focus and catch again?

[joaquim]

finally i fix the code. these code can block the mouse events(in these case i left the mouse move to be more easy to work), but if the form loses the focus, these block don't works for others windows. heres the code:

'Module
' *** START OF MODULE CODE ***
Option Explicit
Public Declare Function SetWindowsHookEx _
 Lib "user32" Alias "SetWindowsHookExA" _
 (ByVal idHook As Long, ByVal lpfn As Long, _
 ByVal hmod As Long, ByVal dwThreadId As Long) As Long
Public Declare Function UnhookWindowsHookEx _
 Lib "user32" (ByVal hHook As Long) As Long
Public Const WH_MOUSE_LL As Long = 14
Private Declare Function CallNextHookEx _
 Lib "user32" (ByVal hHook As Long, _
 ByVal nCode As Long, ByVal wParam As Long, _
 lParam As Any) As Long
Private Declare Sub CopyMemory Lib "kernel32" _
 Alias "RtlMoveMemory" (Destination As Any, _
 Source As Any, ByVal Length As Long)
 Public Declare Function GetForegroundWindow Lib "user32" () As Long

Private Const HC_ACTION = 0
Private Const WM_RBUTTONDOWN As Long = &H204
Private Const WM_RBUTTONUP As Long = &H205
Private Const WM_RBUTTONDBLCLK As Long = &H206
Private Const WM_MOUSEMOVE As Long = &H200
Private Const WM_LBUTTONDOWN As Long = &H201
Private Const WM_LBUTTONUP As Long = &H202
Private Const WM_MBUTTONDOWN As Long = &H207
Private Const WM_MBUTTONUP As Long = &H208
Private Const WM_SCROLL As Long = &H20A
Private Type POINTAPI
 x As Long
 y As Long
End Type
Private Type MOUSELLHOOKSTRUCT
 point As POINTAPI
 data As Long
 flags As Long
 time As Long
 extra As Long
End Type
Private mousedata As MOUSELLHOOKSTRUCT
Public WindowGeneral As Long




Public Function MouseProc(ByVal nCode As Long, _
  ByVal wParam As Long, ByVal lParam As Long) As Long
Dim eatMouse As Boolean
If (nCode = HC_ACTION) Then
 ' Mouse data not used in this example, but useful
 CopyMemory mousedata, ByVal lParam, Len(mousedata)
 '
 If GetForegroundWindow() = WindowGeneral Then

 If wParam = WM_LBUTTONDOWN Or wParam = WM_LBUTTONUP Or wParam = WM_RBUTTONDOWN Or wParam = WM_RBUTTONUP Then
   eatMouse = True
 End If
 Else
    eatMouse = False
End If
If eatMouse Then
 MouseProc = -1
Else
 MouseProc = CallNextHookEx _
   (0, nCode, wParam, ByVal lParam)
End If
End If
End Function
' *** END OF MODULE CODE ***

'in form
Option Explicit
Private mouseHook As Long

Private Sub Form_Load()
mouseHook = SetWindowsHookEx(WH_MOUSE_LL, _
 AddressOf MouseProc, App.hInstance, 0)
 WindowGeneral = Form1.hWnd
End Sub

Private Sub Form_Unload(Cancel As Integer)
If mouseHook <> 0 Then
 UnhookWindowsHookEx mouseHook
End If
End Sub

now i can block the mouse hehehe
note: if someone test these code, please don't close it by using the IDE buttons, but the form it self... how? when you have the form activated(or use ALT+TAB(combinations keys for choose the window or program) the use ALT+F4(for close the window(form in these case)).
anotherthing: these cose can block the keyboard? yes... intead mouse api messages, use the keyboard api messages

[RobDog888]

Its not an issue to have code in a module with calling procedures in a form.
Now with more information about what you are doing/needing, looks like the code will do all you need.

So if your issue has been solved dont forget to mark the thread as Resolved

[joaquim]

why, when i close the program with IDE buttons, the Visual Basic stays very instable and sometimes, the windows give me 1 error and closes the Visual basic?
and i need to know what is the wm_keypress api message. because the w_keyup and w_keydown don't work with special keys(like arrows F's and Alt and SPACE and others). pelase anyone can tell me the message value?

[LaVolpe]

Never close your project with the toolbar stop button or execute an END statement when the project is using subclassing and/or hooking. Doing so may cause it to crash.

Another message you will want to look at: WM_CHAR (like keypress). Value is &H102

[joaquim]

"Never close your project with the toolbar stop button or execute an END statement when the project is using subclassing and/or hooking. Doing so may cause it to crash." thanks for that information

"Another message you will want to look at: WM_CHAR (like keypress). Value is &H102" sorry but these message don't works when i use ALT+F4, the combination key stills working normaly... in others words, the char don't works with these keys. i omly found these way and works:

Or wParam = API_Alt Or API_F4

but key by key gives me a big line

[LaVolpe]

ALT+ keys are accelerator keys and handled differently. Look at WM_SYSKEYDOWN and WM_SYSKEYUP.

Note: I would say it is generally not proper to intercept someone's accelerator/system keys. Trapping and aborting Alt+F4 could annoy a user as that is one way of closing a window.

[joaquim]

"ALT+ keys are accelerator keys and handled differently. Look at WM_SYSKEYDOWN and WM_SYSKEYUP."
thanks for that messages my friend

"Note: I would say it is generally not proper to intercept someone's accelerator/system keys. Trapping and aborting Alt+F4 could annoy a user as that is one way of closing a window." that's way my blockkeyboard sub works only in that form and not in every where if i block the keyboard i can't block the mouse too(or i lose the input lol).thanks for the big information