徐峰（安徽省貿(mào)易學(xué)校 ）

---- 一、提出問題

---- 自從1996年微軟推出Intellimouse鼠標(biāo)后，帶滾輪的鼠標(biāo)開始大行其道，支持鼠標(biāo)滾輪的應(yīng)用軟件也越來越多。但我感到奇怪，為什么VB到6.0本身仍然不支持鼠標(biāo)滾輪，VF可是從5.0就提供MouseWheel事件了。

---- 如何讓VB應(yīng)用程序支持鼠標(biāo)滾輪？MSDN上有一篇解決VB下應(yīng)用Intellimouse鼠標(biāo)的文章，它解決這一問題的方法是通過一個(gè)幾十K的第三方控件實(shí)現(xiàn)的，可惜該控件沒有源代碼。況且為了支持鼠標(biāo)滾輪使用一個(gè)第三方控件，好像有點(diǎn)得不償失。本文給出用純VB實(shí)現(xiàn)這一功能的方法。

---- 二、解決問題

---- 我們知道VB應(yīng)用程序響應(yīng)的Windows傳來的消息，需要通過VB解釋。可是很不幸，雖然VB解釋所有得消息，卻只讓用戶程序在事件中處理部分消息，VB自己處理其他的消息，或者忽略這些消息。

---- 在VB5.0以前應(yīng)用程序無法越過VB直接處理消息，微軟從VB5.0開始提供AddressOf 運(yùn)算符，該運(yùn)算符可以讓用戶程序?qū)⒑瘮?shù)或者過程的地址傳遞給一個(gè)API函數(shù)。這樣我們就可以在VB應(yīng)用程序中編寫自己的窗口處理函數(shù)，通過AddressOf 運(yùn)算符將在VB中定義的窗口地址傳遞給窗口處理函數(shù)，從而繞過VB的解釋器，自己處理消息。事實(shí)上，該方法可用于在VB中處理任何消息。

---- 實(shí)現(xiàn)應(yīng)用程序支持鼠標(biāo)滾輪的關(guān)鍵是，捕獲鼠標(biāo)滾輪的消息 MSH_MOUSEWHEEL、WM_MOUSEWHEEL。其中MSH_MOUSEWHEEL是為95準(zhǔn)備的，需要Intellimouse驅(qū)動(dòng)程序，而WM_MOUSEWHEEL是目前各版本W(wǎng)indows（98/NT40/2000）內(nèi)置的消息。本文主要處理WM_MOUSEWHEEL消息。下面是WM_MOUSEWHEEL的語法。

  WM_MOUSEWHEEL
    fwKeys = LOWORD(wParam); /* key flags */
    zDelta = (short) HIWORD(wParam);
    /* wheel rotation */
    xPos = (short) LOWORD(lParam);
    /* horizontal position of pointer */
    yPos = (short) HIWORD(lParam);
    /* vertical position of pointer */
 
---- 其中：fwKeys指出是否有CTRL、SHIFT、鼠標(biāo)鍵(左、中、右、附加)按下，允許復(fù)合。zDelta傳遞滾輪滾動(dòng)的快慢，該值小于零表示滾輪向后滾動(dòng)（朝用戶方向），大于零表示滾輪向前滾動(dòng)（朝顯示器方向）。lParam指出鼠標(biāo)指針相對(duì)屏幕左上的x、y軸坐標(biāo)。
---- 滾輪按鈕相當(dāng)于普通的三鍵鼠標(biāo)的中鍵，根據(jù)滾輪按鈕的動(dòng)作，Windows分別發(fā)出WM_MBUTTONUP、WM_MBUTTONDOWN、WM_MBUTTONDBLCLK消息，這些消息VB已經(jīng)在鼠標(biāo)事件中支持。

---- 三、實(shí)際應(yīng)用

---- 根據(jù)上述原理，給出一個(gè)數(shù)據(jù)庫(kù)應(yīng)用的典型例子。

---- 1.用戶界面班級(jí)和學(xué)生一對(duì)多的查詢，當(dāng)用戶在學(xué)生網(wǎng)格以外滾動(dòng)鼠標(biāo)滾輪，班級(jí)主表前后移動(dòng)；用戶在網(wǎng)格以內(nèi)滾動(dòng)鼠標(biāo)學(xué)生明細(xì)表垂直移動(dòng)；如果在網(wǎng)格以內(nèi)按住鼠標(biāo)滾輪鍵并且滾動(dòng)鼠標(biāo)，學(xué)生明細(xì)表水平移動(dòng)。

