Событие прокрутки колесика мыши

@Power_Basic · Регистрация: 08.03.2016

Студворк — интернет-сервис помощи студентам

Давно интересует такой вопрос. Кто знает, ответьте, пожалуйста.
Можно ли в VB как-нибудь ловить события, связанные с колесиком мыши?
Ну вот есть, например,

Visual Basic
1
Sub Picture1_Click ()

А вот нет чего-нибудь такого вроде

Visual Basic
1
Sub Picture1_MouseWheelRoll ()

?

Ну точно такого-то, конечно, нет, а то бы я за 10 лет знакомства с VB когда-нибудь это встретил, но может быть уже изобрели какой-нибудь танец с бубном для "ловли" таких событий?

@Pro_grammer · 10.03.2016, 07:58

Сообщение от Power_Basic

Можно ли в VB как-нибудь ловить события, связанные с колесиком мыши?

WinAPI наше всё
API декларация

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
'============== внутри модуля
Option Explicit
'************************************************************
'API
'************************************************************
 
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
Private Declare Function SetWindowLong Lib "user32.dll" Alias "SetWindowLongA" ( _
    ByVal hWnd As Long, _
    ByVal nIndex As Long, _
    ByVal dwNewLong As Long) As Long
 
'************************************************************
'Constants
'************************************************************
 
Public Const MK_CONTROL = &H8
Public Const MK_LBUTTON = &H1
Public Const MK_RBUTTON = &H2
Public Const MK_MBUTTON = &H10
Public Const MK_SHIFT = &H4
Private Const GWL_WNDPROC = -4
Private Const WM_MOUSEWHEEL = &H20A

Модуль

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
'************************************************************
'Variables
'************************************************************
 
Private hControl As Long
Private lPrevWndProc As Long
 
'*************************************************************
'WindowProc
'*************************************************************
 
