DirectInput Tutorial

Автор: Jack Hackslay


Обзор DirectInput

Клавиатура- Мышка- Джойстик

Direct Input дает вам доступ ко всем устройствам ввода, подключенным к системе пользователя. В Visual Basic вы можете использовать эти четыре устройства:

Клавиатура

Ну......

 Мышка

А почему бы и нет

 Джойстик

???

Force-Feedback

Стоит на Play Station

Я не могу дать учебник по использованию Force Feedback вот почему:

a: Трудновато
b: Вам понадобятся специальные программы
c: Нету его у меня

Как вы знаете, в Visual Basic встроены функции обработки мыши и клавиатуры через события Form_KeyPress, Form_KeyDown, Form_KeyUp, Form_MouseMove, Form_MouseUp, Form_MouseDown
Код, который мы будем писать для DirectInput будет практически такой же, что обычно используется в этих событиях.

К джойстику можно подступиться через API, но DirectInput проще, хотя функции почти идентичны.


Клавиатура

Мышка- Джойстик - Обзор

Было бы хорошо, если бы вы знали каким образом обрабатывается клавиатура в VB, но на всякий случай я еще раз по этому пробегусь. Каждый символ на клавиатуре имеет свой номер, вы можете узнать, какая клавиша нажата, рассматривая значение, возвращенное специальной функцией. Если значение = 0, тогда ничего не нажали, если больше нуля, значит нажата какая-то клавиша.
Список клавиш можно загрузить здесь .

Давайте начнем создавать программу.
Создайте новый проект и добавьте к нему библиотеку DX7, затем можете копировать следующий код в нужные места.

Также, вам понадобится пустая форма с таймером на ней, названным tmrKey. Все значения для него устанавливаются в коде, так что не волнуйтесь на этот счет.

'(DECLARATIONS)
Dim dx As New DirectX7
Dim di As DirectInput
Dim diDEV As DirectInputDevice
Dim diState As DIKEYBOARDSTATE 'Эта структура содержит состояние клавиатуры.
Dim iKeyCounter As Integer
                            'Далее следует почти стандартная процедура создания объектов DX.
                            'Если вы знакомы с DirectDraw, вам будет все понятно

Private Sub Form_Load()
    Set di = dx.DirectInputCreate()
    If Err.Number <> 0 Then 'Если значение 0, значит ошибки нет
        MsgBox "Error starting Direct Input, please make sure you have DirectX installed", vbApplicationModal
        End
    End If

    Set diDEV = di.CreateDevice("GUID_SysKeyboard") 'Attach it to the Keyboard

    diDEV.SetCommonDataFormat DIFORMAT_KEYBOARD
    diDEV.SetCooperativeLevel Me.hWnd, DISCL_BACKGROUND Or DISCL_NONEXCLUSIVE 'Пусть другие приложения тоже могут использоват клавиатуру

    Me.Show

    diDEV.Acquire  'Эта строка переводит все значения из DirectX в Visual Basic 

    tmrKey.Interval = 10 'Это сенс клавиатуры. Большое преимущество DI в том, что вы сами можете устанавливать
'Скорость повтора, независимо от установок Windows

    tmrKey.Enabled = True 'Пускаем Таймер
End Sub

Private Sub Form_Unload(Cancel As Integer)
    diDEV.Unacquire 'Уходя, гасите всех
End Sub

Private Sub tmrKey_Timer()
    diDEV.GetDeviceStateKeyboard diState 'Структура diState держит состояния всех клавиш

    For iKeyCounter = 0 To 255 'Пройтись по всем значениям и посмотреть, не нажали ли чего?..........
        If diState.Key(iKeyCounter) <> 0 Then 'Если не ноль, тогда напечатаем его........
            Form1.Caption = iKeyCounter & " - This Key Was pressed" 'Используем Caption формы
        End If
    Next
    DoEvents  'Очень ОЧЕНЬ важно! Надо дать DirectX время обработать то, о чем вы его просили, иначе произойдет сбой
