Как узнать размер курсора мыши

@HackerVlad · Регистрация: 10.09.2021

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

Как узнать размер курсора мыши

Именно сколько пикселей по высоте, системные сообщения будут выдавать 32-х32 но это нето

Добавлено через 42 секунды
Я наткнулся на интересный пост, ещё в 2004 году об этом писали: https://www.rsdn.org/forum/winapi/739215.hot

Добавлено через 38 секунд
Там даже писали ровно то, что мне и надо "Памагите!!!

Никак не могу определить высоту курсора мыши. ToolTip это как-то делает. В зависимости от реального размера курсора делает смещение вниз."

@HackerVlad · 20.10.2023, 20:44 **[ТС]**

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

константы

ты с ума сошёл? какая ещё константа? курсор мышки пользователь может выбрать любой на свой вкус, там может быть какое угодно количество пикселей по высоте. В икспи у меня например другой курсор, там 25

Добавлено через 1 минуту
Константу можно 32 только долбануть (с максимальным запасом сразу), но будет тогда некрасивое пустое место между курсором и подсказкой...

Добавлено через 2 минуты
Потом ещё нужно вычислять расположение горячей точки обязательно (тоже не во всех курсорах это будет именно самый верхний пиксель)

Добавлено через 5 часов 40 минут
The trick, а ты случайно не знаешь как hbmMask преобразовать в hbmColor, а то иначе чёрно-белые у меня не получится обрабатывать

Добавлено через 1 минуту
Наткнулся на интересный пост здесь: https://translated.turbopages.... r-in-win32
Там как раз почти то, что мне надо, показано даже как выглядит чёрно-белый курсор

Добавлено через 1 минуту
Но я с C# не умею переписывать на VB6

@The trick · 20.10.2023, 20:51

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

The trick, а ты случайно не знаешь как hbmMask преобразовать в hbmColor, а то иначе чёрно-белые у меня не получится обрабатывать

Не нужно ничего преобразовывать - нужно работать сразу с hbmMask.

@HackerVlad · 20.10.2023, 20:52 **[ТС]**

Но я наткнулся на очень интересную функцию IconToPicture:

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Private Function IconToPicture(ByVal hIcon As Long) As IPicture
    Dim iPic As IPicture, picDes As PictDesc, iidIPicture As Guid
    With picDes
        .cbSizeofStruct = Len(picDes)
        .picType = &H3
        .hImage = hIcon
    End With
    With iidIPicture
        .Data1 = &H7BF80980
        .Data2 = &HBF32
        .Data3 = &H101A
        .Data4(0) = &H8B
        .Data4(1) = &HBB
        .Data4(2) = &H0
        .Data4(3) = &HAA
        .Data4(4) = &H0
        .Data4(5) = &H30
        .Data4(6) = &HC
        .Data4(7) = &HAB
    End With
    Call OleCreatePictureIndirect(picDes, iidIPicture, True, IconToPicture)
End Function

Добавлено через 24 секунды

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

Не нужно ничего преобразовывать - нужно работать сразу с hbmMask.

Я же говорю, это слишком сложно для моего понимания.

@The trick · 20.10.2023, 20:53

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

Я же говорю, это слишком сложно для моего понимания.

Ну это не ко мне тогда.

@HackerVlad · 20.10.2023, 21:50 **[ТС]**

Зато я могу теперь преобразовать с помощью IconToPicture

Добавлено через 42 минуты
The trick, так как этой маской пользоваться? там наверное всего пару строк кода?

Добавлено через 2 минуты
The trick, поделись, пожалуйста, кодом, если не жалко, который преобразует hbmMask в массив пикселей, для меня это непомерная задача вообще 3 дня бьюсь

Добавлено через 7 минут
Я только где-то нашёл что люди через ImageList преобразовывают маску в картинку.
Я без понятия вообще. Если бы я умел получать картинку из маски или перебирать пиксели в маске.... Эх, как всё тяждело

@HackerVlad · 22.10.2023, 19:57 **[ТС]**

Вот моё новое решение:

Форма:

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
Option Explicit
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal CX As Long, ByVal CY As Long, ByVal wFlags As Long) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
 
Private Const SWP_NOSIZE = &H1
Private Const SWP_NOMOVE = &H2
Private Const SWP_NOACTIVATE = &H10
Private Const SWP_NOZORDER = &H4
Private Const HWND_TOPMOST = -1
 
Private Type POINTAPI
    x As Long
    y As Long
End Type
 
Private Sub Command1_Click()
    Dim CursorSizeHeight As Integer
    Dim HotY As Integer
    
    GetMouseCursorHeight CursorSizeHeight, HotY
    
    Me.Cls
    Print "Height: " & CursorSizeHeight
    Print "HotY: " & HotY
End Sub
 
