关于鼠标 滚轮 穿透(内有代码)api不是很懂.给我完成马上结贴给分

dianzi888999 2011-05-07 06:04:00
鼠标滚轮穿透:大家都懂的吧 我在这里多言下,比如资源管理器左边目录右边文件 不用激活就能滚动 鼠标指哪滚哪.
窗体:
Private Sub Form_Load()
lHook = SetWindowsHookEx(WH_MOUSE_LL, AddressOf CallMouseHookProc, App.hInstance, 0) '窗体载入时安装鼠标钩子
End Sub
模块:可能有些api调用是没用的.现在问题貌是捕获鼠标滚轮消息吧
Public Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long
Public Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Public Type POINTAPI
X As Long
Y As Long
End Type
Public Declare Function PostMessage& Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any)
Public Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
Public Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Public Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpvDest As Any, ByVal lpvSource As Long, ByVal cbCopy As Long)
Public Type MOUSEMSGS
X As Long 'x座标
Y As Long 'y座标
a As Long
b As Long
time As Long 'Window运行时间
End Type
Public Const WH_MOUSE_LL = 14

'-----------------------------------------
'消息
Public Const HC_ACTION = 0

'鼠标消息
Public Const WM_MOUSEMOVE = &H200
Public Const WM_LBUTTONDOWN = &H201
Public Const WM_LBUTTONUP = &H202
Public Const WM_LBUTTONDBLCLK = &H203
Public Const WM_RBUTTONDOWN = &H204
Public Const WM_RBUTTONUP = &H205
Public Const WM_RBUTTONDBLCLK = &H206
Public Const WM_MBUTTONDOWN = &H207
Public Const WM_MBUTTONUP = &H208
Public Const WM_MBUTTONDBLCLK = &H209
Public Const WM_MOUSEACTIVATE = &H21
Public Const WM_MOUSEFIRST = &H200
Public Const WM_MOUSELAST = &H209
Public Const WM_MOUSEWHEEL = &H20A

Public MouseMsg As MOUSEMSGS
Public lHook As Long '记录Hook的值，以便退出程序的时候销毁Hook

'鼠标钩子
Public Function CallMouseHookProc(ByVal code As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
If code = HC_ACTION Then
CopyMemory MouseMsg, lParam, LenB(MouseMsg)

Dim lpPoint As POINTAPI

Dim LOWORD() As Long
Dim HIWORD() As Long

Dim WindowHandle As Long

GetCursorPos lpPoint '获取当前鼠标指针坐标

WindowHandle = WindowFromPoint(lpPoint.X, lpPoint.Y)
Dim wzDelta, wKeys As Integer
Form1.Caption = "当前鼠标指针位置句柄：" & WindowHandle

zDelta = HIWORD(wParam)
fwKeys = LOWORD(wParam)
Select Case wParam
Case WM_MOUSEWHEEL
PostMessage WindowHandle, WM_MOUSEWHEEL, MakeLong(fwKeys, zDelta), MAKELPARAM(lpPoint.X, lpPoint.Y)
End Select

End If
If code <> 0 Then
CallMouseHookProc = CallNextHookEx(0, code, wParam, lParam) '用CallNextHookEx，保证钩子能被其它程序使用
End If
End Function

Public Function LOWORD(LongIn As Long) As Integer
' 取出32位值的低16位
LOWORD = LongIn And &HFFFF&
End Function
Public Function HIWORD(LongIn As Long) As Integer
' 取出32位值的高16位
HIWORD = (LongIn And &HFFFF0000) \ &H10000
End Function
Public Function MAKELPARAM(ByVal l As Integer, ByVal h As Integer) As Long
Dim ll As String
Dim lh As String
Dim r As String
ll = Format(Hex(l), "@@@@")
lh = Format(Hex(h), "@@@@")


MAKELPARAM = CLng("&h" & Replace(lh & ll, " ", "0"))
End Function
Public Function MakeLong(ddLow As Long, ddHigh As Long) As Long
MakeLong = ddHigh * 65536 + ddLow
End Function
...全文
351 10 打赏 收藏 转发到动态 举报
写回复
用AI写文章
10 条回复
切换为时间正序
请发表友善的回复…
发表回复
dianzi888999 2011-05-07
  • 打赏
  • 举报
 回复
可以用了 .多谢啦 帮了我的大忙!!
Lactoferrin 2011-05-07
  • 打赏
  • 举报
 回复 


Public Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long

    Public Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long

    Public Type POINTAPI

    X As Long

    Y As Long

    End Type

Public Declare Function PostMessage& Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Any)

