Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/room3d/dinput.bas

BASIC Source File | 1999-02-11 | 12.3 KB | 340 lines

Attribute VB_Name = "directInputmodule"
'This module contains procedures for using (initializing) mouse
'and Keyboard with DirectInput
'Taken from the D3DIM C-MATRIX samples (sorry they don't say the author)
Option Explicit
Global directInput As IDirectInputA
Global Keyboarddevice2 As IDirectInputDevice2A
Global KeyboardState(0 To 255) As Byte
Global MouseDevice2 As IDirectInputDevice2A
Global MouseState As DIMOUSESTATE
'This procedure creates a IdirectInputdevice2A for Keyboard
'which you can use in a rendering loop for example
'''''''''''''
'This procedure needs
'An idirectInputObject(existing or non existing)
'An Idirectinputdevice2A
'A form class
Public Function CreateDirectInputKeyboard(directInput As IDirectInputA, KeyboardDirectInputDevice2 As IDirectInputDevice2A, Form As Form) As Long
On Error GoTo err
Dim DirectInputKey As Win32.GUID

Dim Keyboarddidatafotmat As DIDATAFORMAT
Dim Keyboarddirectinputobjectdataformat(0 To 255) As DIOBJECTDATAFORMAT

DirectInputKey.Data1 = &H55728220
DirectInputKey.Data2 = &HD33C
DirectInputKey.Data3 = &H11CF
DirectInputKey.Data4(0) = &HBF
DirectInputKey.Data4(1) = &HC7
DirectInputKey.Data4(2) = &H44
DirectInputKey.Data4(3) = &H45
DirectInputKey.Data4(4) = &H53
DirectInputKey.Data4(5) = &H54
DirectInputKey.Data4(6) = 0
DirectInputKey.Data4(7) = 0
'create the Data format
Dim i As Long
For i = 0 To 255
Keyboarddirectinputobjectdataformat(i).dwOfs = i
Keyboarddirectinputobjectdataformat(i).dwType = &H80000000 + DIDFT_BUTTON + i * 256&
Keyboarddirectinputobjectdataformat(i).dwFlags = &H0
Keyboarddirectinputobjectdataformat(i).pGUID = VarPtr(DirectInputKey)
Next

    ' Keyboard data format

Keyboarddidatafotmat.dwSize = &H18
Keyboarddidatafotmat.dwObjSize = &H10
Keyboarddidatafotmat.dwFlags = 2
Keyboarddidatafotmat.dwDataSize = &H100
Keyboarddidatafotmat.dwNumObjs = &H100
Keyboarddidatafotmat.rgodf = VarPtr(Keyboarddirectinputobjectdataformat(0))
Dim oldnotusedKeyboardDirectInputDevice As IDirectInputDeviceA

'create a Direct Input Object when it's nothing
If directInput Is Nothing Then DirectInputCreateA ByVal App.hInstance, &H500, directInput, Nothing

Dim did As DIDEVICEINSTANCEA
directInput.EnumDevices DIDEVTYPE_KEYBOARD, AddressOf enumdirectinputobjects, did, DIEDFL_ATTACHEDONLY

'create a Keyboard Device
directInput.CreateDevice did.guidInstance, oldnotusedKeyboardDirectInputDevice, Nothing

'create Keyboard Device 2
Set KeyboardDirectInputDevice2 = oldnotusedKeyboardDirectInputDevice

'Set the dataformat to device
KeyboardDirectInputDevice2.SetDataFormat Keyboarddidatafotmat

'set the cooperative Level of device
KeyboardDirectInputDevice2.SetCooperativeLevel Form.hWnd, DISCL_FOREGROUND Or DISCL_NONEXCLUSIVE

'acquires the device
KeyboardDirectInputDevice2.Acquire
'You can use the Keyboard device now as described in the fullscreen version of this sample
Exit Function
err:
CreateDirectInputKeyboard = err.Number
End Function
'This procedure creates a IdirectInputdevice2A for Mouse
'which you can use in a rendering loop for example
'''''''''''''
'This procedure needs
'An IdirectInputObject(existing or non existing)
'An Idirectinputdevice2A
'A form class
Public Function CreateDirectInputMouse(directInput As IDirectInputA, MouseDirectInputDevice2 As IDirectInputDevice2A, Form As Form) As Long
On Error GoTo err
Dim MouseX As Win32.GUID
Dim MouseY As Win32.GUID
Dim MouseZ As Win32.GUID
Dim MouseButton As Win32.GUID
Dim Mousedirectinputdataformat As DIDATAFORMAT
Dim MouseDirectinputObject(0 To 6) As DIOBJECTDATAFORMAT

