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

 Microsoft Office: 2000,2002,2003,2007,2010  Архив с файлами: Перейти
 Операционная система: Windows XP,Vista  Применение: Базы данных Access
 Продажа: Купить  Файл исходника: ..\Access\16 Модули\API\la_api.mdb
 Язык интерфейса: Русский

   

' Константы из 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 'Перекрестие
            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 'Стрелка
            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

Copyright © 2002-2015 ООО Лидер Эксэсс
Сайт работает под управлением: ASP.NET, Access