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

@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

Новые блоги и статьи Все статьи Все блоги /
Мысли в слух. Про "навсегда". kumehtar 16.04.2026 Подумалось тут, что наверное очень глупо использовать во всяких своих установках понятие "навсегда". Это очень сильное понятие, и я только начинаю понимать край его смысла, не смотря на то что давно. . .	My Business CRM MaGz GoLd 16.04.2026 Всем привет, недавно возникла потребность создать CRM, для личных нужд. Собственно программа предоставляет из себя базу данных клиентов, в которой можно фиксировать звонки, стадии сделки, а также. . .	Знаешь почему 90% людей редко бывают счастливыми? kumehtar 14.04.2026 Потому что они ждут. Ждут выходных, ждут отпуска, ждут удачного момента. . . а удачный момент так и не приходит.	Фиксация колонок в отчете СКД Maks 14.04.2026 Фиксация колонок в СКД отчета типа Таблица. Задача: зафиксировать три левых колонки в отчете. Процедура ПриКомпоновкеРезультата(ДокументРезультат, ДанныеРасшифровки, СтандартнаяОбработка) / / . . .
Настройки VS Code Loafer 13.04.2026 { "cmake. configureOnOpen": false, "diffEditor. ignoreTrimWhitespace": true, "editor. guides. bracketPairs": "active", "extensions. ignoreRecommendations": true, . . .	Оптимизация кода на разграничение прав доступа к элементам формы Maks 13.04.2026 Алгоритм из решения ниже реализован на нетиповом документе, разработанного в конфигурации КА2. Задачи, как таковой, поставлено не было, проделанное ниже исключительно моя инициатива. Было так:. . .	Контроль заполнения и очистка дат в зависимости от значения перечислений Maks 12.04.2026 Алгоритм из решения ниже реализован на примере нетипового документа "ПланированиеПерсонала", разработанного в конфигурации КА2. Задача: реализовать контроль корректности заполнения дат назначения. . .	Архитектура слоя интернета для сервера-слоя. Hrethgir 11.04.2026 В продолжение https:/ / www. cyberforum. ru/ blogs/ 223907/ 10860. html Знаешь что я подумал? Раз мы все источники пишем в голове ветки, то ничего не мешает добавить в голову такой источник, который сам. . .

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

Решение

Решение

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

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