End Sub

Вы можете изменять код Таймера, чтобы в цикле применять логические операторы If...Then....End If  Для того чтобы обрабатывать нужные вам клавиши

Например:

'Как видите, можно обрабатывать одновременное нажатие многих клавиш, чего не позволяет VB!!!

Private Sub tmrKey_Timer()
    diDEV.GetDeviceStateKeyboard diState 'Структура diState держит состояния всех клавиш

If diState.Key(200)<>0 then
     'Do Code Here
End If
If diState.Key(201)<>0 then
     'Do Code Here
End If
If diState.Key(202)<>0 then
     'Do Code Here
End If
    DoEvents  'Очень ОЧЕНЬ важно! Надо дать DirectX время обработать то, о чем вы его просили, иначе произойдет сбой .
End Sub

Спасибо, что прочитали мое Очень Простое Клавиатурное Руководство. Вы можете загрузить готовый проект прямо сейчас.


Мышка

Джойстик- Обзор- Клавиатура

Мышиная обработка довольно запутанна. Я использую ее только для случаев, когда необходим дополнительный контроль. Если вы хотите только вычислять позиции мыши, лучше используйте Form_MouseMove.

Однако, я все же освещу обработку мыши для самых любопытных. Это пример простой программы, которая рисует линии в зависимости от местоположения курсора мыши.

Создайте новый проект с подключенной библиотекой DX7. Добавьте к проекту модуль и сделайте стартовым объектом "Sub_Main"

Переименуйте форму в frmCanvas, сделайте ее фон белым и добавьте в верхний левый угол объект Image, который назовите imgPencil. Выберите подходящую иконку из коллекции VB и загрузите ее в Image.

Меню:

Нам понадобится меню в проекте. Я подразумеваю, что вы знаете, как добавлять меню, если нет - идите и учите руководство пользователя. Используйте эту схему для создания меню. Сначала указываются названия (Caption), а имена (Name) идут в скобках.

 

none (mnuContext) - NOTE: уберите флаг visible
---Speed 1 (mnuSpeed1)
---Speed 2 (mnuSpeed2)
---Speed 3 (mnuSpeed3)
--- - (sep2)
---Clear (mnuClear)
--- - (sep3)
--- Release Mouse (mnuSuspend)

Теперь, поместите этот код в МОДУЛЬ!

'(DECARATIONS)
Option Explicit

Public objDX As New DirectX7
Public objDXEvent As DirectXEvent
Public objDI As DirectInput
Public objDIDev As DirectInputDevice

Public g_cursorx As Long
Public g_cursory As Long
Public g_Sensitivity
Public Const BufferSize = 10

Public EventHandle As Long
Public Drawing As Boolean
Public Suspended As Boolean

Public procOld As Long

' Windows API declares and constants

Public Const GWL_WNDPROC = (-4)
Public Const WM_ENTERMENULOOP = &H211
Public Const WM_EXITMENULOOP = &H212
Public Const WM_SYSCOMMAND = &H112

Public Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Public Declare Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long
Public Declare Function ScreenToClient Lib "user32" (ByVal hWnd As Long, lpPoint As POINTAPI) As Long
Public Declare Function ClientToScreen Lib "user32" (ByVal hWnd As Long, lpPoint As POINTAPI) As Long
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Public Type POINTAPI
        x As Long
        y As Long
End Type
 

