又是一个鼠标滚轮拉动的问题!!!愁愁愁!!!
我自己做了一个控件,然后把它放到了窗体中的PictureBox控件当中。一切运行正常且良好,但是运行起来这个控件在窗体中比较多,为了用户能够浏览到下面的部分,我没有办法只能在PictureBox控件旁边加上了一个VScrollBar控件,然后写代码:
Picture1.Top = -VScroll1.Value
就想当拉动这个VScrollBar控件的时候,PictureBox控件能够移动显示出下面的需要浏览的控件
请问高手,怎么样才能使鼠标滚轮让这个VScrollBar控件向下拉动实现我的功能???
拜求拜求!!!!!!
[解决办法]
Private Sub Form_Load()
lngPreProc = SetWindowLong(Picture1.hwnd, GWL_WNDPROC, AddressOf WindowProc)
End Sub
Private Sub Form_Unload(Cancel As Integer)
SetWindowLong Picture1.hwnd, GWL_WNDPROC, lngPreProc
End Sub
=======================================================================
模块内容:
Public Declare Function SetWindowLong Lib "user32 " Alias "SetWindowLongA " (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
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 Const GWL_WNDPROC = (-4)
Public lngPreProc As Long
Public Function WindowProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
On Error Resume Next
If uMsg <> 522 Then
WindowProc = CallWindowProc(lngPreProc, hwnd, uMsg, wParam, lParam)
Else '滚轮
On Error Resume Next
With Form1.VScroll1
If wParam > 0 Then
.Value = .Value - .SmallChange
Else
.Value = .Value + .SmallChange
End If
End With
End If
End Function
[解决办法]
此方法与yachong(蚜虫)的类似
'模组中
Option Explicit
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 As Long = (-4)
Private Const WM_MOUSEWHEEL As Long = &H20A
Private m_OldWindowProc As Long
Public Sub HookWheel()
m_OldWindowProc = SetWindowLong(Form1.hWnd, GWL_WNDPROC, AddressOf pvWindowProc)
End Sub
Private Function pvWindowProc(ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Select Case wMsg
Case WM_MOUSEWHEEL
Select Case wParam
Case Is > 0
SendKeys "{Up} "
Case Else
SendKeys "{Down} "
End Select
End Select
pvWindowProc = CallWindowProc(m_OldWindowProc, hWnd, wMsg, wParam, lParam)
End Function
'窗体中
Option Explicit
Private Sub Form_Load()
Call HookWheel
End Sub
Private Sub Pic2_Click()
VScroll1.SetFocus
End Sub