vb中控制鼠标在程序的范围内

vb中控制鼠标在程序的范围内

＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
Option Explicit
Private Const lBorder As Long = 4 '边框大小，经测试，至少为4才能不出现用户点击窗体边缘导致失效。
Dim R As RECT
Private Type RECT
        Left As Long
        Top As Long
        Right As Long
        Bottom As Long
End Type
Private Declare Function ClipCursor Lib "user32" (lpRect As RECT) As Long
'lpRect-鼠标光标限制到的矩形
Private Declare Function ClipCursorByNum Lib "user32" Alias "ClipCursor" (lpRect As Long) As Long
'lpRect-传0，取消鼠标光标限制
Private Declare Function SetRect Lib "user32" (lpRect As RECT, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long

Private Sub Form_Load() '窗体载入后，鼠标只能在窗体范围内移动
SetRect R, Left / Screen.TwipsPerPixelX + lBorder, Top / Screen.TwipsPerPixelY + lBorder, (Left + Width) / Screen.TwipsPerPixelX - lBorder, (Top + Height) / Screen.TwipsPerPixelY - lBorder
ClipCursor R
End Sub

Private Sub Form_Unload(Cancel As Integer) '窗体退出时，取消鼠标光标限制范围
ClipCursorByNum 0
End Sub

一楼的方法执行后，鼠标移动到窗体边上，变成箭头形（即改变大小），一点，那个限制范围就失效了，算是个bug吧。下面这个代码是经过修正的，防止这一点出现。关闭程序后鼠标恢复正常。 ＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝ option explicit private const lborder as long = 4 '边框大小，经测试，至少为4才能不出现用户点击窗体边缘导致失效。 dim r as rect private type rect left as long top as long right as long bottom as long end type private declare function clipcursor lib "user32" (lprect as rect) as long 'lprect-鼠标光标限制到的矩形 private declare function clipcursorbynum lib "user32" alias "clipcursor" (lprect as long) as long 'lprect-传0，取消鼠标光标限制 private declare function setrect lib "user32" (lprect as rect, byval x1 as long, byval y1 as long, byval x2 as long, byval y2 as long) as long private sub form_load() '窗体载入后，鼠标只能在窗体范围内移动 setrect r, left / screen.twipsperpixelx + lborder, top / screen.twipsperpixely + lborder, (left + width) / screen.twipsperpixelx - lborder, (top + height) / screen.twipsperpixely - lborder clipcursor r end sub private sub form_unload(cancel as integer) '窗体退出时，取消鼠标光标限制范围 clipcursorbynum 0 end sub

Public Declare Function ClipCursor Lib "user32 " (ByRef lpRect As rect) As Integer Protected Overrides Function ProcessCmdKey(ByRef msg As Message, ByVal keyData As Keys) As Boolean If keyData = (Keys.Alt Or Keys.F4) Then Return True Else Return MyBase.ProcessCmdKey(msg, keyData) End If End Function Public Structure rect Dim left As Integer Dim top As Integer Dim right As Integer Dim bottom As Integer End Structure mouse.left = 0 mouse.top = 0 mouse.right = Screen.PrimaryScreen.Bounds.Right mouse.bottom = Screen.PrimaryScreen.Bounds.Bottom ClipCursor(mouse) 想要完整版的再联系我，我以前做过这方面的程序，很简单，就是要熟悉API。

如以上回答内容为低俗、色情、不良、暴力、侵权、涉及违法等信息，可以点下面链接进行举报！

点此我要举报以上问答信息