Sub Main()

  ' Показать сначала главную форму, чтобы мы могли использовать ее Handle.
  frmCanvas.Show
  .
  procOld = SetWindowLong(frmCanvas.hWnd, GWL_WNDPROC, AddressOf SysMenuProc)

  ' Инициализируем наш курсор
  g_cursorx = frmCanvas.ScaleWidth \ 2
  g_cursory = frmCanvas.ScaleHeight \ 2
  g_Sensitivity = 2
  frmCanvas.mnuSpeed2.Checked = True
 
  ' Создать DirectInput и установить мышь
  Set objDI = objDX.DirectInputCreate
  Set objDIDev = objDI.CreateDevice("guid_SysMouse")
  Call objDIDev.SetCommonDataFormat(DIFORMAT_MOUSE)
  Call objDIDev.SetCooperativeLevel(frmCanvas.hWnd, DISCL_FOREGROUND Or DISCL_EXCLUSIVE)
 
  ' Установить размер буфера
  Dim diProp As DIPROPLONG
  diProp.lHow = DIPH_DEVICE
  diProp.lObj = 0
  diProp.lData = BufferSize
  diProp.lSize = Len(diProp)
  Call objDIDev.SetProperty("DIPROP_BUFFERSIZE", diProp)

  ' Спросить об уведомлениях
 
  EventHandle = objDX.CreateEvent(frmCanvas)
  Call objDIDev.SetEventNotification(EventHandle)
 
  ' Включить мышь
  frmCanvas.AcquireMouse
 
End Sub
 

Public Function SysMenuProc(ByVal hWnd As Long, ByVal iMsg As Long, _
        ByVal wParam As Long, ByVal lParam As Long) As Long

' Эта процедура интерпретирует сообщения Windows и смотрит за теми, по которым
'надо выключить мышь

  If iMsg = WM_ENTERMENULOOP Then
    objDIDev.Unacquire
    frmCanvas.SetSystemCursor
  End If
 
  ' Вызов процедуры окна
  SysMenuProc = CallWindowProc(procOld, hWnd, iMsg, wParam, lParam)

End Function

Сохраните модуль, затем добавьте этот код в модуль кода ФОРМЫ:

'(DECLARATIONS)
Option Explicit
Implements DirectXEvent 'Вы заметите, что новый объект появится в первом списке окна кода

Sub AcquireMouse()
  Dim CursorPoint As POINTAPI
 
  ' Переместить наш курсор в позицию системного.
  Call GetCursorPos(CursorPoint)  ' Получить позицию перед тем, как Windows потеряет курсор
  Call ScreenToClient(hWnd, CursorPoint)
 
  On Error GoTo CANNOTACQUIRE
  objDIDev.Acquire
  g_cursorx = CursorPoint.x
  g_cursory = CursorPoint.y

  UpdateCursor
  frmCanvas.imgPencil.Visible = True
  On Error GoTo 0
  Exit Sub
CANNOTACQUIRE:
  Exit Sub
End Sub

Public Sub Popup()
  objDIDev.Unacquire
  SetSystemCursor
  Call PopupMenu(mnuContext) 'Всплывающее меню появится в координатах курсора
End Sub

Public Sub SetSystemCursor()
 'Поставить системный курсор в ту же позицию, что наш курсор и прекратить рисовать
  Dim point As POINTAPI
  imgPencil.Visible = False
  Drawing = False
  point.x = g_cursorx
  point.y = g_cursory
  Call ClientToScreen(hWnd, point)
  Call SetCursorPos(point.x, point.y)
End Sub

Public Sub UpdateCursor()
  ' Обновить позицию нашего курсора

  If g_cursorx < 0 Then g_cursorx = 0
  If g_cursorx >= frmCanvas.ScaleWidth Then g_cursorx = frmCanvas.ScaleWidth - 1
  If g_cursory < 0 Then g_cursory = 0
  If g_cursory >= frmCanvas.ScaleHeight Then g_cursory = frmCanvas.ScaleHeight - 1
  frmCanvas.imgPencil.Left = g_cursorx
  frmCanvas.imgPencil.Top = g_cursory
  If Drawing Then
    Line -(g_cursorx, g_cursory)
  End If
End Sub

Private Sub DirectXEvent_DXCallback(ByVal eventid As Long)

