滑鼠滾輪編程

1. 求VB滑鼠滾輪的常量

很不幸，VB6誕生的時候，滑鼠還沒有滾輪呢，所以沒有專門的代表滾輪的常量。這也解釋了為什麼VB6不支持滑鼠滾輪的原因（包括編程環境、設計中的程序和編譯後的可執行文件，都是不支持滑鼠滾輪的），必須使用特殊手段才能有限實現滾輪效果。

2. 滑鼠編程是不是可以一次連續釋放技能

（1）是的，稍微中級和高級的游戲滑鼠一般都有編程按鍵。

（2）以羅技滑鼠為例，如下圖，在對應的功能界面錄入多鍵，設置好每個動作間的時間間隔 ，設置好後，在按下那一個編程按鍵後，就會自動執行錄制好的那一系列動作：

3. 羅技滑鼠滾輪編程

需要編寫程序來控制，安裝一個全局滑鼠鉤子，攔截滑鼠滾輪消息，然後在回調函數里執行相應的操作!

4. vb滑鼠滾輪問題

標滾輪能給系統的使用帶來很大便利，如使用滾輪移動選擇這項，但在VB中的一些常用控制項（如：文件框、列表框等）中沒有提供滑鼠滾輪滾動選擇的效果。現將自己寫的滑鼠滾輪特效實現代碼分享給大家： 本例子就是一個對Win32 API的調用，達到對ListBox、PictureBox等的滑鼠滾輪控制。首先，申明windows API調用，將其放在模塊modWheel中，以供用戶控制項使用。原理很簡單，通過滑鼠滾輪可以對如下白色的橫線進行控制，效果圖如下：相關代碼如下： 滑鼠滾輪處理模塊(modWheel)
Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
(pDest As Any, pSource As Any, ByVal ByteLen As Long)
Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" _
(ByVal hWnd As Long, ByVal nIndex 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
Public Const GWL_WNDPROC = (-4)
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 SetProp Lib "user32" Alias "SetPropA" _
(ByVal hWnd As Long, ByVal lpString As String, _
ByVal hData As Long) As Long
Declare Function GetProp Lib "user32" Alias "GetPropA" _
(ByVal hWnd As Long, ByVal lpString As String) As Long
Declare Function RemoveProp Lib "user32" Alias "RemovePropA" _
(ByVal hWnd As Long, ByVal lpString As String) As Long
Declare Function GetParent Lib "user32" (ByVal hWnd As Long) As Long
Public Const WM_MOUSEWHEEL = &H20A
Public Const WM_MOUSELAST = &H20A
Public Const WHEEL_DELTA = 120
Public Function HIWORD(LongIn As Long) As Integer
HIWORD = (LongIn And &HFFFF0000) \ &H10000
End Function
Public Function MWheelProc(ByVal hWnd As Long, _
ByVal wMsg As Long, ByVal wParam As Long, _
ByVal lParam As Long) As Long
Dim OldProc As Long
Dim CtlWnd As Long
Dim CtlPtr As Long
Dim IntObj As Object
Dim MWObject As MWheel
CtlWnd = GetProp(hWnd, "WheelWnd")
CtlPtr = GetProp(CtlWnd, "WheelPtr")
OldProc = GetProp(CtlWnd, "OldWheelProc")
If wMsg = WM_MOUSEWHEEL Then
CopyMemory IntObj, CtlPtr, 4
Set MWObject = IntObj
MWObject.WndProc hWnd, wMsg, wParam, lParam
Set MWObject = Nothing
CopyMemory IntObj, 0&, 4
Exit Function
End If
MWheelProc = CallWindowProc(OldProc, hWnd, wMsg, wParam, lParam)
End Function
Public Sub Subclass(MWCtl As MWheel, ParentWnd As Long)
If GetProp(MWCtl.hWnd, "OldWheelProc") <> 0 Then
Exit Sub
End If
SetProp MWCtl.hWnd, "OldWheelProc", _
GetWindowLong(ParentWnd, GWL_WNDPROC)
SetProp MWCtl.hWnd, "WheelPtr", ObjPtr(MWCtl)
SetProp ParentWnd, "WheelWnd", MWCtl.hWnd
SetWindowLong ParentWnd, GWL_WNDPROC, AddressOf MWheelProc
End Sub
Public Sub UnSubclass(MWCtl As MWheel, ParentWnd As Long)
Dim OldProc As Long
OldProc = GetProp(MWCtl.hWnd, "OldWheelProc")
If OldProc = 0 Then Exit Sub
SetWindowLong ParentWnd, GWL_WNDPROC, OldProc
RemoveProp ParentWnd, "WheelWnd"
RemoveProp MWCtl.hWnd, "WheelPtr"
RemoveProp MWCtl.hWnd, "OldWheelProc"
End Sub
然後，定義用戶控制項MWheel，實現對相關控制項滑鼠滾輪事件的處理。用戶控制項（MWheel)代碼
Option Explicit
Dim m_CapWnd As Long
Dim m_Subclassed As Boolean
Event WheelScroll(Shift As Integer, zDelta As Integer, _
X As Single, Y As Single)
Private Sub UserControl_Resize()
Size 32 * Screen.TwipsPerPixelX, 32 * Screen.TwipsPerPixelY
End Sub
Public Sub DisableWheel()
If m_CapWnd = 0 Then Exit Sub
If m_Subclassed = False Then Exit Sub
UnSubclass Me, m_CapWnd
m_Subclassed = False
End Sub
Public Sub EnableWheel()
If m_CapWnd = 0 Then Exit Sub
m_Subclassed = True
Subclass Me, m_CapWnd
End Sub
Friend Property Get hWnd() As Long
hWnd = UserControl.hWnd
End Property
Public Property Get hWndCapture() As Long
hWndCapture = m_CapWnd
End Property
Public Property Let hWndCapture(ByVal vNewValue As Long)
m_CapWnd = vNewValue
End Property
Friend Sub WndProc(ByVal hWnd As Long, _
ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long)
Dim wShift As Integer
Dim wzDelta As Integer
Dim wX As Single, wY As Single
wzDelta = HIWORD(wParam)
wY = HIWORD(lParam)
RaiseEvent WheelScroll(wShift, wzDelta, wX, wY)
End Sub最後，就可以將定義的用戶控制項用在vb窗體編程中，實現對滑鼠滾輪事件的監聽和處理，測試主窗體如下：Option Explicit
Dim KAs As Long
Dim KA1 As Long
Dim KA2 As Long
Private Sub Picture1_Click()
MWheel1.hWndCapture = Picture1.hWnd
MWheel1.EnableWheel
End Sub
Private Sub List1_Click()
MWheel2.hWndCapture = List1.hWnd
MWheel2.EnableWheel
KA1 = List1.ListCount
End Sub
Private Sub File1_Click()
MWheel3.hWndCapture = File1.hWnd
MWheel3.EnableWheel
KA1 = File1.ListCount
End Sub
Private Sub MWheel2_WheelScroll(Shift As Integer, zDelta As Integer, X As Single, Y As Single)
If KAs > 0 Then
If zDelta = 120 Then
KAs = KAs - 1
List1.ListIndex = KAs
End If
End If
If KAs < KA1 - 1 Then
If zDelta = -120 Then
KAs = KAs + 1
List1.ListIndex = KAs
End If
End If
End Sub
Private Sub MWheel1_WheelScroll(Shift As Integer, zDelta As Integer, X As Single, Y As Single)
If zDelta = 120 Then
KA2 = KA2 - 5
Line1.Y1 = KA2
Line1.Y2 = KA2
End If
If zDelta = -120 Then
KA2 = KA2 + 5
Line1.Y1 = KA2
Line1.Y2 = KA2
End If
End Sub
Private Sub MWheel3_WheelScroll(Shift As Integer, zDelta As Integer, X As Single, Y As Single)

