Limit Cursor Movement inside a Userform

[Dweeb458]

Hello All,

I'm looking for code to limit the mouse cursor to only the boundries of a userform until the userform is closed. I have found some vb code for this as an API, but cannot seem to get the code to work.

I'm using Excel 2002, Windows XP, and the error I'm encountering is:
"Compile error, Method or Data member not found" on :GetClientRect Me.hWnd, client.

Here is the code I'm using:

Option Explicit

Private Type RECT
    left As Long
    top As Long
    right As Long
    bottom As Long
End Type
Private Type POINT
    x As Long
    y As Long
End Type

Private Declare Sub ClipCursor Lib "user32" (lpRect As Any)
Private Declare Sub GetClientRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT)
Private Declare Sub ClientToScreen Lib "user32" (ByVal hWnd As Long, lpPoint As POINT)
Private Declare Sub OffsetRect Lib "user32" (lpRect As RECT, ByVal x As Long, ByVal y As Long)

Private Sub CommandButton1_Click()
'Limits the Cursor movement to within the form.
    Dim client As RECT
    Dim upperleft As POINT
    
    'Get information about our window
    GetClientRect Me.hWnd, client
    upperleft.x = client.left
    upperleft.y = client.top
    
    'Make the bottom and right the same as the top/left
    client.bottom = client.top
    client.right = client.left
    
    'Convert window coordinates to screen coordinates
    ClientToScreen Me.hWnd, upperleft
    
    'offset our rectangle
    OffsetRect client, upperleft.x, upperleft.y
    
    'limit the cursor movement
    ClipCursor client
    
End Sub

Private Sub CommandButton2_Click()
 'Releases the cursor limits
    ClipCursor ByVal 0&
End Sub

Private Sub UserForm_Activate()
    CommandButton1.Caption = "Limit Cursor Movement"
    CommandButton2.Caption = "Release Limit"
End Sub

Private Sub UserForm_Click()

End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
 'Releases the cursor limits
    ClipCursor ByVal 0&
End Sub

Any help with this is much appreciated.

Thanks in advance.

 

[n07cn3]

Hello @Jaafar Tribak

Hope all is well. I need your help again.

Your code in post# 28 has been working very well with my vba project. I currently have 2 userforms but now I need to add a third userform to my VBA project.

My third userform require your code in post# 17. I need it to trap the cursor within the userform until the userform is closed out. The code work perfectly except after my third userform is closed out. The cursor then trapped in my second userform.
Is it possible to modify your code in post#17 to stop trapping the cursor once i close out my third userform (and still have the code in post# 28 functional)?

as alwaysthank you for your help.

 

[Jaafar Tribak]

Hello @Jaafar Tribak

Hope all is well. I need your help again.

Your code in post# 28 has been working very well with my vba project. I currently have 2 userforms but now I need to add a third userform to my VBA project.

My third userform require your code in post# 17. I need it to trap the cursor within the userform until the userform is closed out. The code work perfectly except after my third userform is closed out. The cursor then trapped in my second userform.
Is it possible to modify your code in post#17 to stop trapping the cursor once i close out my third userform (and still have the code in post# 28 functional)?

as alwaysthank you for your help.

Can you upload an example workbook to some file sharing site (like Box.net ) and post a link here for me to take a look ?

 

[n07cn3]

Hello @Jaafar Tribak

Please take a look at the link below.


https://app.box.com/s/4blsqi2x45i30ihqayhthqusm8zprh08


if possible, can the code also be modified to trap the cursor to a specific userform?
I am thinking down the road I might need it to trap the cursor to future userform and msgbox like UserForm4, UserForm5... and so on BUT NOT for the first 2 UserForm (UserForm1 and UserForm2) I've already have.


thank you so much for your help.

 

[Jaafar Tribak]

Hello @Jaafar Tribak

Please take a look at the link below.

https://app.box.com/s/4blsqi2x45i30ihqayhthqusm8zprh08

if possible, can the code also be modified to trap the cursor to a specific userform?
I am thinking down the road I might need it to trap the cursor to future userform and msgbox like UserForm4, UserForm5... and so on BUT NOT for the first 2 UserForm (UserForm1 and UserForm2) I've already have.
thank you so much for your help.

Ok- I have just got around to checking the workbook and made the necessary modifications to meet your goal.

Modified Workbook.

basically, the idea is to have a generic method to be enable us to freely and flexibly toggle On and Off the cliping of the cursor for ANY upcoming owned window be it a userform a custom messagebox or a standard vba msgbox .

For this, I have created a new Boolean Property named ClipCursor_To_Upcoming_OwnedWindow

You just set the Property to TRUE before showing the owned window (userform, msgbox or any other popup window owned by the excel application)

After the cursor-clipped window is closed, you set the Property back to FALSE unless another window is being shown immediatly after and it also clips the cursor ... such as in the following example:

The use of the Property will look something like this :

   ClipCursor_To_Upcoming_OwnedWindow = True
        MsgBoxAnswer = MsgBoxCB("Cusor is trap with Custom Message Box" & vbNewLine & "Please click the ""A"" button or ""B"" button.", "A", "B", "", vbInformation, "Custom Message Box")
        MsgBox "Cursor is trap with MsgBox function", , "MsgBox"
    ClipCursor_To_Upcoming_OwnedWindow = False

Because this is a generic approach, you can trap the cursor to any number of future userforms and msgboxes in the same fashion.

Note: If you have a Modeless userform, you need not set the Property to False after calling the form.

Here is the code for future reference :

In a Standard Module:

Option Explicit

Private Type RECT
    Left As Long
    Top As Long
    right As Long
    bottom As Long
End Type

[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If"]#If[/URL]  VBA7 Then
    Private Declare PtrSafe Function SetTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr, ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As LongPtr
    Private Declare PtrSafe Function KillTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr) As Long
    Private Declare PtrSafe Function GetLastActivePopup Lib "user32" (ByVal hwndOwnder As LongPtr) As LongPtr
    Private Declare PtrSafe Function ClipCursor Lib "user32" (lpRect As Any) As Long
    Private Declare PtrSafe Function GetWindowRect Lib "user32" (ByVal hwnd As LongPtr, lpRect As RECT) As Long
[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else"]#Else[/URL] 
    Private Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
    Private Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
    Private Declare Function GetLastActivePopup Lib "user32" (ByVal hwndOwnder As Long) As Long
    Private Declare Function ClipCursor Lib "user32" (lpRect As Any) As Long
    Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End"]#End[/URL]  If


Public Property Let ClipCursor_To_Upcoming_OwnedWindow(ByVal Clip As Boolean)

    If Clip Then
        KillTimer Application.hwnd, 0
        SetTimer Application.hwnd, 0, 0, AddressOf TimerProc
    Else
        KillTimer Application.hwnd, 0
        ClipCursor ByVal 0&
    End If

End Property


Private Sub TimerProc()

    [URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If"]#If[/URL]  VBA7 Then
        Dim hwnd As LongPtr
    [URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else"]#Else[/URL] 
        Dim hwnd As Long
    [URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End"]#End[/URL]  If
    
    Dim tRect As RECT
    
    hwnd = GetLastActivePopup(Application.hwnd)
    
    If hwnd = Application.hwnd Then
        KillTimer Application.hwnd, 0: ClipCursor ByVal 0&:  Exit Sub
    End If
    GetWindowRect GetLastActivePopup(Application.hwnd), tRect
    
    With tRect
        .right = .right - 2: .bottom = .bottom - 2
    End With
    
    ClipCursor tRect

End Sub

 

[n07cn3]

as always you are awesome @Jaafar Tribak

thank you so much. this work perfectly.