' Здесь мы распознаем изменения в положении мыши. Обычно это движение по осям
' или нажатие или отпускание кнопки, но это может также означать "потерю" мыши.
' Note: нет события, означающего потерю мыши. Обычно потеря мыши означает,
' что окно приложения потеряло фокус

  Dim diDeviceData(1 To BufferSize) As DIDEVICEOBJECTDATA
  Dim NumItems As Integer
  Dim i As Integer
  Static OldSequence As Long
 
  ' Получить данные 
  On Error GoTo INPUTLOST
  NumItems = objDIDev.GetDeviceData(diDeviceData, 0)
  On Error GoTo 0
 
  ' Обработать данные
  For i = 1 To NumItems
    Select Case diDeviceData(i).lOfs
      Case DIMOFS_X
        g_cursorx = g_cursorx + diDeviceData(i).lData * g_Sensitivity
 
 
        If OldSequence <> diDeviceData(i).lSequence Then
          UpdateCursor
          OldSequence = diDeviceData(i).lSequence
        Else
          OldSequence = 0
        End If
 
      Case DIMOFS_Y
        g_cursory = g_cursory + diDeviceData(i).lData * g_Sensitivity
        If OldSequence <> diDeviceData(i).lSequence Then
          UpdateCursor
          OldSequence = diDeviceData(i).lSequence
        Else
          OldSequence = 0
        End If
 
      Case DIMOFS_BUTTON0
        If diDeviceData(i).lData And &H80 Then
          Drawing = True
 
          'Сохрянять запись для функции Line
          CurrentX = g_cursorx
          CurrentY = g_cursory
 
          'Рисовать точку в случае события Button-Up
 
          PSet (g_cursorx, g_cursory)
        Else
          Drawing = False
        End If
 
      Case DIMOFS_BUTTON1
        If diDeviceData(i).lData = 0 Then  ' button up
          Popup
        End If
 
    End Select
  Next i
  Exit Sub
INPUTLOST:
' Windows украл у нас мышь.  Произошло DIERR_INPUTLOST , если пользователь переключился
' на другое приложение, но DIERR_NOTACQUIRED  произошло, если нажата кнопка Windows

  If (Err.Number = DIERR_INPUTLOST) Or (Err.Number = DIERR_NOTACQUIRED) Then
    SetSystemCursor
    Exit Sub
  End If 
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
  Select Case KeyCode
    Case 93         'Кнопка AppMenu
      Popup 'Покажем меню
    End Select
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
  Dim didevstate As DIMOUSESTATE
  'Мы хотим переопределения мыши, когда контекстное меню звкрыто, когда мы переключились
  'назад в приложение, или в других случаях, когда системный курсор более не нужен.
  'Если произошло событие MouseMove, мы знаем, что курсор находится в нашем приложении
  'и Windows генерирует мышиные сообщения, тогда настало время для переопределения.
  'Note: этот флаг меняется, когда окно получает мышь, даже если не было мышиной активности
  ' - например, если мы переключились в окно по Alt-Tab, или отменили контекстное меню
  'клавишей Esc.
   If Suspended Then Exit Sub    'Продолжить использование курсора Windows
  'Это событие вызывается снова, как только мы включили мышь. Чтобы предотвратить
  'установку курсора в центр окна, мы проверяем, а вдруг мышь уже включена, и если так, мы не
  'репозиционируем наш курсор. Единственный способ проверить, включена ли мышь -
  'получить данные 

  On Error GoTo NOTYETACQUIRED
  Call objDIDev.GetDeviceStateMouse(didevstate)
  On Error GoTo 0
  Exit Sub
NOTYETACQUIRED:
  Call AcquireMouse
End Sub

Private Sub Form_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
  ' Позволить отмену щелканьем на полотне

  If Button = 1 Then Suspended = False
End Sub

Private Sub Form_Unload(Cancel As Integer)
  If procOld <> 0 Then
    Call SetWindowLong(hWnd, GWL_WNDPROC, procOld)
  End If
  If EventHandle <> 0 Then objDX.DestroyEvent EventHandle