If KAs > 0 Then
If zDelta = 120 Then
KAs = KAs - 1
File1.ListIndex = KAs
End If
End If
If KAs < KA1 - 1 Then
If zDelta = -120 Then
KAs = KAs + 1
File1.ListIndex = KAs
End If
End If
End Sub</SPAN>

5. Delphi滑鼠滾輪如何編程

我們使用的滑鼠，很多都帶有一個滾輪，方便用戶的操作。但遺憾的是，平時編程多數只利用到滑鼠的左、右兩鍵，如果將滾輪操作功能也加進你的程序，定能使其增色不少。 當滑鼠指針指向窗體中時，Delphi為滾輪滾動提供OnMouseWheel事件，我們可以對它進行相應的處理。本例中，在窗體內放置一標簽Label1，用於顯示滾輪滾動的效果。 implementation var i:integer; procere TForm1.FormCreate(Sender: TObject); begin i:=0; Label1.Caption:=inttostr(i); end; procere TForm1.FormMouseWheel(Sender: TObject; Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean); begin if WheelDelta>0 then i:=i+1 else i:=i-1; //wheelDelta參數表示滾動一格的值，向上滾動為正數，向下滾動則為負數 Label1.Caption:=inttostr(i); end;

6. 如何用VB編程，來禁止電腦滑鼠滾輪的使用謝謝！

截取滑鼠滾輪消息及窗體消息
'窗體
Option Explicit

Private Const MOD_ALT As Long = &H1
Private Const MOD_CONTROL As Long = &H2
Private Const MOD_SHIFT As Long = &H4

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.dll" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
'注冊/反注冊熱鍵
Private Declare Function RegisterHotKey Lib "user32.dll" (ByVal hWnd As Long, ByVal ID As Long, ByVal fsModifiers As Long, ByVal vk As Long) As Long
Private Declare Function UnregisterHotKey Lib "user32.dll" (ByVal hWnd As Long, ByVal ID As Long) As Long

