#E6E6E6 【VB】攔截捲軸的滑鼠動作,兼談 SubClass 作者:吳文成

  Visual Basic 提供了兩個常用的捲軸物件 HScrollBar 與 VScrollBar 控制項(另外還有進階的 Slider 控制項)。 捲軸物件可以用類比方式來顯示目前的位置,可以作為輸入裝置來指定進度或數量,例如可以用它來控制電[[img src=computer/HScrollBar.gif height=59 width=151 align=left]]腦遊戲的音量,或者像我在近期開發的影音播放程式 ExtraPlayer 裡,用來顯示與指定影音檔案的播放進度 。但是可惜的是,HScrollBar、VScrollBar 並沒有提供各種滑鼠事件(滑鼠移動、滑鼠鍵按下……等等),如果不想(新增 MSCOMCTL.OCX 這龐然大物 )引用 Slider 控制項,又希望能夠讓捲軸物件偵測滑鼠動作,那麼只好使用 Windows API 來截取與處理低階的窗口訊息事件(對於核心程式開發者而言,這是最重要的進階課程)!

  ( 嗯, Application Programming Interface 是大家的,凡是在 Windows 工作環境底下執行的應用程式,都有權利呼叫 Windows API )微軟視窗是以 Message-Driven 為運作核心,我們將深入到視窗程序的內部,我們會使用到關鍵的函數,SetWindowLong 來為指定的窗口設置訊息攔截的勾子,函數 CallWindowProc 來將攔截的系統訊息( , 在個別處理之後 )交還給接續的窗口程序,以備下一次的訊息攔截。由於我們要攔截訊息的目標物件是表單裡的特定物件 , 所以我們還需要函數 GetWindowLong 來取得目標物件在表單裡 Window Procedure 的原本位址。

  這些函數的運用可以讓我們針對個別物件作訊息控制,使它的行為與原來的有所不同,這就是 SubClassing 的技巧 。 原本我們需要把 CallBack Function( 即範例裡的 SubWndProc 程序 ) 之訊息個別處理的程式碼,寫在一般模組中,但是在這裡我們將使用表單的 Friend Function( 即範例裡的 SubClassProc 程序),來將目標物件的訊息處理工作轉移到表單的友程序,這個技巧非常重要,因為這可以讓我們在表單「之內」的程序裡,方便地與自洽地引用表單上的各種物件屬性與方法,而不會容易造成該視窗程式的「崩潰」,當然如果你不小心而程式碼有誤,還是會輕易當機的。

  在我近期開發的影音播放程式 ExtraPlayer 的播放進度列,就是使用到 HScrollBar 控制項 。我需要這樣的功能,可以讓使用者在播放進度列上,滑鼠左鍵按下之時,像 Windows Media Player 隨即播放到指定的時刻( 而不是像 Media Player Classic 只能以 LargeChange 改變播放進度 ), 所以我需要偵測 HScrollBar 的滑鼠左鍵按下事件,以及滑鼠的所在座標來換算成相對的播放進度值 。 在我提供的範例程式裡 , 演示了如何運用 Windows API 與 SubClass 來攔截目標物件的滑鼠動作,與捲軸物件「即按即到」的功能。倘若你想針對其他物件來截取與處理低階的窗口訊息事件,你可以使用同樣的方法來達到你要的需求;除了滑鼠事件,窗口訊息事件還包括鍵盤事件,你可能需要查詢這些事件的常數,例如 WH_KEYBOARD。

  只有透過編程測試,才能夠真正體會上面所說的是怎麼一回事。開啟Visual Basic,(只能在)在一般模組裡,加入以下的程式碼:

Option Explicit

' 窗口終止事件
Public Const WM_DESTROY = &H2
' 各種滑鼠事件
Public Const WM_MOUSEMOVE = &H200
Public Const WM_LBUTTONDOWN = &H201
Public Const WM_LBUTTONUP = &H202
Public Const WM_LBUTTONDBLCLK = &H203
Public Const WM_RBUTTONDOWN = &H204
Public Const WM_RBUTTONUP = &H205
Public Const WM_RBUTTONDBLCLK = &H206
Public Const WM_MBUTTONDOWN = &H207
Public Const WM_MBUTTONUP = &H208
Public Const WM_MBUTTONDBLCLK = &H209

Private Const GWL_WNDPROC = (-4)
' 從指定窗口的結構中取得訊息
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
' 在窗口結構中為指定的窗口設置訊息
Private 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 oldClassProc As Long

' 註冊目標物件的訊息偵測
Public Sub setSubClass(objCtr As Object)
 If oldClassProc = 0 Then
  oldClassProc = GetWindowLong(objCtr.hWnd, GWL_WNDPROC)
  SetWindowLong objCtr.hWnd, GWL_WNDPROC, AddressOf SubWndProc
 End If
End Sub

' 取消目標物件的訊息偵測
Public Sub freeSubClass(objCtr As Object)
 If oldClassProc <> 0 Then
  SetWindowLong objCtr.hWnd, GWL_WNDPROC, oldClassProc
  oldClassProc = 0
 End If
End Sub

' 將目標物件的訊息處理,轉移到目標表單的 Friend 程序
Private Function SubWndProc(ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
 SubWndProc = Form1.SubClassProc(hWnd, Msg, wParam, lParam)
 '      ^^^^^ 目標物件所在表單的名稱
End Function


  在表單裡放置 HScrollBar 控制項,並且加入以下的程式碼:

Option Explicit

Private Sub Form_Load()
 Me.ScaleMode = vbPixels

 ' 註冊目標物件的訊息偵測
 setSubClass HScroll1
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
 ' 滑鼠離開目標物件時,恢復視窗標題
 Me.Caption = "Form1"
End Sub

Private Sub Form_Unload(Cancel As Integer)
 ' 取消目標物件的訊息偵測
 freeSubClass HScroll1
End Sub

Friend Function SubClassProc(ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
 ' 當發生滑鼠事件,處理以下的訊息
 If Msg >= WM_MOUSEMOVE And Msg <= WM_MBUTTONDBLCLK Then
  Dim Xpos As Long, Ypos As Long
  ' 取得滑鼠在目標物件的座標位置
  Xpos = lParam And 65535
  Ypos = lParam / 65536
  ' 處理目標物件的滑鼠事件
  ' 您可以再列舉與處理其他的滑鼠事件
  Select Case Msg
  Case WM_MOUSEMOVE
   ' 處理滑鼠移動
   Me.Caption = "滑鼠在 HScrollBox 的物件座標:" & Xpos & "," & Ypos
  Case WM_LBUTTONDOWN
   ' 處理滑鼠左鍵按下
   Debug.Print "滑鼠在 HScrollBox 物件左鍵按下"
   Dim marginHsb As Long
   ' 實現捲軸物件「即按即到」的功能
   ' HScrollBox 物件之箭號部分的寬度
   marginHsb = 16
   HScroll1.Value = (Xpos - marginHsb) * (HScroll1.Max - HScroll1.Min) / (HScroll1.Width - 2 * marginHsb)
  Case WM_RBUTTONDOWN
   ' 處理滑鼠右鍵按下
   Debug.Print "滑鼠在 HScrollBox 物件右鍵按下"
  End Select
 ' 當物件終止時,取消訊息截取
 ElseIf Msg = WM_DESTROY Then
  freeSubClass HScroll1
  Exit Function
 End If
 ' 將訊息送回原來的窗口程序
 SubClassProc = CallWindowProc(oldClassProc, hWnd, Msg, wParam, lParam)
End Function

範例源碼下載
2004/10/27