Attribute VB_Name = "DXInput"
'// Programmed by Ervin Louie B. Pe Benito
'// DXInput.bas
'// Direct Input module
Option Explicit
' Direct Input variables
Private di As DirectInput8               ' Main DI object
Private diMouse As DirectInputDevice8
Public diKeyboard As DirectInputDevice8 ' The device for the keyboard
Public diKeyState As DIKEYBOARDSTATE    ' The keyboard state
Public Wait As Integer                   ' How long to wait for next input
Private Counter As Integer               ' How long have we waited
Public MouseEnabled As Boolean
Public KEventHandle As Long 'Handle For Keyboard Events
Public bMouseDown As Boolean 'Checks whether the mouse is being held down

' Returns true if a key is pressed
Public Function GetKeyState(lKey As Long) As Boolean
    GetKeyState = (diKeyState.Key(lKey) <> 0)
End Function

' Initializes the input devices. Returns true if sucessful
Public Function InitializeDI(Optional HaveMouse As Boolean = False) As Boolean
    Dim diProp As DIPROPLONG
    On Error GoTo ErrorHandler
    
    ' Create a DirectInput object
    Set di = Dx.DirectInputCreate()
    
    ' Set the keyboard GUID
    Set diKeyboard = di.CreateDevice("GUID_SysKeyboard")
    
    ' Set the format of the keyboard state
    diKeyboard.SetCommonDataFormat DIFORMAT_KEYBOARD
    
    ' Set the cooperative level and start the device
    diKeyboard.SetCooperativeLevel frmMain.hWnd, DISCL_FOREGROUND Or DISCL_EXCLUSIVE
    diKeyboard.Acquire

    InitializeDI = True
    
    If HaveMouse = True Then
        'Set DirectInput For Mouse
        Set diMouse = di.CreateDevice("guid_SysMouse")
        Call diMouse.SetCommonDataFormat(DIFORMAT_MOUSE)
        Call diMouse.SetCooperativeLevel(frmMain.hWnd, DISCL_FOREGROUND Or DISCL_EXCLUSIVE)
    
        'Set Up The Mouse Buffer
        diProp.lHow = DIPH_DEVICE
        diProp.lObj = 0
        diProp.lData = 1000 'Set Buffer To Hold 10 Values At Most
        Call diMouse.SetProperty("DIPROP_BUFFERSIZE", diProp)
        diMouse.Acquire 'Start Using The Mouse
        MouseEnabled = True 'Allow Mouse To Be Enabled
     End If
    Exit Function

ErrorHandler:
    
    InitializeDI = False
End Function

' Function updates all keystates
Public Function CheckAllKeys() As Boolean
On Error GoTo ErrorHandler

    ' If we don't have to wait anymore get key states
    If Counter >= Wait Then
        diKeyboard.GetDeviceStateKeyboard diKeyState
        Counter = 0
        Wait = 0
        CheckAllKeys = True
    Else ' Wait
        Counter = Counter + 1
        CheckAllKeys = False
    End If
        
    
ErrorHandler:
End Function
Public Function CheckMouse() As Boolean
Dim MouseData(1 To 5000) As DIDEVICEOBJECTDATA
Dim NumEvents As Long
Dim LoopC As Long

If MouseEnabled = False Then Exit Function

'Get The Number of Events That Have Happened
NumEvents = diMouse.GetDeviceData(MouseData, DIGDD_DEFAULT)

