定制化窗体之限制鼠标在窗体内移动

定制化窗体之限制鼠标在窗体内移动(1)
2007-12-12 15:32
主     题
定制化窗体之限制鼠标在窗体内移动
版     本
Excel2000及其以后版本
说     明
本示例运用API函数来定制Excel中的用户窗体，使鼠标只能在窗体内移动。（Code By 王明柏）
在有的程序中，其可以限制鼠标只能在窗体内（包括标题栏等）移动。其实在VBA的用户窗体也可以做到。实现过程如下：
l         在Excel 的VBE窗口中插入一个用户窗体，将其命名为 ClipCursorForm。在用户窗体中添加一个 C ommandButton 控件，然后再添加一个模块。在窗体和模块中添加后面所列代码。
l         在工作薄中的任意工作表中添加一窗体按钮控件，将指定其 设置宏 为 ShowForm。其供示范之用
l         代码：
模块1代码
Option Explicit
'//****************************************************************************************************************************************
'// 此模块创建了一个回调函数和按钮调用程序
'//****************************************************************************************************************************************
'//将指针限制到指定区域
Private Declare Function ClipCursor _
Lib "user32" ( _
lpRect As RECT) _
As Long
'//返回指定窗口的屏幕坐标
Private Declare Function GetWindowRect _
Lib "user32" ( _
ByVal Hwnd As Long, _
lpRect As RECT) _
As Long
'//查找窗口句柄
Private Declare Function FindWindow _
Lib "user32" _
Alias "FindWindowA" ( _
ByVal lpClassName As String, _
ByVal lpWindowName As String) _
As Long
'//以下定义类型
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
'//以下定义变量
Private FormRect As RECT
'//****************************************************************************************************************************************
'// 此过程为工作表中按钮调用
'//****************************************************************************************************************************************
Sub ShowForm()
'//显示窗体
ClipCursorForm.Show
End Sub
'//----------------------------------------------------------------------------------------------------------------------------------------------------------------------
'//****************************************************************************************************************************************
'//Settimer函数的回调函数
'//****************************************************************************************************************************************
Public Function TimeOutProc(ByVal Hwnd As Long, ByVal uMsg As Long, ByVal idEvent As Long, ByVal SysTime As Long) As Long
Dim HwndForm As Long
'//取得窗口句柄
HwndForm = FindWindow(vbNullString, ClipCursorForm.Caption)
'//取得窗体的屏幕坐标
GetWindowRect HwndForm, FormRect
'//限制鼠标活动区域
ClipCursor FormRect
End Function
定制化窗体之限制鼠标在窗体内移动(2)
2007-12-12 15:33
ClipCursorForm窗体代码：
Option Explicit
'//****************************************************************************************************************************************
'//此程序演示将鼠标限制在窗体内
'//****************************************************************************************************************************************
'//将指针限制到指定区域
Private Declare Function ClipCursor _
Lib "user32" ( _
lpRect As RECT) _
As Long
'//设置Settimer过程
Private Declare Function SetTimer _
Lib "user32" ( _
ByVal Hwnd As Long, _
ByVal nIDEvent As Long, _
ByVal uElapse As Long, _
ByVal lpTimerfunc As Long) _
As Long
'//结束Settimer过程
Private Declare Function KillTimer _
Lib "user32" ( _
ByVal Hwnd As Long, _
ByVal nIDEvent As Long) _
As Long
'//清除指针剪切区域
Private Declare Function ClipCursorBynum _
Lib "user32" _
Alias "ClipCursor" ( _
ByVal lpRect As Long) _
As Long
'//返回指定窗口的屏幕坐标
Private Declare Function GetWindowRect _
Lib "user32" ( _
ByVal Hwnd As Long, _
lpRect As RECT) _
As Long
'//查找窗口句柄
Private Declare Function FindWindow _
Lib "user32" _
Alias "FindWindowA" ( _
ByVal lpClassName As String, _
ByVal lpWindowName As String) _
As Long
'//以下定义类型
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
'//以下定义变量
Private FormRect As RECT, TID As Long, Hwnd As Long
'//****************************************************************************************************************************************
'//                                     过程
'//****************************************************************************************************************************************
Private Sub CommandButton1_Click()
'//卸载窗体
Unload Me
End Sub
'//----------------------------------------------------------------------------------------------------------------------------------------------------------------------
Private Sub UserForm_Activate()
'//取得窗体句柄
Hwnd = FindWindow(vbNullString, Me.Caption)
'//取得窗体的屏幕坐标
GetWindowRect Hwnd, FormRect
'//将鼠标限制在窗体内
ClipCursor FormRect
End Sub
Private Sub UserForm_Initialize()
'//取得窗体句柄
Hwnd = FindWindow(vbNullString, Me.Caption)
'//设置Settimer过程
TID = SetTimer(Hwnd, 0, 10, AddressOf TimeOutProc)
End Sub
'//----------------------------------------------------------------------------------------------------------------------------------------------------------------------
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If TID <> 0 Then KillTimer Hwnd, TID
'//清除鼠标剪切
ClipCursorBynum 0
End Sub