为什么在xp环境在vb下用F5运行可以限制鼠标,而生成EXE文件后就不能限制鼠标移动范围那?

mustudent 2005-04-26 07:02:53
我先在模块中这样定义:
Public Type POINTAPI
x As Long
y As Long
End Type
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Public Declare Function SwapMouseButton Lib "user32" (ByVal bSwap As Long) As Long '决定是否互换鼠标左右键的功能
'交换按钮
'bswap为True时正常,为False时,互换
Public Declare Function ShowCursor Lib "user32" (ByVal bShow As Long) As Long '控制鼠标指针的可视性
'隐藏指针
'bShow为False时隐藏,为True时复原
Public Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long '获取鼠标指针的当前位置
Public Declare Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long '设置指针的位置
Public Declare Function ClientToScreen Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long '判断窗口内以客户区坐标表示的一个点的屏幕坐标
Public Declare Function ClipCursor Lib "user32" (lpRect As Any) As Long '将指针限制到指定区域。ClipCursorBynum是一个别名,允许我们清除以前设置的指针剪切区域

Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) '自己理解为调用库文件"kernel32.dll"的Sleep方法
Public Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long) '模拟一次鼠标事件

Public Sub clipto(toctl As Object) '自定义函数作用是:
On Error Resume Next
Dim tmprect As RECT
Dim pt As POINTAPI
With toctl
If TypeOf toctl Is Form Then
tmprect.Left = (.Left \ Screen.TwipsPerPixelX)
tmprect.Top = (.Top \ Screen.TwipsPerPixelY)
tmprect.Right = (.Left + .Width) \ Screen.TwipsPerPixelX
tmprect.Bottom = (.Top + .Height) \ Screen.TwipsPerPixelY
ElseIf TypeOf toctl Is Screen Then
tmprect.Left = 0
tmprect.Top = 0
tmprect.Right = (.Width \ Screen.TwipsPerPixelX)
tmprect.Bottom = (.Height \ Screen.TwipsPerPixelY)
Else
pt.x = 0
Call ClientToScreen(.hwnd, pt)
tmprect.Left = pt.x
tmprect.Top = pt.y
pt.x = .Width
pt.y = .Height
Call ClientToScreen(.hwnd, pt)
tmprect.Bottom = pt.y
tmprect.Right = pt.x
End If

End With
Call ClipCursor(tmprect)

End Sub
然后在程序中引用:
Dim s As Integer
Dim f As Integer
Dim xx, yy As Long
Dim pnt As POINTAPI
pnt.x = 0
pnt.y = 0
Me.Left = (Screen.Width - Me.Width) \ 2
Me.Top = (Screen.Height - Me.Height) \ 2
Call ClientToScreen(Me.hwnd, pnt)
xx = pnt.x + (Me.Width \ 2)
yy = pnt.y + (Me.Height \ 2)
Call SetCursorPos(xx, yy)
clipto Loads ' 把鼠标的活动范围缩小到loads范围内

s = 50
f = 50
SetWindowPos hwnd, -1, 0, 0, 0, 0, 3
生成的EXE文件在2000下也可以限制鼠标的移动,但是在XP下同样的EXE文件(而在vb下用F5运行是可以限制鼠标移动!!)就不能限制鼠标的移动了,为什么?
...全文
106 6 打赏 收藏 转发到动态 举报
写回复
用AI写文章
6 条回复
切换为时间正序
请发表友善的回复…
发表回复
mustudent 2005-04-29
  • 打赏
  • 举报
回复
能不能说得再详细点.....
blueink_200451 2005-04-28
  • 打赏
  • 举报
回复
Public Declare Function SwapMouseButton Lib "user32" (ByVal bSwap As Long) As Long '决定是否互换鼠标左右键的功能
'交换按钮
'bswap为True时正常,为False时,互换
Public Declare Function ShowCursor Lib "user32" (ByVal bShow As Long) As Long '控制鼠标指针的可视性
'隐藏指针
'bShow为False时隐藏,为True时复原
Public Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long '获取鼠标指针的当前位置
Public Declare Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long '设置指针的位置
Public Declare Function ClientToScreen Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long '判断窗口内以客户区坐标表示的一个点的屏幕坐标
Public Declare Function ClipCursor Lib "user32" (lpRect As Any) As Long '将指针限制到指定区域。ClipCursorBynum是一个别名,允许我们清除以前设置的指针剪切区域

Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) '自己理解为调用库文件"kernel32.dll"的Sleep方法
Public Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long) '模拟一次鼠标事件