'Guids defining
MouseX.Data1 = &HA36D02E0
MouseX.Data2 = &HC9F3
MouseX.Data3 = &H11CF
MouseX.Data4(0) = &HBF
MouseX.Data4(1) = &HC7
MouseX.Data4(2) = &H44
MouseX.Data4(3) = &H45
MouseX.Data4(4) = &H53
MouseX.Data4(5) = &H54
MouseX.Data4(6) = 0
MouseX.Data4(7) = 0

MouseY = MouseX
MouseY.Data1 = &HA36D02E1

MouseZ = MouseX
MouseZ.Data1 = &HA36D02E2

MouseButton = MouseX
MouseButton.Data1 = &HA36D02F0

'create the Data format
 ' Mouse objects array
     MouseDirectinputObject(0).dwOfs = 0
     MouseDirectinputObject(0).dwType = &HFFFF00 + DIDFT_AXIS
     MouseDirectinputObject(0).dwFlags = 0
     MouseDirectinputObject(0).pGUID = VarPtr(MouseX)
     MouseDirectinputObject(1).dwOfs = 4
     MouseDirectinputObject(1).dwType = &HFFFF00 + DIDFT_AXIS
     MouseDirectinputObject(1).dwFlags = 0
     MouseDirectinputObject(1).pGUID = VarPtr(MouseY)
     MouseDirectinputObject(2).dwOfs = 8
     MouseDirectinputObject(2).dwType = &H80FFFF00 + DIDFT_AXIS
     MouseDirectinputObject(2).dwFlags = 0
     MouseDirectinputObject(2).pGUID = VarPtr(MouseZ)
    Dim i As Long
    For i = 0 To 3
    MouseDirectinputObject(3 + i).dwOfs = 12 + i
    MouseDirectinputObject(3 + i).dwType = &HFFFF00 + DIDFT_BUTTON
    If i = 2 Or i = 3 Then MouseDirectinputObject(3 + i).dwType = &H80000000 Or MouseDirectinputObject(3 + i).dwType
    MouseDirectinputObject(3 + i).dwFlags = 0
    MouseDirectinputObject(3 + i).pGUID = VarPtr(MouseButton)
    Next

    ' Mouse data format
    Mousedirectinputdataformat.dwSize = &H18
    Mousedirectinputdataformat.dwObjSize = &H10
    Mousedirectinputdataformat.dwFlags = 2
    Mousedirectinputdataformat.dwDataSize = &H10
    Mousedirectinputdataformat.dwNumObjs = 7
    Mousedirectinputdataformat.rgodf = VarPtr(MouseDirectinputObject(0))
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim oldnotusedMouseDirectInputDevice As IDirectInputDeviceA
'create a Direct Input Object  when it's nothing
If directInput Is Nothing Then DirectInputCreateA ByVal App.hInstance, &H500, directInput, Nothing

Dim did As DIDEVICEINSTANCEA
directInput.EnumDevices DIDEVTYPE_MOUSE, AddressOf enumdirectinputobjects, did, DIEDFL_ATTACHEDONLY

'create a Mouse Device
directInput.CreateDevice did.guidInstance, oldnotusedMouseDirectInputDevice, Nothing

'create a Mouse Device 2
Set MouseDirectInputDevice2 = oldnotusedMouseDirectInputDevice

'Set the dataformat to device
MouseDirectInputDevice2.SetDataFormat Mousedirectinputdataformat

'set the cooperative Level of device
MouseDirectInputDevice2.SetCooperativeLevel Form.hWnd, DISCL_FOREGROUND Or DISCL_NONEXCLUSIVE
'acquires the device
MouseDirectInputDevice2.Acquire
'you can use the mouse now

Exit Function
err:
CreateDirectInputMouse = err.Number
End Function

