Программирование на Visual Basic

01. Используя эту функцию, Вы можете загрузить разные курсоры в окно формы Access. Кусоры меняют форму когда вы управляете мышкой.

' Константы из API интерфейса
Const IDC_ARROW = 32512 'Стрелка
Const IDC_IBEAM = 32513 'Тип - I
Const IDC_WAIT = 32514 'Часы
Const IDC_CROSS = 32515 'Перекрестие
Const IDC_UPARROW = 32516 'Верх
Const IDC_SIZE = 32640 'Размер
Const IDC_ICON = 32641
Const IDC_SIZENWSE = 32642 'Стрелки размеров
Const IDC_SIZENESW = 32643
Const IDC_SIZEWE = 32644
Const IDC_SIZENS = 32645
Const IDC_SIZEALL = 32646
Const IDC_NO = 32648 'Стоп курсор
Const IDC_APPSTARTING = 32650 'Стрелка и часы
Const IDC_HAND = 32649

' Загружает курсор из ресурса
Private Declare Function apiLoadCursorBynum Lib "user32" Alias "LoadCursorA" _
    (ByVal hInstance As Long, _
    ByVal lpCursorName As Long) _
    As Long

' Устанавливает курсор
Private Declare Function apiSetCursor Lib "user32" Alias "SetCursor" _
    (ByVal hCursor As Long) _
    As Long

' Загружает курсор из файла
Private Declare Function apiLoadCursorFromFile Lib "user32" Alias "LoadCursorFromFileA" _
    (ByVal lpFileName As String) _
    As Long

'Указатель на курсор
Dim hCursor As Long

'==============================================================
'  Назначение
'    Загружаем курсор
Private Sub Объекты_AfterUpdate()
    On Error GoTo 999
    Select Case Me.Объекты
        Case 1: 'Указатель
            hCursor = apiLoadCursorBynum(0, IDC_ARROW)
        Case 2: 'Редактор
            hCursor = apiLoadCursorBynum(0, IDC_IBEAM)
        Case 3: 'Часы
            hCursor = apiLoadCursorBynum(0, IDC_WAIT)
        Case 4 'Перекрестие
            hCursor = apiLoadCursorBynum(0, IDC_CROSS)
        Case 5: 'Стрелка вверх
            hCursor = apiLoadCursorBynum(0, IDC_UPARROW)
        Case 6: 'Размер
            hCursor = apiLoadCursorBynum(0, IDC_SIZE)
        Case 7: 'Иконка
            hCursor = apiLoadCursorBynum(0, IDC_ICON)
        Case 8: 'Стрелка
            hCursor = apiLoadCursorBynum(0, IDC_SIZENWSE)
        Case 9 'Стрелка
            hCursor = apiLoadCursorBynum(0, IDC_SIZENESW)
        Case 10 'Стрелка
            hCursor = apiLoadCursorBynum(0, IDC_SIZEWE)
        Case 11 'Стрелка
            hCursor = apiLoadCursorBynum(0, IDC_SIZENS)
        Case 12 'Стрелка
            hCursor = apiLoadCursorBynum(0, IDC_SIZEALL)
        Case 13 'Стоп курсор
            hCursor = apiLoadCursorBynum(0, IDC_NO)
        Case 14 'Старт приложения
            hCursor = apiLoadCursorBynum(0, IDC_APPSTARTING)
        Case 15 'Загрузить из файла
            hCursor = apiLoadCursorFromFile( _
            Application.CurrentProject.Path  _
            "\la_api.cur")
        Case 16 'Рука курсор
            hCursor = apiLoadCursorBynum(0, IDC_HAND)
    End Select
    Exit Sub
999:
    MsgBox Err.Description  'Ошибка
    Err.Clear
End Sub

'  Изменяем курсор
Private Sub Пример_01_MouseMove(Button As Integer, Shift As Integer, x As Single, Y As Single)
   Call apiSetCursor(hCursor)
End Sub