Часто помимо работы с клавиатурой приложение должно уметь работать и с мышью. В этом учебнике мы рассмотрим два способа работы с мышью. Первый из них мало отличается от рассмотренного в предыдущей части учебника, а второй использует буферизированные данные.
Начнём с нескольких объявлений:
Dim DX As New DirectX8 'объект DirectX
Dim DI As DirectInput8 'объект DirectInput
Dim diDev As DirectInputDevice8 ' устройство DirectInput
Dim diState As DIMOUSESTATE 'структура для хранения состояния мыши
Функция, инициализирующая DirectInput будет такой:
Public Function InitDI() As Boolean
Set DI = DX.DirectInputCreate
If DI Is Nothing Then Exit Function
Set diDev = DI.CreateDevice("guid_SysMouse")
If diDev Is Nothing Then Exit Function
diDev.SetCommonDataFormat DIFORMAT_MOUSE
diDev.SetCooperativeLevel Me.hWnd, DISCL_NONEXCLUSIVE Or DISCL_BACKGROUND
diDev.Acquire
InitDI = True
End Function
Для создания устройства, при помощи которого мы будем получать данные о состоянии мыши был использован метод CreateDevice объекта DirectInput с параметром "guid_SysMouse". Затем устанавливается формат данных устройства; так как мы будем работать с мышью, используется константа DIFORMAT_MOUSE. Метод SetCooperativeLevel "присоединяет" устройство к форме, а также устанавливает неэксклюзивный и фоновый режим доступа к устройству. В конце функции для получения доступа к устройству используется метод Acquire.
Теперь в любой момент мы можем получить информацию о текущем состоянии мыши. В данном примере это делается в обработчике события Timer объекта Timer1:
Private Sub Timer1_Timer()
'текущее сотояние мыши помещается
'в структуру diState
diDev.GetDeviceStateMouse diState
Label1.BackColor = &H8000000F
Label2.BackColor = &H8000000F
Label3.BackColor = &H8000000F
'Если нажата какая-то кнопка мыши, то
'соответствующая метка окрашивается в
'красный цвет
'Левая кнопка мыши
If diState.Buttons(0) <> 0 Then Label1.BackColor = vbRed
'Правая конпка мыши
If diState.Buttons(1) <> 0 Then Label2.BackColor = vbRed
'Средняя кнопка мыши (если её нет -
'то соответствующий элемент в массиве
'всегда равен нулю)
If diState.Buttons(2) <> 0 Then Label3.BackColor = vbRed
'В элементы управления Label7-9
'помещается информация о сдвиге
'мыши вдоль соответствующих осей
Label7.Caption = diState.lX
Label8.Caption = diState.lY
Label9.Caption = diState.lZ
'обычно ось Z соответствует вращения колёсика
'если его нет - lZ всегда равно нулю
End Sub
Скачать готовый VB-проект в RAR-архиве(3 Кб).
DirectInput поддерживает два вида данных: немедленные (immediate) и буферизированные (buffered). Ранее мы пользовались немедленными данными, т. е. получали состояние устройства в данный момент времени. Буферизированные данные - это запись событий, произошедших с тех пор, как приложение последний раз обращалось к устройству. В большинстве приложений используются немедленные данные, однако, иногда предпочтительно использовать буферизированные данные (например, при отслеживании передвижений мыши по экрану).
Сделайте следующие объявления:
Dim DX As New DirectX8
Dim DI As DirectInput8
Dim diDev As DirectInputDevice8
Const BufferSize = 50 'размер буфера
'массив, который будет заполнятся
'данными из буфера
Dim diDeviceData(1 To BufferSize) As DIDEVICEOBJECTDATA
Инициализация DirectInput будет проходить следующим образом:
Public Function InitDI() As Boolean
On Error Resume Next
Set DI = DX.DirectInputCreate
If DI Is Nothing Then Exit Function
Set diDev = DI.CreateDevice("guid_SysMouse")
If diDev Is Nothing Then Exit Function
diDev.SetCommonDataFormat DIFORMAT_MOUSE
diDev.SetCooperativeLevel Me.hWnd, DISCL_BACKGROUND Or DISCL_NONEXCLUSIVE
'вспомогательная структура для задания
'размера буффера
Dim diProp As DIPROPLONG
diProp.lHow = DIPH_DEVICE
diProp.lObj = 0
diProp.lData = BufferSize
diDev.SetProperty "DIPROP_BUFFERSIZE", diProp
diDev.Acquire
InitDI = True
End Function
Задание размера буфера происходит с помощью метода SetProperty устройства DirectInput, первый параметр которого - "DIPROP_BUFFERSIZE" (второй параметр имеет тип DIPROPLONG). Задание размеров буфера должно происходить перед тем, как вызывается метод Acquire. Следует также обратить внимание на то, чтобы размер буфера был достаточно большим, иначе может произойти ошибка переполнения буфера (его размер должен быть тем больше, чем реже к нему обращаются).
Как и в прошлый раз, получение информации о состоянии устройства происходит в обработчике события Timer объекта Timer1.
Private Sub Timer1_Timer()
List1.Clear
Dim NumItems As Integer
Dim i As Integer
On Error GoTo diError
NumItems = diDev.GetDeviceData(diDeviceData, DIGDD_DEFAULT)
For i = 1 To NumItems
Select Case diDeviceData(i).lOfs
Case DIMOFS_BUTTON0
If diDeviceData(i).lData <> 0 Then
List1.AddItem "Нажата левая кнопка мыши"
Else
List1.AddItem "Отпущена левая кнопка мыши"
End If
Case DIMOFS_BUTTON1
If diDeviceData(i).lData <> 0 Then
List1.AddItem "Нажата правая кнопка мыши"
Else
List1.AddItem "Отпущена правая кнопка мыши"
End If
Case DIMOFS_X
List1.AddItem "Сдвиг вдоль оси X:" & Str(diDeviceData(i).lData)
Case DIMOFS_Y
List1.AddItem "Сдвиг вдоль оси Y:" & Str(diDeviceData(i).lData)
Case DIMOFS_Z
List1.AddItem "Сдвиг вдоль оси Z:" & Str(diDeviceData(i).lData)
End Select
Next i
Exit Sub
diError:
MsgBox "Input error."
End Sub
Каждый раз, когда срабатывает таймер, в список List1 выводится информация о событиях, прошедших со времени его предыдущего срабатывания.
Информация из буфера записывается в массив, каждый из элементов которого имеет тип DIDEVICEOBJECTDATA. Его член lOfs содержит тип произошедшего события, а в lData содержится информация о параметрах этого события. Если lOfs принимает одно из значений DIMOFS_BUTTON0 или DIMOFS_BUTTON1 - значит была нажата (lData = 128) или отпущена (lData = 0) соответствующая кнопка мыши. Если lOfs равно DIMOFS_X, DIMOFS_Y или DIMOFS_Z, то в lData находится число пикселей, на которое сдвинулась мышь вдоль соответствующей оси. Аналогично в случае работы с клавиатурой lOfs принимает значение одной из констант набора CONST_DIKEYFLAGS.
Скачать готовый VB-проект в RAR-архиве (2 Кб).