在没有滚动条的状态下怎么样响应MOUSE滚轮的事件,如在from,image等控件中

Question

如标题,意思就是想做到像ACDSee看图时一样加载下一张图或上一张图的功能 
还望各位能帮帮忙

Answer 1

[原创] 在VB中支持鼠标滚轮（补充版） 原文发表在：http://www.dev-club.com/club/bbs/showEssence.asp?id=26695
 最近一直很忙，似乎好久没有贴点什么出来了，实在是对不起大家。早上的时候做了一个鼠标滚轮程序的测试。于是贴出来给各位，希望能有所帮助。    说起在VB中使用鼠标滚轮支持已经不是一个新鲜的话题，因为在此之前已经有不少高人研究过。精华区里就有一篇babytony转贴的《让你的程序支持鼠标滚轮》，所以我们的故事也从这里开始。
    早上一如既往的第一个来到办公室，打开电脑，想起昨天Boss开会时要求的对软件操作的一些改进，他希望我编写的软件能更人性化一点。哦，好吧，那么就从鼠标的应用开始。灵活使用MouseWheel，应该会给客户一个更好的印象。但是VB 6.0不支持鼠标滚轮是众所周知的，虽然我知道只要简单的获取WM_MouseWheel消息就可以解决这个问题，但是软件工程的思想指导我们：不可以重复制造“轮子”！^^;于是照例打开www.dev-club.com搜索一下，哈哈，看看我找到了什么?babytony的《让你的程序支持鼠标滚轮》,得来全不费功夫！（www.dev-club.com就是好啊 ^-^)    粗略的把整篇文章看了一下，恩，思路和我是差不多的。然后新建一个VB工程，按照文中的代码一一对应贴进去，保存，然后运行看一下效果。结果，结果。咦？结果是什么都没有？！连VB也消失了？不会把？眼睛花了么？赶快再打开刚才的工程（还好我做了一个保存），再运行一次又是同样的结果？！VB居然挂掉了：（看来。。这个“轮子”是有问题的（注：偶得测试环境为2000 server+VB 6.0+sp5)
     既然现成的“轮子”不能用，那么还是自己想办法把。再看一下文章中的程序，作者只是把这段程序内嵌在了他的代码里，如果想要拿出来用，还需自己修修补补（估计刚才也就是哪里修补坏了才会死掉的）。颇不方便。干脆一劳永逸，做一个通用的dll,就可以方便很多了。于是新建一个类，主要代码如下：Option Compare Text
Option ExplicitPrivate frm As Object
Private intCancel As Integer
Public Event MouseWheel(Cancel As Integer, nFlag As Long)Public Property Set Form(frmIn As Object)
    Set frm = frmIn
End PropertyPublic Property Get MouseWheelCancel() As Integer
    MouseWheelCancel = intCancel
End PropertyPublic Sub SubClassHookForm()
    lpPrevWndProc = SetWindowLong(frm.hwnd, GWL_WNDPROC, _
                                    AddressOf WindowProc)
      Set CMouse = Me
   End SubPublic Sub SubClassUnHookForm()
    Call SetWindowLong(frm.hwnd, GWL_WNDPROC, lpPrevWndProc)
End SubPublic Sub FireMouseWheel(nFlag As Long)
    RaiseEvent MouseWheel(intCancel, nFlag)
End Sub

Answer 2

再新建一个模块，代码如下：
Option Compare Text
Option ExplicitPublic CMouse As CMouseWheel
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
    (ByVal hwnd As Long, _
    ByVal nIndex As Long, _
    ByVal dwNewLong As Long) As LongPublic 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 Const GWL_WNDPROC = -4
Public Const WM_MouseWheel = &H20A
Public lpPrevWndProc As Long
Public Function WindowProc(ByVal hwnd As Long, _
    ByVal uMsg As Long, _
    ByVal wParam As Long, _
    ByVal lParam As Long) As Long
    Select Case uMsg
        Case WM_MouseWheel
            Dim wzDelta As Long
            wzDelta = HIWORD(wParam)
'            wKeys = LOWORD(wParam)
            
            CMouse.FireMouseWheel wzDelta
            If CMouse.MouseWheelCancel = False Then
                WindowProc = CallWindowProc(lpPrevWndProc, hwnd, uMsg, wParam, lParam)
            End If
            
        Case Else
           WindowProc = CallWindowProc(lpPrevWndProc, hwnd, uMsg, wParam, lParam)
    End Select
End FunctionPublic Function HIWORD(LongIn As Long) As Long
   ' 取出32位值的高16位
   HIWORD = (LongIn And &HFFFF0000) \ &H10000
End FunctionPublic Function LOWORD(LongIn As Long) As Long
    ' 取出32位值的低16位
      LOWORD = LongIn And &HFFFF&
End Function    做好了，测试一下吧，再添加一个project,引用该dll,写下测试代码，运行后滚动鼠标滚轮，看到debug窗口里出现了数值，正值为向上滚动，负值为向下滚动。恩，一切oK!再添加一个skin,应用skin再测试，一切依然OK(注：为什么要用skin进行测试呢？是因为skin的原理一般也是使用hook截取窗口消息，然后进行绘制的。所以放在这里测试一下，以防止和本程序有冲突）
    最后，做一个总结吧。其实本文没有什么特别的亮点。只是算babytony的《让你的程序支持鼠标滚轮》得一个补充。顺便提醒各位拿到别人的代码最好做一下测试，否则有什么问题也不知道，到了用的时候才发现不对，就不得不浪费更多的时间来调试。养成谨慎的编程习惯总是好的。另外能够封装起来的功能代码尽量封装，好的“轮子”多了，造车自然也就方便了。呵呵^^
    最后，如果各位在测试中发现任何问题，请及时通知我。我的mail:[email protected]

Answer 3

感謝agua06(阿瓜)先
我先作個測試行的話就回來結貼

Answer 4

agua06(阿瓜):CMouseWheel是什么？

Answer 5

对啊，agua06(阿瓜):CMouseWheel是什么啊
没法用啊

Answer 6

不好意思，最近一直忙于出差的关系CMouseWheel？CMouseWheel是我建立得类名阿相关的连接下有源代码和调试程序可以下载。直接打开源代码看看就知道啦~

Answer 7

來結貼了 
非常谢谢agua06(阿瓜) 的信息