怎样通过鼠标滚轮的滚动来控制一个对象（如图片）的移动？

Question

就像SLIDER控件和VScrollbar控件一样可以用滚轮来控制。

Answer 1

Option Explicit
Public Type POINTL
X As Long
Y As Long
End Type
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 SetWindowLong Lib "USER32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Declare Function SystemParametersInfo Lib "USER32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, lpvParam As Any, ByVal fuWinIni As Long) As Long
Declare Function ScreenToClient Lib "USER32" (ByVal hWnd As Long, xyPoint As POINTL) As LongPublic Const GWL_WNDPROC = -4
Public Const SPI_GETWHEELSCROLLLINES = 104
Public Const WM_MOUSEWHEEL = &H20A
Public WHEEL_SCROLL_LINES As LongGlobal lpPrevWndProc As LongPublic sngX As Single, sngY As Single   '鼠标坐标
Public intShift As Integer              '鼠标按键
Public bWay As Boolean                  '鼠标方向
Public bMouseFlag As Boolean            '鼠标事件激活标志'*************************************************************************
'**函 数 名：Hook
'**输    入：ByVal hWnd(Long) - 窗口句柄
'**输    出：无
'**功能描述：安装鼠标钩子
'*************************************************************************
Public Sub Hook(ByVal hWnd As Long)
    lpPrevWndProc = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf WindowProc)
    '获取"控制面板"中的滚动行数值
    Call SystemParametersInfo(SPI_GETWHEELSCROLLLINES, 0, WHEEL_SCROLL_LINES, 0)
End Sub'*************************************************************************
'**函 数 名：UnHook
'**输    入：ByVal hWnd(Long) - 窗口句柄
'**输    出：无
'**功能描述：卸载鼠标钩子
'*************************************************************************
Public Sub UnHook(ByVal hWnd As Long)
    Dim lngReturnValue As Long
    lngReturnValue = SetWindowLong(hWnd, GWL_WNDPROC, lpPrevWndProc)
End Sub'*************************************************************************
'**函 数 名：WindowProc
'**输    入：ByVal hw(Long)     - 窗口句柄
'**        ：ByVal uMsg(Long)   - 消息类型
'**        ：ByVal wParam(Long) -
'**        ：ByVal lParam(Long) -
'*************************************************************************
Private Function WindowProc(ByVal hw As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Dim pt As POINTL
    Select Case uMsg
        Case WM_MOUSEWHEEL   '滚动
            Dim wzDelta, wKeys As Integer
            
            'wzDelta传递滚轮滚动的快慢，该值小于零表示滚轮向后滚动（朝用户方向），
            '大于零表示滚轮向前滚动（朝显示器方向）
            wzDelta = HIWORD(wParam)
            
            'wKeys指出是否有CTRL=8、SHIFT=4、鼠标键(左=2、中=16、右=2、附加)按下，允许复合
            wKeys = LOWORD(wParam)
            
            'pt鼠标的坐标
            pt.X = LOWORD(lParam)
            pt.Y = HIWORD(lParam)
            
            '--------------------------------------------------
             If wzDelta < 0 Then  '朝用户方向
                bWay = True
                '在这里你自己处理－－－－－－－－－－－－－－－－－－
             Else                 '朝显示器方向
                bWay = False
             End If
            '--------------------------------------------------
            '将屏幕坐标转换为Form1.窗口坐标
             ScreenToClient hw, pt
             sngX = pt.X
             sngY = pt.Y
             intShift = wKeys
             
             bMouseFlag = True  '置滚动标志
        Case Else
            WindowProc = CallWindowProc(lpPrevWndProc, hw, uMsg, wParam, lParam)
    End Select
End Function'*************************************************************************
'**函 数 名：HIWORD
'**输    入：LongIn(Long) - 32位值
'**输    出：(Integer) - 32位值的低16位
'**功能描述：取出32位值的高16位
'*************************************************************************
Public Function HIWORD(LongIn As Long) As Integer
   ' 取出32位值的高16位
     HIWORD = (LongIn And &HFFFF0000) \ &H10000
End Function'*************************************************************************
'**函 数 名：LOWORD
'**输    入：LongIn(Long) - 32位值
'**输    出：(Integer) - 32位值的低16位
'**功能描述：取出32位值的低16位
'*************************************************************************
Public Function LOWORD(LongIn As Long) As Integer
   ' 取出32位值的低16位
     LOWORD = LongIn And &HFFFF&
End Function

Answer 2

配合这个API使用
【声明】
Public Declare Function BitBlt Lib "gdi32" Alias "BitBlt" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
【说明】
将一幅位图从一个设备场景复制到另一个。源和目标DC相互间必须兼容
【返回值】
Long，非零表示成功，零表示失败。会设置GetLastError
【参数表】
  hDestDC --------  Long，目标设备场景  x,y ------------  Long，对目标DC中目标矩形左上角位置进行描述的那个点。用目标DC的逻辑坐标表示  nWidth,nHeight -  Long，欲传输图象的宽度和高度  hSrcDC ---------  Long，源设备场景。如光栅运算未指定源，则应设为0  xSrc,ySrc ------  Long，对源DC中源矩形左上角位置进行描述的那个点。用源DC的逻辑坐标表示  dwRop ----------  Long，传输过程要执行的光栅运算
【其它】
在NT环境下，如在一次世界传输中要求在源设备场景中进行剪切或旋转处理，这个函数的执行会失败
  如目标和源DC的映射关系要求矩形中像素的大小必须在传输过程中改变，那么这个函数会根据需要自动伸缩、旋转、折叠、或切断，以便完成最终的传输过程

Answer 3

Private Sub Form_Load()
VScroll1.LargeChange = 50
VScroll1.Min = -1000
VScroll1.Max = 1000End Sub
Private Sub vScroll1_Change()Label1.Caption = Str$(VScroll1.Value)
Shape1.Move Shape1.Left + VScroll1.Value
End Sub