---- 2.Form1上ADO Data 控件對(duì)象datPrimaryRS的 ConnectionString為"PROVIDER=MSDataShape;Data PROVIDER=MSDASQL;dsn=SCHOOL;uid=;pwd=;"， RecordSelectors 屬性的SQL命令文本為"SHAPE {select * from 班級(jí)} AS ParentCMD APPEND ({select * from 學(xué)生 } AS ChildCMD RELATE 班級(jí)名稱 TO 班級(jí)名稱) AS ChildCMD"。

---- 3.TextBox的DataSource均為datPrimaryRS,DataFiled如圖所示。

---- 4.窗口下部的網(wǎng)格是DataGrid控件,名稱為grdDataGrid。

---- 5.表單From1.frm的清單如下：

Private Sub Form_Load()
Set grdDataGrid.DataSource = _
datPrimaryRS.Recordset("ChildCMD").UnderlyingValue
Hook Me.hWnd
End Sub

Private Sub Form_Unload(Cancel As Integer)
    UnHook Me.hWnd
End Sub

---- 6.標(biāo)準(zhǔn)模塊Module1.bas清單如下：
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 Long

Public Const GWL_WNDPROC = -4
Public Const SPI_GETWHEELSCROLLLINES = 104
Public Const WM_MOUSEWHEEL = &H20A
Public WHEEL_SCROLL_LINES As Long
     
Global lpPrevWndProc As Long

Public Sub Hook(ByVal hWnd As Long)
lpPrevWndProc = SetWindowLong(hWnd, GWL_WNDPROC, _
    AddressOf WindowProc)
    '獲取"控制面板"中的滾動(dòng)行數(shù)值
Call SystemParametersInfo(SPI_GETWHEELSCROLLLINES, _
  0, WHEEL_SCROLL_LINES, 0)
    If WHEEL_SCROLL_LINES > Form1.grdDataGrid.VisibleRows Then
WHEEL_SCROLL_LINES = Form1.grdDataGrid.VisibleRows
    End If
End Sub

Public Sub UnHook(ByVal hWnd As Long)
Dim lngReturnValue As Long
lngReturnValue = SetWindowLong(hWnd,
GWL_WNDPROC, lpPrevWndProc)
End Sub

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 = HIWORD(wParam)
            wKeys = LOWORD(wParam)
            pt.x = LOWORD(lParam)
            pt.y = HIWORD(lParam)
            '將屏幕坐標(biāo)轉(zhuǎn)換為Form1.窗口坐標(biāo)
            ScreenToClient Form1.hWnd, pt
            With Form1.grdDataGrid

'判斷坐標(biāo)是否在Form1.grdDataGrid窗口內(nèi)
If pt.x > .Left / Screen.TwipsPerPixelX And _
pt.x < (.Left + .Width) / Screen.TwipsPerPixelX And _
pt.y > .Top / Screen.TwipsPerPixelY And _
pt.y < (.Top + .Height) / Screen.TwipsPerPixelY Then
'滾動(dòng)明細(xì)數(shù)據(jù)庫(kù)
If wKeys = 16 Then
'滾動(dòng)鍵按下，水平滾動(dòng)grdDataGrid
If Sgn(wzDelta) = 1 Then
    Form1.grdDataGrid.Scroll -1, 0
Else
                    Form1.grdDataGrid.Scroll 1, 0
                        End If
                    Else
              '垂直滾動(dòng)grdDataGrid
                        If Sgn(wzDelta) = 1 Then
Form1.grdDataGrid.Scroll 0, 0 - WHEEL_SCROLL_LINES
                        Else
Form1.grdDataGrid.Scroll 0, WHEEL_SCROLL_LINES
                        End If
                    End If
                Else
    '鼠標(biāo)不在grdDataGrid區(qū)域，滾動(dòng)主數(shù)據(jù)庫(kù)
                    With Form1.datPrimaryRS.Recordset
                        If Sgn(wzDelta) = 1 Then
                            If .BOF = False Then
                                .MovePrevious
                                If .BOF = True Then
                                    .MoveFirst
                                End If
                            End If
                        Else
                            If .EOF = False Then
                                .MoveNext
                                If .EOF = True Then
                                    .MoveLast
                                End If
                            End If
                        End If
                    End With
                End If
            End With
        Case Else
