標題：讓VB應用程序支持鼠標滾輪

1樓

wangxinxin 發表于：2010-12-14 12:06:06

徐峰（安徽省貿易學校）

---- 一、提出問題

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

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

---- 二、解決問題

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

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

---- 實現應用程序支持鼠標滾輪的關鍵是，捕獲鼠標滾輪的消息 MSH_MOUSEWHEEL、WM_MOUSEWHEEL。其中MSH_MOUSEWHEEL是為95準備的，需要Intellimouse驅動程序，而WM_MOUSEWHEEL是目前各版本Windows（98/NT40/2000）內置的消息。本文主要處理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、鼠標鍵(左、中、右、附加)按下，允許復合。zDelta傳遞滾輪滾動的快慢，該值小于零表示滾輪向后滾動（朝用戶方向），大于零表示滾輪向前滾動（朝顯示器方向）。lParam指出鼠標指針相對屏幕左上的x、y軸坐標。
---- 滾輪按鈕相當于普通的三鍵鼠標的中鍵，根據滾輪按鈕的動作，Windows分別發出WM_MBUTTONUP、WM_MBUTTONDOWN、WM_MBUTTONDBLCLK消息，這些消息VB已經在鼠標事件中支持。

---- 三、實際應用

---- 根據上述原理，給出一個數據庫應用的典型例子。

---- 1.用戶界面班級和學生一對多的查詢，當用戶在學生網格以外滾動鼠標滾輪，班級主表前后移動；用戶在網格以內滾動鼠標學生明細表垂直移動；如果在網格以內按住鼠標滾輪鍵并且滾動鼠標，學生明細表水平移動。

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

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

---- 4.窗口下部的網格是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.標準模塊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)
'獲取"控制面板"中的滾動行數值
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)
'將屏幕坐標轉換為Form1.窗口坐標
ScreenToClient Form1.hWnd, pt
With Form1.grdDataGrid

'判斷坐標是否在Form1.grdDataGrid窗口內
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
'滾動明細數據庫
If wKeys = 16 Then
'滾動鍵按下，水平滾動grdDataGrid
If Sgn(wzDelta) = 1 Then
Form1.grdDataGrid.Scroll -1, 0
Else
Form1.grdDataGrid.Scroll 1, 0
End If
Else
'垂直滾動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
'鼠標不在grdDataGrid區域，滾動主數據庫
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.該例在未安裝任何附加鼠標驅動程序的Win2000/98環境，采用聯想網絡鼠標/羅技銀貂，VB6.0下均通過。
---- 需要進一步說明的是,對用戶界面鼠標滾輪的操作也要遵循公共用戶界面操作習慣，不要隨意定義一些怪異的操作，如果你編制的應用程序支持鼠標滾輪，請看看是否符合下面這些標準。

---- 垂直滾動：當用戶向后滾動輪子（朝用戶方向），滾動條向下移動；向前滾動輪子（朝顯示器方向），滾動條向上移動。對文檔當前的選擇應該不受影響，對數據庫當前記錄指針不變。

---- 水平滾動：如果同時有垂直滾動條，鼠標滾輪首先應控制上下滾動；當文檔只有水平滾動杠時，用戶向后滾動輪子，滾動條向右移動，向前滾動輪子，滾動條向左移動。對文檔當前的選擇應該不受影響，對數據庫字段選擇不受影響。

---- 滾動速度：鼠標滾輪每滾一個刻痕，對于長文檔移動的行數，應符合控制面板中鼠標的定義（默認移動三行），對短文檔每次滾一行，在任何情況下，決不要超過窗口顯示的行數。

---- 平移：平移事實上就是滾動條的連續操作。平移一般是配合滾輪按鈕的拖拽，最好提供方向指示光標。

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

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

---- 四、結束語

---- 通過前面的介紹，你會發現編制"直接"支持鼠標滾輪軟件，需要增加不少工作量。但對軟件的易用性有顯著的提高，筆者認為這一點付出是值得的。當然你也可以通過使用專門的鼠標功能增強軟件來實現部分鼠標滾輪功能。最后需要注意的是，并不是每個用戶都有滾輪鼠標，軟件的鼠標滾輪上功能，要讓用戶通過其他的操作也可以實現。

共1 條記錄, 每頁顯示 10 條, 頁簽: [1]

[Full] 完整版
[Rss] 訂閱
[Xml] 無圖版
[Xhtml] 無圖版