Public Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long

Public Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long

Public Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long

Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpvDest As Any, ByVal lpvSource As Long, ByVal cbCopy As Long)

Public Declare Function GetForegroundWindow Lib "user32" () As Long

Declare Function GetGUIThreadInfo Lib "user32.dll" (ByVal ThreadId As Long, gui As GUITHREADINFO) As Long

Public Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long



Public Type MOUSEMSGS

       X As Long            'x座标

       Y As Long            'y座标

       mousedata As Long

       flags As Long

       time As Long         'Window运行时间

       dwExtraInfo As Long

End Type

Public Const WH_MOUSE_LL = 14

Public Type RECT

        Left As Long

        Top As Long

        Right As Long

        Bottom As Long

End Type

Type GUITHREADINFO

   cbSize As Long

   flags As Long

   hwndActive As Long

   hwndFocus As Long

   hwndCapture As Long

   hwndMenuOwner As Long

   hwndMoveSize As Long

   hwndCaret As Long

   rcCaret As RECT

End Type

'-----------------------------------------

'消息

Public Const HC_ACTION = 0



'鼠标消息

Public Const WM_MOUSEMOVE = &H200

Public Const WM_LBUTTONDOWN = &H201

Public Const WM_LBUTTONUP = &H202

Public Const WM_LBUTTONDBLCLK = &H203

Public Const WM_RBUTTONDOWN = &H204

Public Const WM_RBUTTONUP = &H205

Public Const WM_RBUTTONDBLCLK = &H206

Public Const WM_MBUTTONDOWN = &H207

Public Const WM_MBUTTONUP = &H208

Public Const WM_MBUTTONDBLCLK = &H209

Public Const WM_MOUSEACTIVATE = &H21

Public Const WM_MOUSEFIRST = &H200

Public Const WM_MOUSELAST = &H209

Public Const WM_MOUSEWHEEL = &H20A



Public MouseMsg As MOUSEMSGS

Public lHook As Long '记录Hook的值，以便退出程序的时候销毁Hook

Public lClick As Long, mClick As Long, rClick As Long, tClick As Long '用来统计鼠标各个键的按下次数





'鼠标钩子