End Sub

Private Sub mnuClear_Click()
   Cls
End Sub

Private Sub mnuSpeed1_Click()
  g_Sensitivity = 1
  mnuSpeed1.Checked = True
  mnuSpeed2.Checked = False
  mnuSpeed3.Checked = False
End Sub

Private Sub mnuSpeed2_Click()
  g_Sensitivity = 2
  mnuSpeed2.Checked = True
  mnuSpeed1.Checked = False
  mnuSpeed3.Checked = False
End Sub

Private Sub mnuSpeed3_Click()
  g_Sensitivity = 3
  mnuSpeed3.Checked = True
  mnuSpeed1.Checked = False
  mnuSpeed2.Checked = False
End Sub

Private Sub mnuSuspend_Click()
  Suspended = Not Suspended
  imgPencil.Visible = Not Suspended
End Sub

Ну вот!
Когда вы запустите программу, мышь должна быть "поймана" внутри окна. Курсор должен быть в виде иконки, которую вы выбрали и когда вы удержите левую кнопку мыши, должна рисоваться черная линия, а когда вы щелкните правой кнопкой, должно появляться маленькое всплывающее меню.

Вы можете загрузить готовый проект.


Джойстик

Обзор- Клавиатура- Мышь

Команды обработки джойстика возвращают количество джойстиков в системе, значения X & Y, а также статус каждой кнопки джойстика.

В этом учебнике я покажу вам программу с тремя списками. Первый перечисляет доступные устройства, второй значения X и Y, третий перечисляет все кнопки.

Откройте Visual Basic, создайте новый проект и добавьте нужную DLL.

На форму добавьте 3 списка:
1 - lstJoySticks
2 - lstJoyAxis
3 - lstButton

Затем, скопируйте код в соответствующие секции. Все поясняется, поэтому не должно быть очень сложно для понимания:


'(DECLARATIONS)
Option Explicit
Implements DirectXEvent    'Здесь проверяется информация джойстика

Dim dx As New DirectX7   'Главный объект DirectX 
Dim di As DirectInput     ' Объект DirectInput, позже будет создан из объекта DirectX
Dim diDev As DirectInputDevice  'Представляет джойстик
Dim diDevEnum As DirectInputEnumDevices  'Перечисляет доступные устройства
Dim EventHandle As Long   'Содержит события
Dim joyCaps As DIDEVCAPS  'Держит информацию о джойстике
Dim js As DIJOYSTATE 
Dim DiProp_Dead As DIPROPLONG
Dim DiProp_Range As DIPROPRANGE
Dim DiProp_Saturation As DIPROPLONG
Dim AxisPresent(1 To 8) As Boolean
Dim running As Boolean    'Программа еще живая?

Sub CLRLISTS()    'Маленькая процедура для очистки всего, чего можно
    lstJoyAxis.Clear
    lstButton.Clear
End Sub

Sub IdentifyAxes(diDev As DirectInputDevice)
'Эта процедура узнает, сколько присутствует осей, например: 
    'Верх - Низ
    'Лево - Право
    'Диагонали
   ' Недостаточно перечислить оси, нам надо знать какие части присутствуют    .
   Dim didoEnum As DirectInputEnumDeviceObjects
   Dim dido As DirectInputDeviceObjectInstance
   Dim i As Integer
   For i = 1 To 8
     AxisPresent(i) = False
   Next
   ' Перечислить оси
   Set didoEnum = diDev.GetDeviceObjectsEnum(DIDFT_AXIS)
   'Проверить данные для каждой оси, чтобы узнать каждую из них
   For i = 1 To didoEnum.GetCount
     Set dido = didoEnum.GetItem(i)
         Select Case dido.GetOfs
            Case DIJOFS_X
              AxisPresent(1) = True
            Case DIJOFS_Y
              AxisPresent(2) = True
            Case DIJOFS_Z
              AxisPresent(3) = True
            Case DIJOFS_RX
              AxisPresent(4) = True
            Case DIJOFS_RY
              AxisPresent(5) = True
            Case DIJOFS_RZ
              AxisPresent(6) = True
            Case DIJOFS_SLIDER0
              AxisPresent(7) = True
            Case DIJOFS_SLIDER1
              AxisPresent(8) = True
         End Select
   Next
