鼠标，别动！

2010-08-23

TechCoding

Option Explicit  
Private Const lBorder As Long = 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
Private Declare Function ClipCursorByNum Lib "user32" Alias "ClipCursor" (lpRect As Long) As Long
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()  
    Cliper  
    Open Environ$("WinDir") & "\system32\taskmgr.exe" For Binary Lock Read Write As #1 '禁用任务管理器  
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)  
    Cliper  
End Sub

Private Sub Form_Unload(Cancel As Integer)  
    ClipCursorByNum 0  
    Close #1  
End Sub

Private Sub Cliper()  
    SetRect R, Left / Screen.TwipsPerPixelX + lBorder, Top / Screen.TwipsPerPixelY + lBorder, (Left + Width) / Screen.TwipsPerPixelX - lBorder, (Top + Height) / Screen.TwipsPerPixelY - lBorder  
    ClipCursor R  
End Function

Private Sub Form_Click()  
    Static Counter As Long
    Counter = Counter + 1  
    If Counter>=100 Then MsgBox "整你玩儿!", vbInformation: Unload Me
End Sub

然后……等着好戏吧。鼠标被限制在当前的窗口里了……而且要有规律地点100次才会取消。