Private Function WindowProc(ByVal lWnd As Long, ByVal lMsg As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long
    'Test if the message is WM_MOUSEWHEEL
    If lMsg = WM_MOUSEWHEEL Then
        'Add event handling code here
        'this will be universal to all forms that are 'hooked' to this code
        Screen.ActiveForm.MouseWheelRolled
    End If
    'Sends message to previous procedure if not MOUSEWHEEL
    'This is VERY IMPORTANT!!!
    If lMsg <> WM_MOUSEWHEEL Then
        WindowProc = CallWindowProc(lPrevWndProc, lWnd, lMsg, wParam, lParam)
    End If
End Function
 
'*************************************************************
'Hook
'All forms that call this procedure must implement this procedure in their module:
'   Public Sub MouseWheelRolled()
'        <your code>
'   End Sub
'*************************************************************
Public Sub Hook(ByVal hControl_ As Long)
    hControl = hControl_
    lPrevWndProc = SetWindowLong(hControl, GWL_WNDPROC, AddrOf("WindowProc"))
End Sub
 
'*************************************************************
'UnHook
'*************************************************************
Public Sub UnHook()
    Call SetWindowLong(hControl, GWL_WNDPROC, lPrevWndProc)
End Sub

теперь в коде формы сожно написать, то что и требовалось

Visual Basic
1
2
3
Public Sub MouseWheelRolled()
   ' код процедуры
End Sub

@The trick · 10.03.2016, 10:22

Попробуй это. Это класс для безопасного сабклассинга.

@Pro_grammer · 10.03.2016, 13:39

Не по теме:

Сообщение от The trick

Попробуй это.

А как же П.5.8?

@The trick · 10.03.2016, 13:53

Не по теме:

Сообщение от Pro_grammer

А как же П.5.8?

Администрация не исправляет проблему скачивания вложений из блогов, поэтому дал ссылку на другой ресурс. В противном случае дал бы сюда.

@Power_Basic · 10.03.2016, 17:32 **[ТС]**

Спасибо обоим авторам откликнувшимся на мой вопрос!

Честно говоря, API-шный подход мне "роднее", потому что с классами я немного не в ладах и вообще тяготею к процедурному программированию

Сейчас вот как раз нахожусь на той стадии развития, что собираюсь серьезно восполнять пробелы в знаниях. Помню еще 10 лет назад распечатал Online Books из Vb5 и честно прочитал всё (ничего не пропуская!) до того места, где написано про дом из соломы, дом из дерева и дом из кирпича. Это они так образно излагают идею инкапсуляции в модулях. И сразу же там про полиморфизм что-то пытаются втолковывать, но это я уже не понял, в башке получилась полная путаница, и охота читать дальше сразу пропала, особенно потому что они там же пишут, что программы со всеми этими наворотами будут работать очень медленно. И вот с тех самых пор к классам у меня неприязнь

Но, на самом деле, сейчас снова начал читать с самого начала эти Online Books, чтобы, наконец, во всем разобраться, уже имея за плечами неплохой опыт программирования в среде VBA Excel. А там ведь тоже сплошные классы и коллекции, но там я всё это применяю, не особо вникая в то, откуда ноги растут

Но это была присказка, теперь к делу...

Первый, API-шный пример почему-то не работает. Возможно я что-то делаю неправильно. Просто тупо скопировал в стандартный модуль два больших куска кода, бросил на форму командную кнопку, а в саму форму вписал вот такой код:

Visual Basic
1
2
3
4
5
6
7
Public Sub MouseWheelRolled()
   MsgBox "Пользователь крутит колесо мыши"
End Sub
 
Private Sub cmdCommand1_Click()
   MsgBox "Пользователь нажал кнопку"
End Sub

В результате при нажатии на кнопку сообщение выскакивает, а вот на вращение колеса форма почему-то никак не реагирует. Сначала пробовал без кнопки, а потом её добавил, чтобы убедиться, что с самими сообщениями всё в порядке.

А что касается Ver. 2_2.zip, то там да, всё работает идеально, колесо крутится и окружность при этом расширяется или сужается. Но сам код такой длинный и сложный, что мне пока не по зубам

А бездумно вставлять в свои программы куски чужого готового кода, работу которого не понимаешь, как-то некомфортно. Поэтому хотелось бы все-таки разобраться, почему не работает первый пример. Я что-то делаю не так?

Когда запускаюсь в IDE, компилятор не ругается, а вот когда пытаюсь сделать екскшник, мне говорят, что подпрограмма или функция не определена и показывают вот на это место:

Visual Basic
1
AddrOf("WindowProc")

Прилагаю то, что у меня получилось:

@The trick · 10.03.2016, 18:27

По сути это тот же код что тебе дал Pro_grammer, только он уже укомплектован в класс для удобного использования в формах и вообще любых объектных модулях. Плюс он более безопасен чем первый код. Разбираться с кодом класса тебе не нужно, также к примеру как ты не исследуешь внутренний код стандартных классов - используй его как есть.

Добавлено через 4 минуты
Насчёт первого кода. Ты должен вызывать Hook и Unhook с hWnd'ом нужного контрола для инициализации и деинициализации перехвата соответственно.

Сообщение от Power_Basic

AddrOf("WindowProc")

Вместо этого нужно писать AddressOf WindowProc

@Power_Basic · 11.03.2016, 00:20 **[ТС]**

Сообщение от The trick

Насчёт первого кода. Ты должен вызывать Hook и Unhook с hWnd'ом нужного контрола для инициализации и деинициализации перехвата соответственно.

Сообщение от Power_Basic

AddrOf("WindowProc")

Вместо этого нужно писать AddressOf WindowProc

Большое спасибо! Заработало!
Прикольно, колесо кручу и форма движется по экрану

Модуль

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
'============== внутри модуля
Option Explicit
'************************************************************
'API
'************************************************************
 
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
Private Declare Function SetWindowLong Lib "user32.dll" Alias "SetWindowLongA" ( _
    ByVal hWnd As Long, _
    ByVal nIndex As Long, _
    ByVal dwNewLong As Long) As Long
 
'************************************************************
'Constants
'************************************************************
 
Public Const MK_CONTROL = &H8
Public Const MK_LBUTTON = &H1
Public Const MK_RBUTTON = &H2
Public Const MK_MBUTTON = &H10
Public Const MK_SHIFT = &H4
Private Const GWL_WNDPROC = -4
Private Const WM_MOUSEWHEEL = &H20A
 
'************************************************************
'Variables
'************************************************************
 
Private hControl As Long
Private lPrevWndProc As Long
 
'*************************************************************
'WindowProc
'*************************************************************
 
Private Function WindowProc(ByVal lWnd As Long, ByVal lMsg As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long
    'Test if the message is WM_MOUSEWHEEL
    If lMsg = WM_MOUSEWHEEL Then
        'Add event handling code here
        'this will be universal to all forms that are 'hooked' to this code
        Screen.ActiveForm.MouseWheelRolled
    End If
    'Sends message to previous procedure if not MOUSEWHEEL
    'This is VERY IMPORTANT!!!
    If lMsg <> WM_MOUSEWHEEL Then
        WindowProc = CallWindowProc(lPrevWndProc, lWnd, lMsg, wParam, lParam)
    End If
End Function
 
'*************************************************************
'Hook
'All forms that call this procedure must implement this procedure in their module:
'   Public Sub MouseWheelRolled()
'        <your code>
'   End Sub
'*************************************************************
Public Sub Hook(ByVal hControl_ As Long)
    hControl = hControl_
    lPrevWndProc = SetWindowLong(hControl, GWL_WNDPROC, AddressOf WindowProc)
End Sub
 
'*************************************************************
'UnHook
'*************************************************************
Public Sub UnHook()
    Call SetWindowLong(hControl, GWL_WNDPROC, lPrevWndProc)
End Sub

Форма

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Option Explicit
 
Private Declare Function FindWindow Lib _
    "user32" Alias "FindWindowA" _
    (ByVal lpClassName As String, _
    ByVal lpWindowName As String) As Long
    
Dim lngHandle As Long
 
Public Sub MouseWheelRolled()
      Me.Left = Me.Left + 100
End Sub
 
Private Sub Form_Load()
   'получаем хендл формы по Caption.
   lngHandle = FindWindow(vbNullString, "Form1")
   Hook (lngHandle)
End Sub

@Alex77755 · 11.03.2016, 08:58

колесо кручу и форма движется

Но только в одну сторону. Не зависимо от направления вращения.
Должно же быть решения распознания направления вращения

@Power_Basic · 11.03.2016, 14:11 **[ТС]**

Сообщение от Alex77755

Но только в одну сторону. Не зависимо от направления вращения.
Должно же быть решения распознания направления вращения

Но это же только самый простой пример, чтобы понять возможно ли это в принципе или нет. А более точная настройка это (для меня) уже в будущем, поскольку сейчас у меня по жизни нет задач, где требуется такая возможность (реакция на вращение колеса). Для меня самое важное было выяснить, что это возможно, и я в этом убедился, а то ведь всегда было обидно, что, например, сишники в своих прогах могут использовать мышь по полной программе, а мы нет.

Ну а то, что можно ловить вращения мыши в разные стороны и по-разному их обрабатывать видно из примера The trick'а. Там же у него окружность при вращении колеса в одну сторону расширяется, а в другую сужается. Когда придет время и это мне понадобится, просто полезу в свой архив, в котором храню все советы со всех форумов (со всеми сопутствующими материалами), разберусь, как это там сделано и буду использовать.

Dragokas · 11.03.2016, 23:31

Power_Basic, для этого не обязательно искать/смотреть на чужой пример.
Вы можете симмитировать нужное Вам действие (движение колесом мыши) и посмотреть какой код оконного сообщения оно генерирует, предварительно (на примере Pro_grammer, вписав в процедуру оконного сообщения что-то вроде:

Visual Basic
1
debug.? lWnd

Потом поискать название этой константы по коду.
Я себе к примеру из наиболее популярных шпоргалку выписал (прикрепил). Можно по ней. Потом посмотреть описание на MSDN (сообщений, вероятно, будет много. Вам придется найти 1 подходящее под Вашу ситуацию).

Есть и такие программы, которые могут показать, какие оконные сообщения приходят в окно чужой программы:
WinSpy, WinID, Win Inspector, Window Detective ... и т.п. по вкусу.

@Power_Basic · 12.03.2016, 23:25 **[ТС]**

Dragokas, спасибо за список! Буду пользоваться.

@Alenos55 · 29.10.2024, 13:24

VB.NET
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
Public Class frmMain
 
 
    Private _totalDelta As Integer = 0
 
    Private Sub frmMain_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
        'на форме должны быть:
        ' DeltaLabel
        ' TotalDeltaLabel
        ' LinesLabel
    End Sub
 
    Private Sub frmMain_MouseWheel(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) _
            Handles Me.MouseWheel
        'параметр e.Delta при вращении колесика мыши в зависимости от
        'направления вращения меняет свой знак, но всегда равен 120 единиц
        'при вращении «НА СЕБЯ» он равен -120, «ОТ СЕБЯ» +120 на единичный
        'поворот колесика. Таким образом e.Delta только меняет знак +/-
        'переменная _totalDelta суммирует e.Delta с учетом знака
        _totalDelta = _totalDelta + e.Delta
        DeltaLabel.Text = e.Delta.ToString()
        TotalDeltaLabel.Text = _totalDelta.ToString()
        'здесь выдается системная информация на сколько строк проведена прокрутка
        'от начальной заданной строки(по умолчанию по 3 строки на одно движение колесика)
        LinesLabel.Text = (SystemInformation.MouseWheelScrollLines * _totalDelta / 120).ToString()
 
    End Sub
    'кажется так
End Class

Новые блоги и статьи Все статьи Все блоги /
Философия технологии iceja 01.02.2026 На мой взгляд у человека в технических проектах остается роль генерального директора. Все остальное нейронки делают уже лучше человека. Они не могут нести предпринимательские риски, не могут. . .	SDL3 для Web (WebAssembly): Вывод текста со шрифтом TTF с помощью SDL3_ttf 8Observer8 01.02.2026 Содержание блога В этой пошаговой инструкции создадим с нуля веб-приложение, которое выводит текст в окне браузера. Запустим на Android на локальном сервере. Загрузим Release на бесплатный. . .	SDL3 для Web (WebAssembly): Сборка C/C++ проекта из консоли 8Observer8 30.01.2026 Содержание блога Если вы откроете примеры для начинающих на официальном репозитории SDL3 в папке: examples, то вы увидите, что все примеры используют следующие четыре обязательные функции, а. . .	SDL3 для Web (WebAssembly): Установка Emscripten SDK (emsdk) и CMake для сборки C и C++ приложений в Wasm 8Observer8 30.01.2026 Содержание блога Для того чтобы скачать Emscripten SDK (emsdk) необходимо сначало скачать и уставить Git: Install for Windows. Следуйте стандартной процедуре установки Git через установщик. . . .
SDL3 для Android: Подключение Box2D v3, физика и отрисовка коллайдеров 8Observer8 29.01.2026 Содержание блога Box2D - это библиотека для 2D физики для анимаций и игр. С её помощью можно определять были ли коллизии между конкретными объектами. Версия v3 была полностью переписана на Си, в. . .	Инструменты COM: Сохранение данный из VARIANT в файл и загрузка из файла в VARIANT bedvit 28.01.2026 Сохранение базовых типов COM и массивов (одномерных или двухмерных) любой вложенности (деревья) в файл, с возможностью выбора алгоритмов сжатия и шифрования. Часть библиотеки BedvitCOM Использованы. . .	SDL3 для Android: Загрузка PNG с альфа-каналом с помощью SDL_LoadPNG (без SDL3_image) 8Observer8 28.01.2026 Содержание блога SDL3 имеет собственные средства для загрузки и отображения PNG-файлов с альфа-каналом и базовой работы с ними. В этой инструкции используется функция SDL_LoadPNG(), которая. . .	SDL3 для Android: Загрузка PNG с альфа-каналом с помощью SDL3_image 8Observer8 27.01.2026 Содержание блога SDL3_image - это библиотека для загрузки и работы с изображениями. Эта пошаговая инструкция покажет, как загрузить и вывести на экран смартфона картинку с альфа-каналом, то есть с. . .

Событие прокрутки колесика мыши

Решение

Решение

@The trick Модератор 10048 / 3894 / 883 Регистрация: 22.02.2013 Сообщений: 5,847 Записей в блоге: 79
	10.03.2016, 10:22
	Попробуй это. Это класс для безопасного сабклассинга. 2

@Power_Basic 46 / 25 / 0 Регистрация: 08.03.2016 Сообщений: 443
	12.03.2016, 23:25 [ТС]
	Dragokas, спасибо за список! Буду пользоваться. 0