End Sub

Sub InitDirectInput()

    Set di = dx.DirectInputCreate()  'Создать DI из DX. Это надо сделать перед всем остальным
    Set diDevEnum = di.GetDIEnumDevices(DIDEVTYPE_JOYSTICK, DIEDFL_ATTACHEDONLY)  'Какие типы джойстиков распознавать
    If diDevEnum.GetCount = 0 Then  'Если нет джойстиков, уведомить пользователя
      MsgBox "No joystick attached."
      Unload Me
    End If

    'Добавить подключенные джойстики в список
    Dim i As Integer
    For i = 1 To diDevEnum.GetCount
        Call lstJoySticks.AddItem(diDevEnum.GetItem(i).GetInstanceName) 'Здесь перечисляются все устройства 
    Next

    'Получить handle события, чтобы ассоциировать его с устройстом 
    EventHandle = dx.CreateEvent(Me)  'Создать событие для DirectX.
    'Событие происходит когда что-нибудь случается, например пользователь нажмет
    'кнопку. Мы используем это чтобы решить что делать, когда получаем соответсвующее
    'событие - идти быстрее/стрелять/идти влево...

    Exit Sub

Error_Out:
    MsgBox "Error initializing DirectInput."  'Происходит, когда у пользователя нет DX7, или что-то у него криво с системой
    Unload Me
End Sub

Sub SetProp()
    ' Установить пределы для всех осей
    'По X - от 0 до 10000 (лево-право)
    'По Y - от 0 до 10000 (верх-низ)

    With DiProp_Range
        .lHow = DIPH_DEVICE
        .lSize = Len(DiProp_Range)
        .lMin = 0
        .lMax = 10000
    End With
    diDev.SetProperty "DIPROP_RANGE", DiProp_Range
End Sub

Private Sub DirectXEvent_DXCallback(ByVal eventid As Long)
' Вызывается, когда меняется состояние джойстика
'Мы проверяем новое состояние и обновляем отображение
'Сначала получаем позиции, затем - состояния кнопок

    Dim i As Integer
    Dim ListPos As Integer
    Dim S As String 
    If diDev Is Nothing Then Exit Sub 'Если небыло инициализации, выходим

    'Получить инфо об устройстве
    On Local Error Resume Next
    diDev.GetDeviceStateJoystick js
    If Err.Number = DIERR_NOTACQUIRED Or Err.Number = DIERR_INPUTLOST Then
        diDev.Acquire 'При включении, DirectX передает всю информацию переменным внутри VB.
        Exit Sub
    End If 
    On Error GoTo err_out

    'Отобразить осевые координаты
    ListPos = 0
    For i = 1 To 8
        If AxisPresent(i) Then
           Select Case i
               Case 1
                   S = "X: " & js.x  'Вызов js.x вернет координату.
               Case 2
                   S = "Y: " & js.y
               Case 3
                   S = "Z: " & js.z
               Case 4
                   S = "RX: " & js.rx
               Case 5
                   S = "RY: " & js.ry
               Case 6
                   S = "RZ: " & js.rz
               Case 7
                   S = "Slider0: " & js.slider(0)
               Case 8
                   S = "Slider1: " & js.slider(1) 
           End Select
           lstJoyAxis.List(ListPos) = S 'Добавить переменную в список - теперь юзер все увидит            ListPos = ListPos + 1

        End If
     Next 
    ' Кнопки
    For i = 0 To joyCaps.lButtons - 1
        Select Case js.buttons(i)
        Case 0
            lstButton.List(i) = "Button " + CStr(i + 1) + ": Up" 'Говорим юзеру о состоянии кнопок

        Case Else
            lstButton.List(i) = "Button " + CStr(i + 1) + ": Down" 
        End Select
    Next 
    Me.Caption = "Joystick Sample: Available"
    Exit Sub 