Private Sub Form_Load()
    Form2.Show
End Sub
 
Private Sub Form_Unload(Cancel As Integer)
    Unload Form2
End Sub
 
Private Sub Timer1_Timer()
    Dim pt As POINTAPI
    Dim CursorSizeHeight As Integer
    Dim HotY As Integer
    
    GetCursorPos pt
    GetMouseCursorHeight CursorSizeHeight, HotY
    
    SetWindowPos Form2.hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOACTIVATE Or SWP_NOSIZE Or SWP_NOMOVE
    SetWindowPos Form2.hwnd, 0, pt.x, pt.y + (CursorSizeHeight - HotY), 0, 0, SWP_NOSIZE Or SWP_NOZORDER Or SWP_NOACTIVATE
End Sub

Модуль:

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
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
Option Explicit
Private Declare Function GetCursorInfo Lib "user32" (ByRef pci As CURSORINFO) As Long
Private Declare Function GetIconInfo Lib "user32" (ByVal hIcon As Long, ByRef piconinfo As ICONINFO) As Long
Private Declare Function GetObjectW Lib "gdi32" (ByVal hObject As Long, ByVal nCount As Long, ByRef lpObject As Any) As Long
Private Declare Function GetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, ByVal dwCount As Long, lpBits As Any) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
 
Private Type CURSORINFO
    cbSize          As Long
    Flags           As Long
    hCursor         As Long
    ptPosX          As Long
    ptPosY          As Long
End Type
 
Private Type ICONINFO
    fIcon           As Long
    xHotspot        As Long
    yHotspot        As Long
    hbmMask         As Long
    hbmColor        As Long
End Type
 
Private Type BITMAP
    bmType          As Long
    bmWidth         As Long
    bmHeight        As Long
    bmWidthBytes    As Long
    bmPlanes        As Integer
    bmBitsPixel     As Integer
    bmBits          As Long
End Type
 
Public Sub GetMouseCursorHeight(SizeHeight As Integer, HotY As Integer)
    Dim tCurInfo As CURSORINFO
    
    ' If there is no mouse cursor, these should be 0
    SizeHeight = 0
    HotY = 0
    
    tCurInfo.cbSize = Len(tCurInfo)
    GetCursorInfo tCurInfo
    
    If tCurInfo.Flags = 1 And CBool(tCurInfo.hCursor) Then
        ' In case we can't figure out the dimensions, this is a best guess
        SizeHeight = 19
        
        Dim tICONINFO As ICONINFO
        
        If GetIconInfo(tCurInfo.hCursor, tICONINFO) Then
            Dim bm As BITMAP
            
            If GetObjectW(tICONINFO.hbmMask, Len(bm), bm) <> 0 Then
                ' Extract the bitmap bits
                Dim max As Long
                Dim curMask() As Byte
                
                max = bm.bmWidth * bm.bmHeight / 8
                ReDim curMask(max * 2 - 1) ' Enough space for the mask and the xor mask
                
                ' bm.bmWidthBytes = UBound(curMask)
                If GetBitmapBits(tICONINFO.hbmMask, UBound(curMask), curMask(0)) <> 0 Then
                    Dim hasXORMask As Byte
                    Dim Empt As Boolean
                    Dim bottom As Long
                    
                    If tICONINFO.hbmColor Then
                    
                    Else
                        ' if no color bitmap, then the hbmMask is a double height bitmap
                        ' with the cursor and the mask stacked.
                        hasXORMask = 1
                        max = max / 2
                    End If
                    
                    ' Go through the bitmap looking for the bottom of the image and/or mask
                    Empt = True
                    bottom = max
                    bottom = bottom - 1
                    
                    Do While bottom >= 0
                        If curMask(bottom) <> &HFF Or (hasXORMask And (curMask(bottom + max) <> 0)) Then
                            Empt = False
                            Exit Do
                        End If
                        
                        bottom = bottom - 1
                    Loop
                    
                    If Empt = False Then
                        ' Go through the bitmap looking for the top of the image and/or mask
                        Dim top As Long
                        Dim byteWidth As Long
                        
                        For top = 0 To max - 1
                            If curMask(top) <> &HFF Or (hasXORMask And (curMask(top + max) <> 0)) Then Exit For
                        Next
                        
                        ' byteWidth = bytes per row AND bytes per vertical pixel
                        byteWidth = bm.bmWidth / 8
                        bottom = bottom / byteWidth
                        top = top / byteWidth
                        
                        SizeHeight = bottom - top + 1
                        HotY = tICONINFO.yHotspot - top
                    Else
                        ' (Final value) We didn't find anything in the bitmap.
                        ' So, we'll make a guess with the information that we have.
                        ' Note: This seems to happen on I-Beams and Cross-hairs -- cursors that
                        ' are all inverted. Strangely, their hbmColor is non-null.
                        SizeHeight = bm.bmHeight
                        HotY = tICONINFO.yHotspot
                    End If
                End If
                
                DeleteObject tICONINFO.hbmMask
            End If
        End If
    End If
