什么方法可以让picturbox响应鼠标滚轮

Question

现在我想做得就很像windows里面看图片那样的，鼠标滚轮zoom in, zoom out没有什么概念，请各位指点

Answer 1

同意，子类化PICTUREBOX窗体，在接收到WM_MOUSEWHEEL之类的消息后进行STRETCHBITBLT。

Answer 2

以下给出简单示例，希望对你有帮助
modSubClass.bas
Option Explicit'// BitBlt API dwRop parameter constants
Private Const SRCAND = &H8800C6          ' (DWORD) dest = source AND dest
Private Const SRCCOPY = &HCC0020         ' (DWORD) dest = source
Private Const SRCERASE = &H440328        ' (DWORD) dest = source AND (NOT dest )
Private Const SRCINVERT = &H660046       ' (DWORD) dest = source XOR dest
Private Const SRCPAINT = &HEE0086        ' (DWORD) dest = source OR dest
Private Const SRCMERGEPAINT = &HBB0226
Private Const SRCDSNA = &H220326
'// SetStretchBltMode API nStretchMode parameter constants
Private Const STRETCH_ANDSCANS = 1
Private Const STRETCH_ORSCANS = 2
Private Const STRETCH_DELETESCANS = 3
Private Const STRETCH_HALFTONE = 4Private Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hDC As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hDC As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hDC As Long) As LongPrivate Declare Function GetStretchBltMode Lib "gdi32" (ByVal hDC As Long) As Long
Private Declare Function SetStretchBltMode Lib "gdi32" (ByVal hDC As Long, ByVal nStretchMode As Long) As Long
Private Declare Function StretchBlt Lib "gdi32" (ByVal hDC 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 nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As LongPrivate Declare Function SelectObject Lib "gdi32" (ByVal hDC As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As LongPrivate 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 = &H20APrivate m_lpPreWndFunc As Long            '// 默认窗口处理函数地址Public Sub SubClasss(ByVal hWnd As Long)    m_lpPreWndFunc = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf WindProc)
    
End SubPublic Sub UnSubClasss(ByVal hWnd As Long)    SetWindowLong hWnd, GWL_WNDPROC, m_lpPreWndFunc
    
End SubPublic Function WindProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long    Select Case uMsg
        Case WM_MOUSEWHEEL
             ' 缩小图片
             If wParam > 0 Then
                frmTest.picImage.Width = frmTest.picImage.Width - 100
                frmTest.picImage.Height = frmTest.picImage.Height - 100
             ' 放大图片
             Else
                frmTest.picImage.Width = frmTest.picImage.Width + 100
                frmTest.picImage.Height = frmTest.picImage.Height + 100
             End If
             StretchPic frmTest.picImage
        Case Else
             WindProc = CallWindowProc(m_lpPreWndFunc, hWnd, uMsg, wParam, lParam)
    End Select
    
End Function'//
'// 放大缩小图片
'//
Public Sub StretchPic(dstPic As PictureBox)
 
    Dim lngOldDIB As Long
    Dim lngOldMode As Long
    Dim lnghDC As Long
    Dim lngMHDC As Long
    Dim lngSrcX As Long
    Dim lngSrcY As Long
     
    dstPic.AutoRedraw = True
    dstPic.ScaleMode = vbPixels
    
    lnghDC = GetDC(dstPic.hWnd)
    lngMHDC = CreateCompatibleDC(lnghDC)
    ReleaseDC dstPic.hWnd, lnghDC
       
    lngSrcX = dstPic.ScaleX(dstPic.Picture.Width, vbHimetric, vbPixels)
    lngSrcY = dstPic.ScaleY(dstPic.Picture.Height, vbHimetric, vbPixels)
    lngOldDIB = SelectObject(lngMHDC, dstPic.Picture.Handle)
    lngOldMode = SetStretchBltMode(dstPic.hDC, STRETCH_DELETESCANS)
    StretchBlt dstPic.hDC, 0, 0, dstPic.ScaleWidth, dstPic.ScaleHeight, _
               lngMHDC, 0, 0, lngSrcX, lngSrcY, vbSrcCopy
    SetStretchBltMode dstPic.hDC, lngOldMode
    dstPic.Refresh
    
    SelectObject lngMHDC, lngOldDIB
    DeleteObject lngOldDIB
    DeleteDC lngMHDC
    
End SubfrmTest.frm
Option ExplicitPrivate Sub Form_Load()
    
    Me.picImage.AutoRedraw = True
    Me.picImage.ScaleMode = vbPixels
    
    SubClasss Me.picImage.hWnd
    
End SubPrivate Sub Form_Unload(Cancel As Integer)
    
    UnSubClasss Me.picImage.hWnd
    
End Sub