Private Sub Form_Load()
Dim ret As Long
Print "關閉本實例一定要按下窗體上的關閉按鈕關閉，否則會出現錯誤！"
'記錄原來的 Window Procere 的位址
preProc = GetWindowLong(Me.hWnd, GWL_WNDPROC)
'設定form的 Window Procere 到 hProc
ret = SetWindowLong(Me.hWnd, GWL_WNDPROC, AddressOf hProc)
'注冊熱鍵，RegisterHotKey 的第三個參數為附加的功能鍵，不用時應設為 0
'注冊熱鍵為 Ctrl + F
Call RegisterHotKey(Me.hWnd, &HFFFFF, MOD_CONTROL, vbKeyF)
End Sub

Private Sub Form_Unload(Cancel As Integer)
'反注冊熱鍵
Call UnregisterHotKey(Me.hWnd, &HFFFFF)
'取消窗體消息的截取，而使之又只送往原來的 Window Procere
Call SetWindowLong(Me.hWnd, GWL_WNDPROC, preProc)
End Sub

'模塊
Option Explicit

'Prodeced 2007 By TZWSOHO
'下面給出一小部分窗體消息的解釋，想獲取更多內容請參考微軟的 MSDN
Private Const WM_GETMINMAXINFO As Long = &H24 '窗體移動或改變大小時激發的通告，可控制窗口能改變的大小
Private Const WM_MOUSEWHEEL As Long = &H20A '滑鼠滾輪滾動通告
Private Const WM_DEVICECHANGE As Long = &H219 '設備插入通告，可用於檢測當前是否有可移動磁碟插入
Private Const WM_HOTKEY As Long = &H312 '熱鍵鍵入通告

Private Declare Function CallWindowProc Lib "user32.dll" 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 preProc As Long

Function hProc(ByVal hWnd As Long, ByVal msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Select Case msg
Case WM_HOTKEY
'轉成十六進制後的 lParam 首兩位為對應熱鍵的鍵代碼，
'末兩位是功能鍵的代碼：1 = Alt, 2 = Ctrl, 4 = Shift
'其餘值為代碼的和，如：3 = Alt + Ctrl
Form1.Print Hex(lParam)
Form1.Print "用戶按下熱鍵！"
Case WM_MOUSEWHEEL '滑鼠滾輪滾動，方向取決於 wParam 的符號
If Sgn(wParam) = -1 Then 'wParam 的符號為負，滾輪從左往右看為順時針旋轉
Form1.Print "滾輪向後滾"
ElseIf Sgn(wParam) = 1 Then 'wParam 的符號為正，滾輪從左往右看為逆時針旋轉
Form1.Print "滾輪向前滾"
End If
End Select
hProc = CallWindowProc(preProc, hWnd, msg, wParam, lParam)
End Function

7. 請教：用vb編程如何實現用滑鼠滾輪擴大和縮小窗體上的圖片

添加一個模塊，輸入以下代碼：

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 Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
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 GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Public Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long

Public Const GWL_WNDPROC = -4&
Public Const WM_MOUSEWHEEL = &H20A

Public Type POINTAPI
x As Long
y As Long
End Type

Public OldWindowProc As Long
Public ohwnd As Long

Public Function NewWindowProc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
On Error Resume Next
If Msg = WM_MOUSEWHEEL Then
Dim CurPoint As POINTAPI, hwndUnderCursor As Long
GetCursorPos CurPoint
hwndUnderCursor = WindowFromPoint(CurPoint.x, CurPoint.y)
If hwndUnderCursor = ohwnd Then
If wParam = -7864320 Then
If Form1.Picture1.Width < Form1.ScaleWidth Then Form1.Picture1.Width = Form1.Picture1.Width + 300
If Form1.Picture1.Height < Form1.ScaleHeight Then Form1.Picture1.Height = Form1.Picture1.Height + 240
ElseIf wParam = 7864320 Then
If Form1.Picture1.Width > 600 Then Form1.Picture1.Width = Form1.Picture1.Width - 300
If Form1.Picture1.Height > 480 Then Form1.Picture1.Height = Form1.Picture1.Height - 240
End If
End If
Else
NewWindowProc = CallWindowProc(OldWindowProc, hwnd, Msg, wParam, lParam)
End If
End Function

在Form1中放入一個Picture1控制項，然後輸入以下代碼：

Private Sub Form_Load()
Picture1.AutoRedraw = True
Picture1.Picture = LoadPicture("e:\tmp\cd1.gif") '圖片文件名，自己改
Picture1.Move 0, 0, 6000, 4800
ohwnd = Picture1.hwnd
OldWindowProc = GetWindowLong(Picture1.hwnd, GWL_WNDPROC)
Call SetWindowLong(Picture1.hwnd, GWL_WNDPROC, AddressOf NewWindowProc)
End Sub

Private Sub Picture1_Resize()
Picture1.PaintPicture Picture1.Picture, 0, 0, Picture1.ScaleWidth, Picture1.ScaleHeight
End Sub