For LoopC = 1 To NumEvents

    Select Case MouseData(LoopC).lOfs
    
        Case DIMOFS_X   'Mouse Has Moved Along X Axis
            MousePos.x = MousePos.x + (MouseData(LoopC).lData * 2)
            If MousePos.x <= 0 Then MousePos.x = 0
            If MousePos.x >= 640 Then MousePos.x = 639
            bDeleted = False
            
        Case DIMOFS_Y   'Mouse Has Moved Along Y Axis
            MousePos.y = MousePos.y + (MouseData(LoopC).lData * 2)
            If MousePos.y <= 0 Then MousePos.y = 0
            If MousePos.y >= 480 Then MousePos.y = 479
            bDeleted = False
            
        Case DIMOFS_BUTTON0 'First Mouse Button (Left) Has Been Pressed
            'CHecks if the current screen is main menu
            If DrawScreen = 1 Then
                'Click "New Game"
                If MouseOver(262, 194, 117, 22) = True Then
                    Sound_Play 1
                    DrawScreen = 2
                End If
                'Click "Load"
                If MouseOver(262, 220, 117, 22) = True Then
                    DrawScreen = 3
                    Sound_Play 1
                    GetFiles
                End If
                'Click "Help"
                If MouseOver(262, 256, 117, 22) = True Then
                    DrawScreen = 15
                End If
                'Click "Credits"
                If MouseOver(262, 282, 117, 22) = True Then
                    DrawScreen = 4
                    Music_Stop 1
                    Music_Start 2
                    Sound_Play 1
                End If
                'Click "Quit"
                If MouseOver(262, 308, 117, 22) = True Then
                    Sound_Play 1
                    bRunning = False
                End If
            End If
            'Help win
            If DrawScreen = 15 Then
                'Click Back
                If MouseOver(44, 395, 52, 32) = True Then
                    Sound_Play 1
                    DrawScreen = 1
                End If
            End If
            'characterwin/storywin
            If DrawScreen = 2 Then
                'Click Back
                If MouseOver(44, 395, 52, 32) = True Then
                    Sound_Play 1
                    DrawScreen = 1
                End If
                'click forward
                If MouseOver(543, 395, 58, 32) = True Then
                'Initialize players starting position
                Userchar.MapX = 64
                Userchar.MapY = 208
                Sound_Play 1
                MouseEnabled = False
                GameMap(1).enabled = True
                GameMap(2).enabled = False
                GameMap(3).enabled = False
                GameMap(4).enabled = False
                GameMap(5).enabled = False
                GameMap(6).enabled = False
                DrawScreen = 5
                Music_Stop 1
                Music_Start 3
                NewPlayer
                RefreshStats
                End If
            End If
            'Loadwin
            If DrawScreen = 3 Then
                'Click Back
                If MouseOver(44, 395, 52, 32) = True Then
                    DrawScreen = 1
                    Sound_Play 1
                    ReDim files(1)
                    Filenum = 0
                End If
                If MouseOver(256 + 128 + 16, 96 - 8, 50, 10) = True Then
                    If Val(sFile) > 0 And Val(sFile) < Filenum + 1 Then
                        LoadPlayer files(Val(sFile))
                        DrawScreen = 16
                    End If
                ElseIf MouseOver(256 + 128 + 16, 96 + 12, 50, 10) Then
                    If Val(sFile) > 0 And Val(sFile) < Filenum + 1 Then
                        If bDeleted = False Then
                            KillFile files(Val(sFile))
                            GetFiles
                            bDeleted = True
                        End If
                    End If
                End If
            End If
            If DrawScreen = 4 Then
                'Click Back
                If MouseOver(44, 395, 52, 32) = True Then
                Sound_Play 1
                DrawScreen = 1
                Music_Stop 2
                Music_Start 1
                End If
            End If
            'GameEnd
            If DrawScreen = 19 Then
                'Click Back
                If MouseOver(44, 395, 52, 32) = True Then
                Sound_Play 1
                DrawScreen = 1
                Music_Stop 9
                Music_Start 1
                End If
            End If
        Case DIMOFS_BUTTON1 'Second Mouse Button (Right) Has Been Pressed
        'Case DIMOFS_BUTTON2 'Third Mouse Button (Middle) Has Been Pressed
    End Select
Next LoopC
End Function
'Checks if the mouse is in the x,y pos
Public Function MouseOver(ByVal Left As Integer, ByVal Top As Integer, ByVal width As Integer, ByVal height As Integer) As Boolean

'Check If Mouse Is In Correct X
If MousePos.x >= Left And MousePos.x <= Left + width Then
    'Check If Mouse Is In Correct Y
    If MousePos.y >= Top And MousePos.y <= Top + height Then
    
        'Mouse Is In The Correct
        MouseOver = True
        
    End If
End If
End Function

' Ends the directInput objects
Public Sub TerminateDI()
    
    ' Unload the keyboard
    diKeyboard.Unacquire
    Set diMouse = Nothing
    Set diKeyboard = Nothing
    Set di = Nothing
   
End Sub
