如何使VB6.0支持鼠标滚轮

*** 作步骤如下：

1、下载

http://download.microsoft.com/download/e/f/b/efb39198-7c59-4ace-a5c4-8f0f88e00d34/vb6mousewheel.exe

这是一个自解压的包，其中包含VB6IDEMouseWheelAddin.dll和其源程序，将其解压到桌面即可。

2、选择直接使用VB6IDEMouseWheelAddin.dll，或者无聊地将源程序自行编译出一个新的VB6IDEMouseWheelAddin.dll。

3、在cmd里运行：regsvr32 VB6IDEMouseWheelAddin.dll 运行前请将当前路劲切换（cd命令）到桌面，或者将这个dll复制到cmd默认路径下。

4. 运行目录下的“VBA Mouse Wheel Fix.reg”。

5、运行VB6.0。

6、点击菜单中 外接程序（A） =》 外接程序管理器（A）。

7、在列表中，选择“MouseWheel Fix”，在“外接程序管理器“ 右下角的 加载行为 中将前两项勾上，即 在启动中加载（S） 和 加载/卸载（L）。

8、确定，退出VB6.0。

9. 重新启动VB6.0，进入代码编辑窗口，鼠标滚轮支持成功！

'功能：VB鼠标滚轮控制DirListBox控件选择

'标准模块中：

Option Explicit

Public 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

Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long

Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

Public Const GWL_WNDPROC = -4&

Public Const WM_MOUSEWHEEL = &H20A

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

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

Public Type POINTAPI

        x As Long

        y As Long

End Type

Public OldWindowProc As Long '用来保存系统默认的窗口消息处理函数的地址

Public hwndDirListBox As Long  '用来保存Dir1控件的句柄

'自定义的消息处理函数

Public Function NewWindowProc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

    On Error Resume Next

    If Msg = WM_MOUSEWHEEL Then

        '下面得到鼠标位置处的对象的句柄

        Dim CurPoint As POINTAPI, hwndUnderCursor As Long

        GetCursorPos CurPoint

        hwndUnderCursor = WindowFromPoint(CurPoint.x, CurPoint.y)

        '如果鼠标位于Form1.Dir1内部，则对鼠标滚轮事件进行处理

        If hwndUnderCursor = hwndDirListBox Then

            If wParam = -7864320 Then '向下滚动

                Form1.Dir1.ListIndex = Form1.Dir1.ListIndex - 1

            ElseIf wParam = 7864320 Then '向上滚动

                Form1.Dir1.ListIndex = Form1.Dir1.ListIndex + 1

            End If

        End If

    Else

        '调用Dir1的默认窗口消息处理函数

        NewWindowProc = CallWindowProc(OldWindowProc, hwnd, Msg, wParam, lParam)

    End If

End Function

'窗体中添加DirListBox控件(Dir1),CommandButton控件(Command1)：

Private Sub Command1_Click()

Print Dir1.List(Dir1.ListIndex)

End Sub

Private Sub Form_Load()

    '取得Dir1控件的句柄

    hwndDirListBox = Dir1.hwnd

    '保存Dir1控件的默认窗口消息处理函数地址

    OldWindowProc = GetWindowLong(Dir1.hwnd, GWL_WNDPROC)

    '将Dir1控件的消息处理函数指定为自定义函数NewWindowProc

    Call SetWindowLong(Dir1.hwnd, GWL_WNDPROC, AddressOf NewWindowProc)

End Sub

Private Sub Form_Unload(Cancel As Integer)

Dim lngReturnValue As Long

lngReturnValue = SetWindowLong(hwndDirListBox, GWL_WNDPROC, OldWindowProc)

End Sub

---