Public Function CallMouseHookProc(ByVal code As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

If code = HC_ACTION Then

    CopyMemory MouseMsg, lParam, LenB(MouseMsg)



            Dim lpPoint As POINTAPI



            Dim WindowHandle As Long, gui As GUITHREADINFO, tid As Long



            GetCursorPos lpPoint '获取当前鼠标指针坐标



            WindowHandle = WindowFromPoint(lpPoint.X, lpPoint.Y)

             Form1.Caption = "当前鼠标指针位置句柄：" & WindowHandle

If wParam = WM_MOUSEWHEEL Then

            gui.cbSize = Len(gui)

            tid = GetWindowThreadProcessId(GetForegroundWindow(), ByVal 0)

            If GetGUIThreadInfo(tid, gui) <> 0 Then

            

            

            If gui.hwndCapture <> WindowHandle Then

            

           

              PostMessage WindowHandle, WM_MOUSEWHEEL, MouseMsg.mousedata, MAKELPARAM(lpPoint.X, lpPoint.Y)

              CallMouseHookProc = 1

              Exit Function

              End If

              End If

End If

End If

    CallMouseHookProc = CallNextHookEx(0, code, wParam, lParam) '使用CallNextHookEx，来保证鼠标钩子能够被其它程序使用

End Function



Public Function LOWORD(ByVal LongIn As Long) As Integer

' 取出32位值的低16位

LOWORD = LongIn And &HFFFF&

End Function

Public Function HIWORD(ByVal LongIn As Long) As Integer

' 取出32位值的高16位

HIWORD = (LongIn And &HFFFF0000) \ &H10000

End Function

Public Function MAKELPARAM(ByVal l As Integer, ByVal h As Integer) As Long

    Dim ll As String

    Dim lh As String

    Dim r As String

    ll = Format(Hex(l), "@@@@")

    lh = Format(Hex(h), "@@@@")

    



    MAKELPARAM = CLng("&h" & Replace(lh & ll, " ", "0"))

End Function

Public Function MakeLong(ByVal ddLow As Long, ByVal ddHigh As Long) As Long

MakeLong = ddHigh * 65536 + ddLow

End Function
dianzi888999 2011-05-07
  • 打赏
  • 举报
 回复
回Lactoferrin:
目前在资源管理器里实测:
当右边文件列表框处于激活状态 时 把鼠标移到左边目录上 这时两个框都会同时滚动 .这个再帮我完善下吧.
Lactoferrin 2011-05-07
  • 打赏
  • 举报
 回复
mouse1.bas改成这个


Public Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long

    Public Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long

    Public Type POINTAPI

    X As Long

    Y As Long

    End Type

Public Declare Function PostMessage& Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Any)

Public Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long

Public Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long

Public Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long

Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpvDest As Any, ByVal lpvSource As Long, ByVal cbCopy As Long)

Public Type MOUSEMSGS

       X As Long            'x座标

       Y As Long            'y座标

       mousedata As Long

       flags As Long

       time As Long         'Window运行时间

       dwExtraInfo As Long

End Type

Public Const WH_MOUSE_LL = 14



'-----------------------------------------

'消息

Public Const HC_ACTION = 0



'鼠标消息

Public Const WM_MOUSEMOVE = &H200

Public Const WM_LBUTTONDOWN = &H201

Public Const WM_LBUTTONUP = &H202

Public Const WM_LBUTTONDBLCLK = &H203

Public Const WM_RBUTTONDOWN = &H204

Public Const WM_RBUTTONUP = &H205

Public Const WM_RBUTTONDBLCLK = &H206

Public Const WM_MBUTTONDOWN = &H207

Public Const WM_MBUTTONUP = &H208

Public Const WM_MBUTTONDBLCLK = &H209

Public Const WM_MOUSEACTIVATE = &H21

Public Const WM_MOUSEFIRST = &H200

Public Const WM_MOUSELAST = &H209

Public Const WM_MOUSEWHEEL = &H20A



Public MouseMsg As MOUSEMSGS

Public lHook As Long '记录Hook的值，以便退出程序的时候销毁Hook

Public lClick As Long, mClick As Long, rClick As Long, tClick As Long '用来统计鼠标各个键的按下次数





'鼠标钩子

