none
请教vb6鼠标滚轮事件在win10下运行问题 RRS feed

 > 

  • 问题

  • Question
    登录进行投票
    0
    登录进行投票
    下面代码，在xp系统和win7系统下，只要text1或text2控件获得焦点，鼠标在任何位置滚动滚轮都正常执行代码。但是，在win10系统下运行，当text1或text2获得焦点后，鼠标必须在获得焦点的控件范围内，才能执行滚轮代码，离开后则不执行。求帮忙解决！谢谢！！！

    '模块
    Option Explicit

    Public Const GWL_WNDPROC = (-4)

    Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
    Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
    Public prevWndProc As Long
    Dim t As Boolean

    Function WndProc(ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    If Msg = 522 Then
    If wParam > 0 Then
    If Form1.Label1.Caption = "1" Then
    Form1.Text1.Text = Form1.Text1.Text + 1
    Else
    Form1.Text2.Text = Form1.Text2.Text + 1
    End If
    Else
    If Form1.Label1.Caption = "1" Then
    If Form1.Text1.Text > 0 Then Form1.Text1.Text = Form1.Text1.Text - 1
    Else
    If Form1.Text2.Text > 0 Then Form1.Text2.Text = Form1.Text2.Text - 1
    End If
    End If
    End If
    WndProc = CallWindowProc(prevWndProc, hWnd, Msg, wParam, lParam)

    End Function
    '窗体
    Option Explicit

    Private Sub Text1_GotFocus()
    Label1.Caption = 1
    Text1.Text = "0"
    prevWndProc = GetWindowLong(Text1.hWnd, GWL_WNDPROC)
    SetWindowLong Text1.hWnd, GWL_WNDPROC, AddressOf WndProc
    End Sub

    Private Sub Text1_LostFocus()
    SetWindowLong Text1.hWnd, GWL_WNDPROC, prevWndProc
    End Sub

    Private Sub Text2_GotFocus()
    Label1.Caption = 2
    Text2.Text = "0"
    prevWndProc = GetWindowLong(Text2.hWnd, GWL_WNDPROC)
    SetWindowLong Text2.hWnd, GWL_WNDPROC, AddressOf WndProc
    End Sub

    Private Sub Text2_LostFocus()
    SetWindowLong Text2.hWnd, GWL_WNDPROC, prevWndProc
    End Sub
    2020年4月26日 2:16
    |

答案

  • Question
    登录进行投票
    0
    登录进行投票
    问题自己解决了，是我将问题想偏了，以为VB6的代码落后，在win10系统里可能不兼容，或者win10系统里被调用的函数属性有改变，昨天忽然想到会不会是鼠标设置的问题，一试之下，问题立马解决。win10系统的鼠标设置里有一个选项“当我悬停在非活动窗口上方时对其进行滚动”，将它关闭就可以了。问题原因分析：当鼠标离开获得焦点的控件范围后，该功能就将鼠标滚轮的焦点移动到了鼠标指针所在位置的控件或窗体上，滚动滚轮就变成滚动鼠标指针所在位置的控件或窗体，所以代码内的命令没有得到执行。
    2020年5月9日 0:20
    |

全部回复

  • Question
    登录进行投票
    0
    登录进行投票

    你好，

    根据你的描述，这个应该是开发相关的问题。建议发帖至开发者论坛，他们或许更熟悉此类问题。

    https://social.msdn.microsoft.com/forums/zh-cn/home?category=windowsclient&filter=alltypes&sort=lastpostdesc

    如果我的回复对你有帮助，请将其标记为答案。

    针对Windows 2008/2008R2的扩展支持已于2020年1月结束，微软不再为其提供安全更新。点击此处或扫描二维码获取《在 Azure 上运行 Windows Server 的终极指南》，把握良机完成云迁移并实现业务现代化。


    • 已编辑 Joy-Qiao 2020年4月27日 2:20
    • 已建议为答案 Joy-Qiao 2020年4月30日 8:32
    2020年4月27日 2:20
    |
  • Question
    登录进行投票
    0
    登录进行投票

    你好，

    如果我的回复对你有帮助，烦请标记为答案。

    感谢您的配合。

    针对Windows 2008/2008R2的扩展支持已于2020年1月结束，微软不再为其提供安全更新。点击此处或扫描二维码获取《在 Azure 上运行 Windows Server 的终极指南》，把握良机完成云迁移并实现业务现代化。



    • 已编辑 Joy-Qiao 2020年4月30日 8:33
    2020年4月30日 8:33
    |
  • Question
    登录进行投票
    0
    登录进行投票
    按你说的，到开发者论坛发帖，至今无人解答……
    2020年5月7日 7:57
    |
  • Question
    登录进行投票
    0
    登录进行投票

    由于该论坛的英文版活跃度比较高，您还可以在英文论坛发帖提问。

    https://social.msdn.microsoft.com/forums/en-us/home?category=windowshardwaredev&filter=alltypes&sort=lastpostdesc

    或者您可以使用下列链接开有偿付费咨询。

    https://support.microsoft.com/zh-cn/assistedsupportproducts

    由于您的问题并不是我们所能支持的范围，所以仅能提供以上途径进行咨询，感谢您的理解。

    针对Windows 2008/2008R2的扩展支持已于2020年1月结束，微软不再为其提供安全更新。点击此处或扫描二维码获取《在 Azure 上运行 Windows Server 的终极指南》，把握良机完成云迁移并实现业务现代化。

    2020年5月7日 9:01
    |
  • Question
    登录进行投票
    0
    登录进行投票
    问题自己解决了，是我将问题想偏了，以为VB6的代码落后，在win10系统里可能不兼容，或者win10系统里被调用的函数属性有改变，昨天忽然想到会不会是鼠标设置的问题，一试之下，问题立马解决。win10系统的鼠标设置里有一个选项“当我悬停在非活动窗口上方时对其进行滚动”，将它关闭就可以了。问题原因分析：当鼠标离开获得焦点的控件范围后，该功能就将鼠标滚轮的焦点移动到了鼠标指针所在位置的控件或窗体上，滚动滚轮就变成滚动鼠标指针所在位置的控件或窗体，所以代码内的命令没有得到执行。
    2020年5月9日 0:20
    |
  • Question
    登录进行投票
    0
    登录进行投票
    感谢您的反馈。这或许对同样问题的用户能起到很大的提示作用或者帮助。

    针对Windows 2008/2008R2的扩展支持已于2020年1月结束，微软不再为其提供安全更新。点击此处或扫描二维码获取《在 Azure 上运行 Windows Server 的终极指南》，把握良机完成云迁移并实现业务现代化。


    • 已编辑 Joy-Qiao 2020年5月11日 1:24
    2020年5月11日 1:24
    |