Public Function CreateDirectInputJoystick(directInput As IDirectInputA, JoystickDirectInputDevice2 As IDirectInputDevice2A, Form As Form) As Long
On Error GoTo err

Dim Joystickddidatafotmat As DIDATAFORMAT
Dim Joystickdirectinputobjectdataformat(0 To 43) As DIOBJECTDATAFORMAT

Dim JoystickX As Win32.GUID
Dim JoystickY As Win32.GUID
Dim JoystickZ As Win32.GUID
Dim JoystickRxAxis As Win32.GUID
Dim JoystickRyAxis As Win32.GUID
Dim JoystickRzAxis As Win32.GUID
Dim JoystickSlider As Win32.GUID
Dim JoystickPov As Win32.GUID
Dim Joystickbutton As Win32.GUID

JoystickX.Data1 = &HA36D02E0
JoystickX.Data2 = &HC9F3
JoystickX.Data3 = &H11CF
JoystickX.Data4(0) = &HBF
JoystickX.Data4(1) = &HC7
JoystickX.Data4(2) = &H44
JoystickX.Data4(3) = &H45
JoystickX.Data4(4) = &H53
JoystickX.Data4(5) = &H54
JoystickX.Data4(6) = 0
JoystickX.Data4(7) = 0

JoystickY = JoystickX
JoystickY.Data1 = &HA36D02E1

JoystickZ = JoystickX
JoystickZ.Data1 = &HA36D02E2

JoystickRxAxis = JoystickX
JoystickRxAxis.Data1 = &HA36D02F4

JoystickRyAxis = JoystickX
JoystickRyAxis.Data1 = &HA36D02F5

JoystickRzAxis = JoystickX
JoystickRzAxis.Data1 = &HA36D02E3

JoystickSlider = JoystickX
JoystickSlider.Data1 = &HA36D02E4

JoystickPov = JoystickX
JoystickPov.Data1 = &HA36D02F2

Joystickbutton = JoystickX
Joystickbutton.Data1 = &HA36D02F0

Joystickdirectinputobjectdataformat(0).dwOfs = 0
Joystickdirectinputobjectdataformat(0).dwType = &H80FFFF00 + DIDFT_AXIS
Joystickdirectinputobjectdataformat(0).dwFlags = 1
Joystickdirectinputobjectdataformat(0).pGUID = VarPtr(JoystickX)

Joystickdirectinputobjectdataformat(1).dwOfs = 4
Joystickdirectinputobjectdataformat(1).dwType = &H80FFFF00 + DIDFT_AXIS
Joystickdirectinputobjectdataformat(1).dwFlags = 1
Joystickdirectinputobjectdataformat(1).pGUID = VarPtr(JoystickY)


Joystickdirectinputobjectdataformat(2).dwOfs = 8
Joystickdirectinputobjectdataformat(2).dwType = &H80FFFF00 + DIDFT_AXIS
Joystickdirectinputobjectdataformat(2).dwFlags = 1
Joystickdirectinputobjectdataformat(2).pGUID = VarPtr(JoystickZ)

Joystickdirectinputobjectdataformat(3).dwOfs = &HC
Joystickdirectinputobjectdataformat(3).dwType = &H80FFFF00 + DIDFT_AXIS
Joystickdirectinputobjectdataformat(3).dwFlags = 1
Joystickdirectinputobjectdataformat(3).pGUID = VarPtr(JoystickRxAxis)

Joystickdirectinputobjectdataformat(4).dwOfs = &H10
Joystickdirectinputobjectdataformat(4).dwType = &H80FFFF00 + DIDFT_AXIS
Joystickdirectinputobjectdataformat(4).dwFlags = 1
Joystickdirectinputobjectdataformat(4).pGUID = VarPtr(JoystickRyAxis)

Joystickdirectinputobjectdataformat(5).dwOfs = &H14
Joystickdirectinputobjectdataformat(5).dwType = &H80FFFF00 + DIDFT_AXIS
Joystickdirectinputobjectdataformat(5).dwFlags = 1
Joystickdirectinputobjectdataformat(5).pGUID = VarPtr(JoystickRzAxis)