Public Sub clipto(toctl As Object) '自定义函数作用是:
On Error Resume Next
Dim tmprect As RECT
Dim pt As POINTAPI
With toctl
If TypeOf toctl Is Form Then
tmprect.Left = (.Left \ Screen.TwipsPerPixelX)
tmprect.Top = (.Top \ Screen.TwipsPerPixelY)
tmprect.Right = (.Left + .Width) \ Screen.TwipsPerPixelX
tmprect.Bottom = (.Top + .Height) \ Screen.TwipsPerPixelY
ElseIf TypeOf toctl Is Screen Then
tmprect.Left = 0
tmprect.Top = 0
tmprect.Right = (.Width \ Screen.TwipsPerPixelX)
tmprect.Bottom = (.Height \ Screen.TwipsPerPixelY)
Else
pt.x = 0
Call ClientToScreen(.hwnd, pt)
tmprect.Left = pt.x
tmprect.Top = pt.y
pt.x = .Width
pt.y = .Height
Call ClientToScreen(.hwnd, pt)
tmprect.Bottom = pt.y
tmprect.Right = pt.x
End If

End With
Call ClipCursor(tmprect)

End Sub
然后在程序中引用:
Dim s As Integer
Dim f As Integer
Dim xx, yy As Long
Dim pnt As POINTAPI
pnt.x = 0
pnt.y = 0
Me.Left = (Screen.Width - Me.Width) \ 2
Me.Top = (Screen.Height - Me.Height) \ 2
Call ClientToScreen(Me.hwnd, pnt)
xx = pnt.x + (Me.Width \ 2)
yy = pnt.y + (Me.Height \ 2)
Call SetCursorPos(xx, yy)
clipto Loads ' 把鼠标的活动范围缩小到loads范围内

s = 50
f = 50
SetWindowPos hwnd, -1, 0, 0, 0, 0, 3



关键是要把你的坐标重定义一下,你的坐标也必须要精确。
duanlidong 2005-04-28
  • 打赏
  • 举报
回复
Public Sub clipto(toctl As Object) '自定义函数作用是:
On Error Resume Next
Dim tmprect As RECT
Dim pt As POINTAPI
With toctl
If TypeOf toctl Is Form Then
tmprect.Left = (.Left \ Screen.TwipsPerPixelX)
tmprect.Top = (.Top \ Screen.TwipsPerPixelY)
tmprect.Right = (.Left + .Width) \ Screen.TwipsPerPixelX
tmprect.Bottom = (.Top + .Height) \ Screen.TwipsPerPixelY
ElseIf TypeOf toctl Is Screen Then
tmprect.Left = 0
tmprect.Top = 0
tmprect.Right = (.Width \ Screen.TwipsPerPixelX)
tmprect.Bottom = (.Height \ Screen.TwipsPerPixelY)
Else
pt.x = 0
Call ClientToScreen(.hwnd, pt)
tmprect.Left = pt.x
tmprect.Top = pt.y
pt.x = .Width
pt.y = .Height
Call ClientToScreen(.hwnd, pt)
tmprect.Bottom = pt.y
tmprect.Right = pt.x
End If
wylcy 2005-04-28
  • 打赏
  • 举报
回复
限制鼠标最好用windows hook
qjzrd 2005-04-28
  • 打赏
  • 举报
回复
学习
dongge2000 2005-04-26
  • 打赏
  • 举报
回复
Option Explicit

Public Declare Sub ClipCursor Lib "user32" (lpRect As Any)
Public Declare Sub GetClientRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT)
Public Declare Sub ClientToScreen Lib "user32" (ByVal hWnd As Long, lpPoint As POINT)
Public Declare Sub OffsetRect Lib "user32" (lpRect As RECT, ByVal x As Long, ByVal y As Long)
Public Type RECT
left As Long
top As Long
right As Long
bottom As Long
End Type
Public Type POINT
x As Long
y As Long
End Type
Dim client As RECT
Dim Cur As POINT
Public Function SetMouseRect(ByVal hWnd As Long, ByVal Install As Boolean) As Long
If Not Install Then ClipCursor ByVal 0&: Exit Function
GetClientRect hWnd, client
Cur.x = client.left
Cur.y = client.top
ClientToScreen hWnd, Cur
OffsetRect client, Cur.x, Cur.y
ClipCursor client
End Function

1,486

社区成员

发帖
与我相关
我的任务
社区描述
VB API
社区管理员
  • API
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