LOCK cursor in the top right corner of form

[sal21]

POssible to (pseudo code):

click on button
move the cursor and lock it in the top right corner of form
run mycode
and of mycode
free the cursor and movment

possible?

[SpeakEasy]

Possible? Yes - and only a few lines of code

Best practice? No. Beyond irritating users who may think something has broken, think about what may happen if for some reason (say a crash) your unlock code doesn't run.

[Jay Freedman]

A better solution would be to disable every control on the form that could respond to a click. Exception: you may want to leave the Cancel button enabled, with code in its Click procedure to handle shutting down whatever process is taking too long.

[SpeakEasy]

But, in case you still want to go down this path ...

You'll need a form with a timer, textbox, command button and a picturebox. The copy n paste in this code (most of thjis is comments and setting up the form). Only a tiny bit is actually handling the cursor):

Code: Select all

Option Explicit

Private Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long
Private Declare Function ClipCursor Lib "user32" (lpRect As Any) As Long

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

Private Sub Form_Load()
    Form1.ScaleMode = vbPixels    
    ' We wil lock the curor into Picture1, so set up Picture1
    ' Position it top right of Form
    Picture1.Appearance = 0 'flat
    Picture1.Width = 1
    Picture1.Height = 1
    Picture1.Top = 1
    Picture1.Left = Form1.ScaleWidth - 16
End Sub

Private Sub Command1_Click()
    Dim myRect As RECT
    
     ' setup a timer so we can unlock the cursor after 5000ms
    Timer1.Interval = 5000
    Timer1.Enabled = True
    
    ' Get the rectangle that we want to lock the cursor into, we are using Picture1 (just needs to be a single pixel)...
    GetWindowRect Picture1.hWnd, myRect
    ' and lock it there
    ClipCursor myRect
    ' inform user of current status
    Text1.Text = "Clipped"
End Sub

Private Sub Form_Unload(Cancel As Integer)
    ClipCursor vbNull 'just in case
End Sub

Private Sub Timer1_Timer()
    ' Disable timer and unlock the cursor
    Timer1.Enabled = False
    ClipCursor vbNull
    ' inform user of current status
    Text1.Text = "Unclipped"
End Sub

[SpeakEasy]

What did you decide to do, Sal21?

[sal21]

What did you decide to do, Sal21?

sorry for delay.
Tested and work, for me!