[VB6]为什么水平滚动无法启动? [英] [VB6] why horizontal scroll doesn't woks?

问题描述

我有这些模块可与鼠标滚轮一起使用.在垂直方向盘上可以正常工作，但在水平方向盘上不能响应.为什么?

i have these module for work with mouse wheel. works fine with vertical wheel, but doesn't respond with horizontal whell. why?

'Ed Wilk/Edgemeal give me the code
'with some help i did my changes;)
' ///////////////////////////////////////////////
'  Return MouseWheel Over Multiple UserControls
'  Ed Wilk/Edgemeal
'  Example UPDATED September 18, 2008
' ///////////////////////////////////////////////
'
' ****************************************************
' IMPORTANT NOTICE:
'   To stop the hook from sending messages to a
'   window handle set the variable MouseOverControl
'   to zero!
' ****************************************************
Option Explicit

Private PrevWin2 As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private 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
Private Const GWL_WNDPROC = (-4)
Private Const WM_MOUSEWHEEL = &H20A
Private Const WM_KEYDOWN = &H100
Public MouseOverControl As Long ' Handle for User Control (mouse move)
Private Const WM_HSCROLL = &H114
Public blnControlKey As Boolean

'with these public variable i can, only, use these event when the mouse is in control
'because out off it, isn't need it;)

Private Function Proc2(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
       If Msg = WM_MOUSEWHEEL And MouseOverControl > 0 Then
            If LoWord(wParam) > 0 Then ' the Horizontal right mouse wheel rotated
                SendMessage MouseOverControl, WM_KEYDOWN, 1000, 0
                Debug.Print "H-R"
            ElseIf LoWord(wParam) < 0 Then ' the Horizontal left mouse wheel rotated
                SendMessage MouseOverControl, WM_KEYDOWN, 1001, 0
                Debug.Print "H-L"
            ElseIf HiWord(wParam) > 0 Then ' the Vertical  mouse wheel rotated
                SendMessage MouseOverControl, WM_KEYDOWN, 1002, 0
                Debug.Print "V-U"
            ElseIf HiWord(wParam) < 0 Then ' vertical down mouse wheel rotated
                SendMessage MouseOverControl, WM_KEYDOWN, 1003, 0
                Debug.Print "V-D"
            End If
        End If
    
    Proc2 = CallWindowProc(PrevWin2, hwnd, Msg, wParam, lParam)
End Function

Public Sub Hook2(handle As Long)
    If PrevWin2 = 0 Then
        PrevWin2 = SetWindowLong(handle, GWL_WNDPROC, AddressOf Proc2)
    End If
End Sub

Public Sub Unhook2(handle As Long)
    If PrevWin2 Then
        Call SetWindowLong(handle, GWL_WNDPROC, PrevWin2)
        PrevWin2 = 0
    End If
End Sub

Public Function HiWord(ByVal lDWord As Long) As Integer
  HiWord = (lDWord And &HFFFF0000) \ 65536
End Function

Public Function LoWord(ByVal lDWord As Long) As Integer
  If lDWord And &H8000& Then
    LoWord = lDWord Or &HFFFF0000
  Else
    LoWord = lDWord And &HFFFF&
  End If
End Function

我尝试阅读mdsn文档中的内容，但没有成功:(

i try read something in mdsn documentation, but without sucess:(

有人可以建议我吗?

谢谢

推荐答案

您在错误的论坛中发了帖.这是 VB.NET 论坛.请查看此页面顶部附近的粘贴链接，标题为"

You've posted in the wrong forum.  This is the VB.NET forum.  Please see the sticky link near the top of this page titled "For Visual Basic 6 questions, please read... " to find a VB6 forum.

:)

这篇关于[VB6]为什么水平滚动无法启动?的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！