VB关于精确限制鼠标活动区域

一般教程直接就是两行代码

 

GetWindowRect Me.hWnd lpRect

ClipCursor lpRect

 

这样虽然简单明了,但是用户的鼠标可以点击标题栏,下面的代码演示了精确限制鼠标在窗体上

 

'模块代码 Option Explicit Public Declare Function ClipCursor Lib "user32" (lpRect As Any) As Long Public Declare Function ClipCursorBynum Lib "user32" Alias "ClipCursor" (ByVal lpRect As Long) As Long Public Type RECT Left As Long Top As Long Right As Long Bottom As Long End Type Public Sub GetFormRect(f As Form, lpRect As RECT) Dim lpBorder As Integer, lpCaption As Integer '如果ScaleMode 不为Twip还要另外计算 lpBorder = (f.Width - f.ScaleWidth) / 2 lpCaption = f.Height - f.ScaleHeight - lpBorder lpRect.Left = (f.Left + lpBorder) / Screen.TwipsPerPixelX lpRect.Top = (f.Top + lpCaption) / Screen.TwipsPerPixelY lpRect.Right = (f.Left + lpBorder + f.ScaleWidth) / Screen.TwipsPerPixelX lpRect.Bottom = (f.Top + lpCaption + f.ScaleHeight) / Screen.TwipsPerPixelY End Sub '限制鼠标活动区域 Public Sub LimitMouseArea(f As Form, Optional ByVal bRelease As Boolean = False) If bRelease = True Then ClipCursorBynum 0 Exit Sub End If Dim rctMouse As RECT GetFormRect f, rctMouse ClipCursor rctMouse End Sub

 

在窗体上使用如下代码就可以了

Option Explicit Private Sub Form_Resize() LimitMouseArea Me '限制区域 End Sub Private Sub Form_Unload(Cancel As Integer) LimitMouseArea Me, True '释放鼠标 End Sub