End Sub

@HackerVlad · 22.10.2023, 20:32 **[ТС]**

Кстати, я только что заметил, что стандартный ToolTip от VB6 вообще появляется через 32 пикселя, в отличии от системного тултипа.

Добавлено через 13 секунд
Там даже не старались они делать видимо вообще...

@HackerVlad · 24.10.2023, 11:04 **[ТС]**

Важно! Новая версия функции GetMouseCursorHeight. Теперь не будет глючить, добавил строчку DeleteObject tICONINFO.hbmColor чтобы небыло переполнение стека или переполнение графического буфера. В общем чтоб графика не глючила, при многократном вызове. Теперь эта процедура чистит память как надо. А то раньше до конца память не чистила.

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
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
Option Explicit
Private Declare Function GetCursorInfo Lib "user32" (ByRef pci As CURSORINFO) As Long
Private Declare Function GetIconInfo Lib "user32" (ByVal hIcon As Long, ByRef piconinfo As ICONINFO) As Long
Private Declare Function GetObjectW Lib "gdi32" (ByVal hObject As Long, ByVal nCount As Long, ByRef lpObject As Any) As Long
Private Declare Function GetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, ByVal dwCount As Long, lpBits As Any) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
 
Private Type CURSORINFO
    cbSize          As Long
    Flags           As Long
    hCursor         As Long
    ptPosX          As Long
    ptPosY          As Long
End Type
 
Private Type ICONINFO
    fIcon           As Long
    xHotspot        As Long
    yHotspot        As Long
    hbmMask         As Long
    hbmColor        As Long
End Type
 
Private Type BITMAP
    bmType          As Long
    bmWidth         As Long
    bmHeight        As Long
    bmWidthBytes    As Long
    bmPlanes        As Integer
    bmBitsPixel     As Integer
    bmBits          As Long
End Type
 
Public Sub GetMouseCursorHeight(SizeHeight As Integer, HotY As Integer)
    Dim tCurInfo As CURSORINFO
    
    ' If there is no mouse cursor, these should be 0
    SizeHeight = 0
    HotY = 0
    
    tCurInfo.cbSize = Len(tCurInfo)
    GetCursorInfo tCurInfo
    
    If tCurInfo.Flags = 1 And CBool(tCurInfo.hCursor) Then
        ' In case we can't figure out the dimensions, this is a best guess
        SizeHeight = 19
        
        Dim tICONINFO As ICONINFO
        
        If GetIconInfo(tCurInfo.hCursor, tICONINFO) Then
            Dim bm As BITMAP
            
            If GetObjectW(tICONINFO.hbmMask, Len(bm), bm) <> 0 Then
                ' Extract the bitmap bits
                Dim max As Long
                Dim curMask() As Byte
                
                max = bm.bmWidth * bm.bmHeight / 8
                ReDim curMask(max * 2 - 1) ' Enough space for the mask and the xor mask
                
                ' bm.bmWidthBytes = UBound(curMask)
                If GetBitmapBits(tICONINFO.hbmMask, UBound(curMask), curMask(0)) <> 0 Then
                    Dim hasXORMask As Byte
                    Dim Empt As Boolean
                    Dim bottom As Long
                    
                    If tICONINFO.hbmColor Then
                    
                    Else
                        ' if no color bitmap, then the hbmMask is a double height bitmap
                        ' with the cursor and the mask stacked.
                        hasXORMask = 1
                        max = max / 2
                    End If
                    
                    ' Go through the bitmap looking for the bottom of the image and/or mask
                    Empt = True
                    bottom = max
                    bottom = bottom - 1
                    
                    Do While bottom >= 0
                        If curMask(bottom) <> &HFF Or (hasXORMask And (curMask(bottom + max) <> 0)) Then
                            Empt = False
                            Exit Do
                        End If
                        
                        bottom = bottom - 1
                    Loop
                    
                    If Empt = False Then
                        ' Go through the bitmap looking for the top of the image and/or mask
                        Dim top As Long
                        Dim byteWidth As Long
                        
                        For top = 0 To max - 1
                            If curMask(top) <> &HFF Or (hasXORMask And (curMask(top + max) <> 0)) Then Exit For
                        Next
                        
                        ' byteWidth = bytes per row AND bytes per vertical pixel
                        byteWidth = bm.bmWidth / 8
                        bottom = bottom / byteWidth
                        top = top / byteWidth
                        
                        SizeHeight = bottom - top + 1
                        HotY = tICONINFO.yHotspot - top
                    Else
                        ' (Final value) We didn't find anything in the bitmap.
                        ' So, we'll make a guess with the information that we have.
                        ' Note: This seems to happen on I-Beams and Cross-hairs -- cursors that
                        ' are all inverted. Strangely, their hbmColor is non-null.
                        SizeHeight = bm.bmHeight
                        HotY = tICONINFO.yHotspot
                    End If
                End If
            End If
            
            DeleteObject tICONINFO.hbmMask
            If tICONINFO.hbmColor Then DeleteObject tICONINFO.hbmColor
        End If
    End If
