VB程式中使用滑鼠滾倫

 說明

由於VB自訂的事件中,並沒有這項訊息,於是只好自己攔截WM_MOUSEWHEEL這個訊息了

程式

'以下在.Bas
Option Explicit

'用以告訴系統當這個視窗的msg事件發生時 執行lpPrevWndFunc
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
'lpPrevWndFunc執行函數的位址
'hwnd 就是視窗的hwnd屬性
'Msg就是訊息 例如按下滑鼠右鍵 最大化....
'wParam,lParam會因Msg不同而有不同的用途

'用以設定視窗的程序
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" ( _
ByVal hwnd As Long, _
ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long
'hwnd 就是所要設定視窗的hwnd屬性
'nIndex 是要設定的程序
'dwNewLong  所指定的程序(nIndex)所要執行的動作

Public Const GWL_WNDPROC = (-4)
Public Const WM_MOUSEWHEEL = &H20A
Public PrevWndProc As Long

Function WndProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim t(0 To 1) As Integer
If uMsg = WM_MOUSEWHEEL Then '如果是滾輪
    If wParam < 0 Then 'backward
        Form1.Top = Form1.Top + 10
    Else 'forforward
        Form1.Top = Form1.Top - 10
    End If
Else
    WndProc = CallWindowProc(PrevWndProc, hwnd, uMsg, wParam, lParam)
    '其他訊息用原來的回呼函數處理
End If
End Function

'以下在Form1中
Option Explicit
Private Sub Form_Load()
PrevWndProc = SetWindowLong(Me.hwnd, GWL_WNDPROC, AddressOf WndProc)
'設定新的回呼函式 以攔截訊息
'note: 傳回值PrevWndProc是原來視窗的回呼函數
'WndProc函數放在模組 因為AddressOf只能取得模組下函數的位址
End Sub

Private Sub Form_Unload(Cancel As Integer)
Dim lResult As Long
lResult = SetWindowLong(Me.hwnd, GWL_WNDPROC, PrevWndProc)
'結束時歸還原來的回呼函數 不然會當機
End Sub

相關資訊

  WM_MOUSEWHEEL

  SetWindowLong

  CallWindowProc

文件出處

  Honey