Ручной курсор для Label VBA Excel - PullRequest
Новая
       36

Ручной курсор для Label VBA Excel

0 голосов
/ 31 декабря 2018

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

1 Ответ

0 голосов
/ 31 декабря 2018

Вы можете использовать Windows API для изменения внешнего вида курсора.Я предполагаю, что это в пользовательской форме Excel, поэтому вы можете использовать событие MouseMove, чтобы узнать, когда указатель мыши находится над меткой.

Вот код, который вы бы добавили в код позади формы. 

Option Explicit

'Api Declarations
Private Declare Function GetCursorInfo Lib "user32" (ByRef pci As CursorInfo) As Boolean
Private Declare PtrSafe Function LoadCursor Lib "user32" Alias "LoadCursorA" (ByVal hInstance As Long, ByVal lpCursorName As Long) As Long
Private Declare PtrSafe Function SetCursor Lib "user32" (ByVal hCursor As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

'You can use the default cursors in windows
Public Enum CursorTypes
    IDC_ARROW = 32512
    IDC_IBEAM = 32513
    IDC_WAIT = 32514
    IDC_CROSS = 32515
    IDC_UPARROW = 32516
    IDC_SIZE = 32640
    IDC_ICON = 32641
    IDC_SIZENWSE = 32642
    IDC_SIZENESW = 32643
    IDC_SIZEWE = 32644
    IDC_SIZENS = 32645
    IDC_SIZEALL = 32646
    IDC_NO = 32648
    IDC_HAND = 32649
    IDC_APPSTARTING = 32650
End Enum

'Needed for GetCursorInfo
Private Type POINT
    X As Long
    Y As Long
End Type

'Needed for GetCursorInfo
Private Type CursorInfo
    cbSize As Long
    flags As Long
    hCursor As Long
    ptScreenPos As POINT
End Type

'Event that handles knowing when the mouse is over the control
Private Sub Label1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    AddCursor IDC_HAND
End Sub

'To set a cursor
Private Function AddCursor(CursorType As CursorTypes)
    If Not IsCursorType(CursorType) Then
        SetCursor LoadCursor(0, CursorType)
        Sleep 200 ' wait a bit, needed for rendering
    End If
End Function

'To determine if the cursor is already set
Private Function IsCursorType(CursorType As CursorTypes) As Boolean
    Dim CursorHandle As Long: CursorHandle = LoadCursor(ByVal 0&, CursorType)
    Dim Cursor As CursorInfo: Cursor.cbSize = Len(Cursor)
    Dim CursorInfo As Boolean: CursorInfo = GetCursorInfo(Cursor)

    If Not CursorInfo Then
        IsCursorType = False
        Exit Function
    End If

    IsCursorType = (Cursor.hCursor = CursorHandle)
End Function
...