Пример отслеживания движений скрола мышки - Система - Интересные решения для программистов - Примеры кода

Система → Пример отслеживания движений скрола мышки → Visual Basic

В переменную Wheel передаётся направление вращение: -1 при движении вниз или 1 при движении вверх.

'-------------------
'---VBNet[dot]Ru
'-------------------

'КОД ФОРМЫ
Option Explicit

Private Sub Form_Load()
Call Hook(Me.hwnd)
End Sub

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

'КОД МОДУЛЯ
Option Explicit
Private Declare Function CallWindowProcA Lib "user32" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal MSG As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function SetWindowLongA Lib "user32" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function SetWindowTextA Lib "user32" (ByVal hwnd As Long, ByVal lpString As String) As Long
Private Const GWL_WNDPROC = -4
Private Const WM_MOUSEWHEEL = &H20A
Private lpPrevWndProc As Long, Wheel As Integer

Sub Hook(hwnd As Long)
lpPrevWndProc = SetWindowLongA(hwnd, GWL_WNDPROC, AddressOf WindowProc)
End Sub

Sub UnHook(hwnd As Long)
Call SetWindowLongA(hwnd, GWL_WNDPROC, lpPrevWndProc)
End Sub

Function WindowProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
On Error GoTo xErr
If uMsg = WM_MOUSEWHEEL Then
If wParam = -7864320 Or wParam = -23592960 Or wParam = -15728640 Then Wheel = -1
If wParam = 7864320 Or wParam = 23592960 Or wParam = 15728640 Then Wheel = 1
Call SetWindowTextA(Form1.hwnd, "Wheel " & Wheel)
Else
WindowProc = CallWindowProcA(lpPrevWndProc, hwnd, uMsg, wParam, lParam)
End If
xErr:
End Function

motion, mouse, scroll, vb, visual basic, wheel

KOS_MOS

Алексей

19.10.2008

Александр [Добавлено 07.05.2011 22:37:09]

Спасибо огромное!!!

Меню

Подписка на RSS:

Подпишись на RSS-ленту

Поиск

Облако тегов

	Система → Пример отслеживания движений скрола мышки → Visual Basic В переменную Wheel передаётся направление вращение: -1 при движении вниз или 1 при движении вверх. '------------------- '---VBNet[dot]Ru '------------------- 'КОД ФОРМЫ Option Explicit Private Sub Form_Load() Call Hook(Me.hwnd) End Sub Private Sub Form_Unload(Cancel As Integer) Call UnHook(Me.hwnd) End Sub 'КОД МОДУЛЯ Option Explicit Private Declare Function CallWindowProcA Lib "user32" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal MSG As Long, ByVal wParam As Long, ByVal lParam As Long) As Long Private Declare Function SetWindowLongA Lib "user32" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long Private Declare Function SetWindowTextA Lib "user32" (ByVal hwnd As Long, ByVal lpString As String) As Long Private Const GWL_WNDPROC = -4 Private Const WM_MOUSEWHEEL = &H20A Private lpPrevWndProc As Long, Wheel As Integer Sub Hook(hwnd As Long) lpPrevWndProc = SetWindowLongA(hwnd, GWL_WNDPROC, AddressOf WindowProc) End Sub Sub UnHook(hwnd As Long) Call SetWindowLongA(hwnd, GWL_WNDPROC, lpPrevWndProc) End Sub Function WindowProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long On Error GoTo xErr If uMsg = WM_MOUSEWHEEL Then If wParam = -7864320 Or wParam = -23592960 Or wParam = -15728640 Then Wheel = -1 If wParam = 7864320 Or wParam = 23592960 Or wParam = 15728640 Then Wheel = 1 Call SetWindowTextA(Form1.hwnd, "Wheel " & Wheel) Else WindowProc = CallWindowProcA(lpPrevWndProc, hwnd, uMsg, wParam, lParam) End If xErr: End Function motion, mouse, scroll, vb, visual basic, wheel KOS_MOS Алексей 19.10.2008 Александр [Добавлено 07.05.2011 22:37:09] Спасибо огромное!!! Ваше имя Ваш E-mail (если хотите отслеживать комментарии) Дoкажи, что ты не робот Текст комментария	Меню CodeIgniter Алгоритмы Базы данных Дата и Время Интернет Интерфейс Мультимедиа ОС и Железо Работа с текстом Разное Технологии Файлы Подписка на RSS: Подпишись на RSS-ленту Поиск Облако тегов .net array asp bash browser charset check class clean convert count create css curl database date delete directory download element email equivalent extension file find form format function get height html http ie image javascript jquery load mysql number page perl php random scriplet send shell size sql string text time url utf8 variable vb visual basic width window xml xslt