WindowProc = CallWindowProc(lpPrevWndProc, hw, _
          uMsg, wParam, lParam)
    End Select
End Function

Public Function HIWORD(LongIn As Long) As Integer
  ' 取出32位值的高16位
  HIWORD = (LongIn And &HFFFF0000) \ &H10000
End Function

Public Function LOWORD(LongIn As Long) As Integer
    ' 取出32位值的低16位
      LOWORD = LongIn And &HFFFF&
End Function

---- 7.該例在未安裝任何附加鼠標(biāo)驅(qū)動(dòng)程序的Win2000/98環(huán)境，采用聯(lián)想網(wǎng)絡(luò)鼠標(biāo)/羅技銀貂，VB6.0下均通過。
---- 需要進(jìn)一步說明的是,對(duì)用戶界面鼠標(biāo)滾輪的操作也要遵循公共用戶界面操作習(xí)慣，不要隨意定義一些怪異的操作，如果你編制的應(yīng)用程序支持鼠標(biāo)滾輪，請(qǐng)看看是否符合下面這些標(biāo)準(zhǔn)。

---- 垂直滾動(dòng)：當(dāng)用戶向后滾動(dòng)輪子（朝用戶方向），滾動(dòng)條向下移動(dòng)；向前滾動(dòng)輪子（朝顯示器方向），滾動(dòng)條向上移動(dòng)。對(duì)文檔當(dāng)前的選擇應(yīng)該不受影響，對(duì)數(shù)據(jù)庫(kù)當(dāng)前記錄指針不變。

---- 水平滾動(dòng)：如果同時(shí)有垂直滾動(dòng)條，鼠標(biāo)滾輪首先應(yīng)控制上下滾動(dòng)；當(dāng)文檔只有水平滾動(dòng)杠時(shí)，用戶向后滾動(dòng)輪子，滾動(dòng)條向右移動(dòng)，向前滾動(dòng)輪子，滾動(dòng)條向左移動(dòng)。對(duì)文檔當(dāng)前的選擇應(yīng)該不受影響，對(duì)數(shù)據(jù)庫(kù)字段選擇不受影響。

---- 滾動(dòng)速度：鼠標(biāo)滾輪每滾一個(gè)刻痕，對(duì)于長(zhǎng)文檔移動(dòng)的行數(shù)，應(yīng)符合控制面板中鼠標(biāo)的定義（默認(rèn)移動(dòng)三行），對(duì)短文檔每次滾一行，在任何情況下，決不要超過窗口顯示的行數(shù)。

---- 平移：平移事實(shí)上就是滾動(dòng)條的連續(xù)操作。平移一般是配合滾輪按鈕的拖拽，最好提供方向指示光標(biāo)。

---- 自動(dòng)滾動(dòng)：自動(dòng)滾動(dòng)通常開始于鼠標(biāo)滾輪按鈕單擊，以后任何擊鍵、鼠標(biāo)按鍵或者滾動(dòng)鼠標(biāo)滾輪終止。滾動(dòng)方向和速度取決于鼠標(biāo)偏移滾輪按鈕單擊時(shí)原始位置的方向和距離，距原始位置標(biāo)記越遠(yuǎn)自動(dòng)滾動(dòng)越快，距離近則慢。應(yīng)用程序需要提供初始位置位圖以及方向指示圖標(biāo)。

---- 縮放：在按住 Ctrl 鍵的同時(shí)前后滾動(dòng)滾輪。向后滾動(dòng)輪子（朝用戶方向），縮小比例；向前滾動(dòng)輪子（朝顯示器方向），增大比例。

---- 四、結(jié)束語

---- 通過前面的介紹，你會(huì)發(fā)現(xiàn)編制"直接"支持鼠標(biāo)滾輪軟件，需要增加不少工作量。但對(duì)軟件的易用性有顯著的提高，筆者認(rèn)為這一點(diǎn)付出是值得的。當(dāng)然你也可以通過使用專門的鼠標(biāo)功能增強(qiáng)軟件來實(shí)現(xiàn)部分鼠標(biāo)滾輪功能。最后需要注意的是，并不是每個(gè)用戶都有滾輪鼠標(biāo)，軟件的鼠標(biāo)滾輪上功能，要讓用戶通過其他的操作也可以實(shí)現(xiàn)。