Public Function CallMouseHookProc(ByVal code As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

If code = HC_ACTION Then

    CopyMemory MouseMsg, lParam, LenB(MouseMsg)



            Dim lpPoint As POINTAPI



            Dim WindowHandle As Long



            GetCursorPos lpPoint '获取当前鼠标指针坐标



            WindowHandle = WindowFromPoint(lpPoint.X, lpPoint.Y)

            Dim wzDelta, wKeys   As Integer

            Form1.Caption = "当前鼠标指针位置句柄：" & WindowHandle

    Select Case wParam

        Case WM_MOUSEWHEEL

              PostMessage WindowHandle, WM_MOUSEWHEEL, MouseMsg.mousedata, MAKELPARAM(lpPoint.X, lpPoint.Y)

    End Select



End If

    CallMouseHookProc = CallNextHookEx(0, code, wParam, lParam) '使用CallNextHookEx，来保证鼠标钩子能够被其它程序使用

End Function



Public Function LOWORD(ByVal LongIn As Long) As Integer

' 取出32位值的低16位

LOWORD = LongIn And &HFFFF&

End Function

Public Function HIWORD(ByVal LongIn As Long) As Integer

' 取出32位值的高16位

HIWORD = (LongIn And &HFFFF0000) \ &H10000

End Function

Public Function MAKELPARAM(ByVal l As Integer, ByVal h As Integer) As Long

    Dim ll As String

    Dim lh As String

    Dim r As String

    ll = Format(Hex(l), "@@@@")

    lh = Format(Hex(h), "@@@@")

    



    MAKELPARAM = CLng("&h" & Replace(lh & ll, " ", "0"))

End Function

Public Function MakeLong(ByVal ddLow As Long, ByVal ddHigh As Long) As Long

MakeLong = ddHigh * 65536 + ddLow

End Function
dianzi888999 2011-05-07
  • 打赏
  • 举报
 回复
已发邮箱 .
dianyancao 2011-05-07
  • 打赏
  • 举报
 回复
想奔潰用Out做吧
Lactoferrin 2011-05-07
  • 打赏
  • 举报
 回复
把东西发到ribonucleic_acid@126.com给我看看
dianzi888999 2011-05-07
  • 打赏
  • 举报
 回复
问题就是获取滚轮消息时的错误.你那有VB环境吧给我调试一下吧.本来想200分的.可我目前状态只能发100分的.
Lactoferrin 2011-05-07
  • 打赏
  • 举报
 回复
哪个地方有问题?
dianyancao 2011-05-07
  • 打赏
  • 举报
 回复
65536 +
高德地图(AMap)JavaScript API的使用
  申请JSAPI的开发者key 申请地址：http://lbs.amap.com/dev/key   引入高德地图JavaScript API文件: &lt;script type="text/javascript" src="http://webapi.amap.com/maps?v=1.3&amp;key=您申请的key值"&gt;&lt;/script&gt;   创建...
鼠标交互的使用与优化
无论是PC端的鼠标交互还是移动端的触摸交互，我们暂且都泛称为鼠标交互。这是游戏引擎实现人机交互的基础。本文从LayaAir引擎鼠标交互的基础使用开始（包括2D与3D），到进阶级的使用，进行全面介绍，希望对使用LayaAir的新老朋友都有所帮助。一、鼠标交互的基础使用非新手开发者，可以跳过本小节1.1 鼠标事件的类型鼠标事件是鼠标交互的基础之一。例如点击，按下，离开，滚动等等，有了这些鼠标事件，我们...
移动端、pc端，遮罩层滚动穿透问题
常见的解决方式有一下三种： 1. css 之 overflow: hidden； .model-open { overflow: hidden; height: 100%; } 遮罩层显示时将 .modal-open 添加到 html上，删除多余一页的部分，禁止页面滚动。 遮罩层隐藏时，移除.modal-open，恢复页面滚动即可； 缺点： pc端有效，移动端无效 2. js 之...
选中回填 高德_高德地图(AMap)JavaScript API的使用
申请JSAPI的开发者key引入高德地图JavaScript API文件:创建地图容器在页面body里你想展示地图的地方创建一个div 容器，并指定id标识:指定容器大小按照需要设定地图容器的大小，确保大小合适,比如用CSS这样设置它:#container {width:300px; height: 180px; }创建地图设定地图的中心点和级别我们一般需要给地图按需设定中心点和坐标等属性，这里可...
高德地图Js API的使用
申请JSAPI的开发者key 申请地址：http://lbs.amap.com/dev/key 引入高德地图JavaScript API文件: 创建地图容器 在页面body里你想展示地图的地方创建一个div 容器，并指定id标识: 指定容器大小 按照需要设定地图容器的大小，确保大小合适,比如用CSS这样设置它: #container {width:300px; he
API

1,486

社区成员

23,279

社区内容

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

加载中

查看更多榜单
社区公告
暂无公告

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

+ 用AI写文章