Joystickdirectinputobjectdataformat(6).dwOfs = &H18
Joystickdirectinputobjectdataformat(6).dwType = &H80FFFF00 + DIDFT_AXIS
Joystickdirectinputobjectdataformat(6).dwFlags = 1
Joystickdirectinputobjectdataformat(6).pGUID = VarPtr(JoystickSlider)

Joystickdirectinputobjectdataformat(7).dwOfs = &H1C
Joystickdirectinputobjectdataformat(7).dwType = &H80FFFF00 + DIDFT_AXIS
Joystickdirectinputobjectdataformat(7).dwFlags = 1
Joystickdirectinputobjectdataformat(7).pGUID = VarPtr(JoystickSlider)

Joystickdirectinputobjectdataformat(8).dwOfs = &H20
Joystickdirectinputobjectdataformat(8).dwType = &H80FFFF00 + DIDFT_POV
Joystickdirectinputobjectdataformat(8).dwFlags = 0
Joystickdirectinputobjectdataformat(8).pGUID = VarPtr(JoystickPov)


Joystickdirectinputobjectdataformat(9).dwOfs = &H24
Joystickdirectinputobjectdataformat(9).dwType = &H80FFFF00 + DIDFT_POV
Joystickdirectinputobjectdataformat(9).dwFlags = 0
Joystickdirectinputobjectdataformat(9).pGUID = VarPtr(JoystickPov)

Joystickdirectinputobjectdataformat(10).dwOfs = &H28
Joystickdirectinputobjectdataformat(10).dwType = &H80FFFF00 + DIDFT_POV
Joystickdirectinputobjectdataformat(10).dwFlags = 0
Joystickdirectinputobjectdataformat(10).pGUID = VarPtr(JoystickPov)


Joystickdirectinputobjectdataformat(11).dwOfs = &H2C
Joystickdirectinputobjectdataformat(11).dwType = &H80FFFF00 + DIDFT_POV
Joystickdirectinputobjectdataformat(11).dwFlags = 0
Joystickdirectinputobjectdataformat(11).pGUID = VarPtr(JoystickPov)

Dim i As Long
For i = 0 To 31
Joystickdirectinputobjectdataformat(12 + i).dwOfs = &H30 + i
Joystickdirectinputobjectdataformat(12 + i).dwType = &H80FFFF00 + DIDFT_BUTTON
Joystickdirectinputobjectdataformat(12 + i).dwFlags = 0
Joystickdirectinputobjectdataformat(12 + i).pGUID = VarPtr(Joystickbutton)
Next
    ' Joystick data format
Joystickddidatafotmat.dwSize = &H18
Joystickddidatafotmat.dwObjSize = &H10
Joystickddidatafotmat.dwFlags = 1
Joystickddidatafotmat.dwDataSize = &H50
Joystickddidatafotmat.dwNumObjs = &H2C
Joystickddidatafotmat.rgodf = VarPtr(Joystickdirectinputobjectdataformat(0))



Dim oldnotusedJoystickDirectInputDevice As IDirectInputDeviceA

'create a Direct Input Object when it's nothing
If directInput Is Nothing Then DirectInputCreateA ByVal App.hInstance, &H500, directInput, Nothing

Dim did As DIDEVICEINSTANCEA
directInput.EnumDevices DIDEVTYPE_JOYSTICK, AddressOf enumdirectinputobjects, did, DIEDFL_ATTACHEDONLY

'create a joystick Device
directInput.CreateDevice did.guidInstance, oldnotusedJoystickDirectInputDevice, Nothing

'create joystick Device 2
Set JoystickDirectInputDevice2 = oldnotusedJoystickDirectInputDevice

'Set the dataformat to device
JoystickDirectInputDevice2.SetDataFormat Joystickddidatafotmat

'set the cooperative Level of device
JoystickDirectInputDevice2.SetCooperativeLevel Form.hWnd, DISCL_FOREGROUND Or DISCL_NONEXCLUSIVE

'acquires the device
JoystickDirectInputDevice2.Acquire
'You can use the joystick device now as described in the fullscreen version of this sample
Exit Function
err:
CreateDirectInputJoystick = err.Number
End Function
Function enumdirectinputobjects(ddi As DIDEVICEINSTANCEA, results As DIDEVICEINSTANCEA) As Long
    results = ddi
    enumdirectinputobjects = DIENUM_STOP
End Function