Direct Input в VB
Direct Input, как все уже догадались, нужен дляработы с устройствами ввода, например с клавиатурой и мышкой. Почему нельзяобойтись стандартными средствами Visual Basic? Потому что вы не сможетеобрабатывать одновременно 5 нажатых клавиш. Например когда вы играете вкакую-нибудь игру, вы, к примеру, бежите вперёд, одновременно заворачиваетенаправо и стреляете. Такое сделать чисто на VB нельзя. Поэтому мы используемDirectX.В этой статье мы сделаем небольшую программу, котораяпродемонстрирует работу Direct Input. Для начала создаём новый проэкт.Изменяем свойство ScaleMode формы на "3 - Pixel". Теперь помещаем на форму 2Label"а рядом в верхней части формы и 1 PictuteBox в её центре. Именаобъектов оставьте по умолчанию. Должно получиться примерно так:
Теперь приступим к написанию кода программы. Чтобыработать с DirectX"ом, подключите файл dx8vb.dll (dx7vb.dll для 7-ого DirectX"а).Теперь создайте модуль. В нем напишем:
Option Explicit
Global DirectX As New DirectX8
Global Working As Boolean
Global DirectInput As DirectInput8
Global DirectInputDevice As DirectInputDevice8
Global DirectInputState As DIKEYBOARDSTATE
Здесь мы сначала создали объект DirectX, а затем переменныетипа DirectInput8, DirectInputDevice8 и DIKEYBOARDSTATE. Поскольку наша программабудет состоять из цикла, то переменная Working нужна для выхода их программы. Теперьначинаем писать функции. Сначала напишем функцию, которая создаёт объекты на основесозданных выше переменных.
Создаём объект DirectInput:
Sub DX8CreateKeyboard(HWnd As Integer)
Set DirectInput = DirectX.DirectInputCreate()
Теперь создаём устройство клавиатуры и устанавливаем формат приходящейинформации мультииспользование (все программы могут использовать клавиатуру).
Set DirectInputDevice = DirectInput.CreateDevice("GUID_SysKeyboard")
DirectInputDevice.SetCommonDataFormat DIFORMAT_KEYBOARD
DirectInputDevice.SetCooperativeLevel HWnd, DISCL_BACKGROUND Or DISCL_NONEXCLUSIVE
DirectInputDevice.Acquire
End Sub
Теперь функция для удаления объектов из памяти:
Sub DX8DestroyKeyboard()
Set DirectInput = Empty
Set DirectInputDevice = Empty
End Sub
А теперь функция, ради которой мы и создавали 2 последние:
Function DX8GetKeyState(ByVal KeyNumber As Integer) As Boolean
DirectInputDevice.GetDeviceStateKeyboard DirectInputState
DX8GetKeyState = DirectInputState.Key(KeyNumber)
End Function
Эта функция возвращает True или False в зависимости от того, нажатали клавиша, код которой мы передали в качестве параметра функции. Этикоды клавиш не совпадают с ascii кодами. Чтобы определить код клавиш,можно написать такой код в Form_Load:
Private Sub Form_Load()
DX8CreateKeyboard Me.HWnd
Dim K As Integer
Me.Show
Do
For K = 0 to 255
If DX8GetKeyState(K) = True Then
Label1 = K
End If
Next K
DoEvents
Loop
End Sub
Если вы испытаете эту программу, то увидмте что у стрелки вверхкод развен 200, вниз - 208, влево - 203, а вправо - 205. Но это не цель нашейпрограммы. Нам нужно, чтобы можно было нажимать сразу несколько кнопок. Для этогоИзменяем Form_Load на этот:
Private Sub Form_Load()
DX8CreateKeyboard Me.HWnd
Me.Show
Working = True
Do
If DX8GetKeyState(200) = True Then
Label1 = "200"
Picture1.Top = Picture1.Top - 1
End If
If DX8GetKeyState(208) = True Then
Label1 = "208"
Picture1.Top = Picture1.Top + 1
End If
If DX8GetKeyState(203) = True Then
Label1 = "203"
Picture1.Left = Picture1.Left - 1
End If
If DX8GetKeyState(205) = True Then
Label1 = "205"
Picture1.Left = Picture1.Left + 1
End If
If DX8GetKeyState(157) = True Then
Label1 = "157"
Picture1.BackColor = RGB(255, 0, 0)
End If
If DX8GetKeyState(157) = False Then
Picture1.BackColor = RGB(192, 192, 192)
End If
Label2 = "X: " & Picture1.Left & _
"; Y: " & Picture1.Top
DoEvents
If Working = False Then Exit Do
Loop
DX8DestroyKeyboard
End Sub
Сначала мы создаём Direct Input вызовом функции DX8CreateKeyboard,затем показываем форму и присваиваем значение True переменной Working. Далееначинается цикл, в котором мы наблюдаем за стрелками на клавиатуре и кнопкой Ctrl.При нажатии/отжатии кнопок, меняются свойства Picture1. Теперь программа дляForm_Unload:
Private Sub Form_Unload(Cancel As Integer)
Working = False
End Sub
Тут и объяснять не надо.
Работающая программа должна выглядеть как на рисунке:
Вот в принципе и всё. Исходники можно скачать сэтой страницы.