End Sub

Новые блоги и статьи Все статьи Все блоги /
Сезонность закисления почв anaschu 04.07.2026 200 часов это все равно моловато. Есть ситуации, но нестандартные, когда смена происходит за 5 лет. Но обычно это 50 лет и более. Наверное, закисление почвы происходит сезонно в средней. . .	В чем ценность человеческого опыта в глобальном смысле? kumehtar 03.07.2026 Возможно, ценность человека не в том, что он однажды достигает мудрости, а в том, что он становится носителем карты пути. Он знает не только истину, но и последовательность внутренних изменений,. . .	интеграция AnyLogic с самописным REST API и переход на Odoo anaschu 03.07.2026 Успешная интеграция AnyLogic с самописным REST API и переход на промышленную Odoo WMS Сегодня проделал огромный путь от простой симуляции физических процессов до построения полноценной. . .	Поиск всех путей на ориентированном графе. Linux dcc0 02.07.2026 Переработка старого кода из моей статьи. Через несколько переработок от PHP кода к C89 (надеюсь, 89). Но довольно запутанно получилось. Код для Linux. Но если убрать time и то, что с ним. . .
Сам себя обучал rest api anaschu 02.07.2026 Педагогический лайфхак: Почему чистый REST API для ученика намного круче, чем готовые библиотеки Когда мы отказались от капризного JAR-файла AnyLogic и переписали код на стандартный HttpClient,. . .	rest api anylogic - выполнение модели на своём русском сайте anaschu 02.07.2026 Как подружиться с AnyLogic Cloud API, победить провайдеров и развернуться Java-бэкенд в Docker на бесплатном хостинге: Двухдневный лог борьбы Всем привет! Хочу поделиться свежим (и довольно. . .	Где деньги лежат kumehtar 02.07.2026 Это - японская подводная лодка I-52 (тип C2, кодовое имя Momi) вышла из Японии в марте 1944 года с миссией в оккупированную немцами Францию (Лорьян). Это была одна из «Янаги»-миссий по обмену. . .	Krabik для WoW 3.3.5a, многоязычный AmbA 02.07.2026 Допилил бота, думаю что окончательно. Изменения: - добавлена многоязычность - добавлено снятие скриншотов - добавлено поддержание бафов хождения по воде (для жреца, дк и шамана) - и так, по. . .

@HackerVlad Вернулся 1748 / 644 / 45 Регистрация: 10.09.2021 Сообщений: 2,786

	Как узнать размер курсора мыши 17.10.2023, 17:52. Показов 4152. Ответов 47 Метки нет (Все метки) Как узнать размер курсора мыши Именно сколько пикселей по высоте, системные сообщения будут выдавать 32-х32 но это нето Добавлено через 42 секунды Я наткнулся на интересный пост, ещё в 2004 году об этом писали: https://www.rsdn.org/forum/winapi/739215.hot Добавлено через 38 секунд Там даже писали ровно то, что мне и надо "Памагите!!! Никак не могу определить высоту курсора мыши. ToolTip это как-то делает. В зависимости от реального размера курсора делает смещение вниз." 0

@HackerVlad Вернулся 1748 / 644 / 45 Регистрация: 10.09.2021 Сообщений: 2,786
	20.10.2023, 21:50 [ТС]
	Зато я могу теперь преобразовать с помощью IconToPicture Добавлено через 42 минуты The trick, так как этой маской пользоваться? там наверное всего пару строк кода? Добавлено через 2 минуты The trick, поделись, пожалуйста, кодом, если не жалко, который преобразует hbmMask в массив пикселей, для меня это непомерная задача вообще 3 дня бьюсь Добавлено через 7 минут Я только где-то нашёл что люди через ImageList преобразовывают маску в картинку. Я без понятия вообще. Если бы я умел получать картинку из маски или перебирать пиксели в маске.... Эх, как всё тяждело 0

@HackerVlad Вернулся 1748 / 644 / 45 Регистрация: 10.09.2021 Сообщений: 2,786
	22.10.2023, 20:32 [ТС]
	Кстати, я только что заметил, что стандартный ToolTip от VB6 вообще появляется через 32 пикселя, в отличии от системного тултипа. Добавлено через 13 секунд Там даже не старались они делать видимо вообще... 0