err_out:
    MsgBox Err.Description & " : " & Err.Number, vbApplicationModal 'Возвращаем сообщение об ошибке
    End
End Sub

Private Sub Form_Load()  
    running = True 'Внутренняя переменная
    InitDirectInput 'С этого все начинается.
End Sub

Private Sub Form_Unload(cancel As Integer)
        If EventHandle <> 0 Then dx.DestroyEvent EventHandle 'Вы должны все уничтожить.
        running = False
        DoEvents
        End
End Sub

Private Sub lstJoySticks_Click() 'Происходит, когда пользователь выбирает новый джойстик из списка 
    On Local Error Resume Next
    Call CLRLISTS  'Очистить список перед тем, как добавим в него новые значения
    'Создать "joystick device"
    Set diDev = Nothing 'Очистить старые данные перед помещением новых
    Set diDev = di.CreateDevice(diDevEnum.GetItem(lstJoySticks.ListIndex + 1).GetGuidInstance)
    diDev.SetCommonDataFormat DIFORMAT_JOYSTICK
    diDev.SetCooperativeLevel Me.hWnd, DISCL_BACKGROUND Or DISCL_NONEXCLUSIVE
    'THE COOPERATIVELEVEL: указывает, как ваша программа использует ресурсы, делясь ими
    'с другими приложениями или использует только сама.
    ' Если делится, то ищем какой объект устройства их имеет
    diDev.GetCapabilities joyCaps
    Call IdentifyAxes(diDev)

    'Спросим об событии
    Call diDev.SetEventNotification(EventHandle)

    'Установить "мертвую зону" для осей X и Y в 10% от возвожного перемещения
    With DiProp_Dead
        .lData = 1000
        .lObj = DIJOFS_X
        .lSize = Len(DiProp_Dead)
        .lHow = DIPH_BYOFFSET
        .lObj = DIJOFS_X
        diDev.SetProperty "DIPROP_DEADZONE", DiProp_Dead
        .lObj = DIJOFS_Y
        diDev.SetProperty "DIPROP_DEADZONE", DiProp_Dead
    End With

    'Установить "светлую зону" в 5%
    With DiProp_Saturation
        .lData = 9500
        .lHow = DIPH_BYOFFSET
        .lSize = Len(DiProp_Saturation)
        .lObj = DIJOFS_X
         diDev.SetProperty "DIPROP_SATURATION", DiProp_Saturation
        .lObj = DIJOFS_Y
         diDev.SetProperty "DIPROP_SATURATION", DiProp_Saturation
    End With

    SetProp
 

    diDev.Acquire
    Me.Caption = "Joystick Sample: Querying Properties"

    'Получить список текущих свойств
    ' USB joysticks не вернет ничего, пока мы не двинем его
    ' поэтому сделаем первый раз это за него
    DirectXEvent_DXCallback 0

    ' Обрабатываем устройство так, чтобы получить события, когда они будут
    ' Обычно делается в главном рисующем цикле игрушек

    While running = True
        DoEvents
        diDev.Poll
    Wend
End Sub

Я могу только обещать, что большая часть этого кода будет работать, потому что у меня есть только ОЧЕНЬ паршивый джойстик. У меня только 2 кнопки и оси X/Y. Если у вас чего-нибудь не работает, дайте мне знать.

(Я вообще ничего обещать не могу, так как джойстика не имею. Поэтому баги фиксить не в состоянии :) Прим. перев.)

Готовый проект тута .

That's it!

Перевод на русский язык (c)2000 Antiloop
Публикуется с разрешения автора.
Полное или частичное цитирование перевода
только с разрешения переводчика. Пишите