Option Explicit
Implements DirectXEvent

Dim DX As New DirectX7
Dim DI As DirectInput
Dim DIDev As DirectInputDevice
Dim CursorX As Long
Dim CursorY As Long

Const BufferSize = 10

Dim Button_0 As Boolean
Dim Button_1 As Boolean
Dim Button_2 As Boolean
Dim Button_3 As Boolean

Dim EventHandle As Long
Dim NotActive As Boolean

Private Declare Function GetCursorPos Lib "user32" (lpPoint _
    As POINTAPI) As Long

Private Declare Function SetCursorPos Lib "user32" (ByVal X _
    As Long, ByVal Y As Long) As Long

Private Declare Function ScreenToClient Lib "user32" (ByVal hWnd _
    As Long, lpPoint As POINTAPI) As Long

Private Declare Function ClientToScreen Lib "user32" (ByVal hWnd _
    As Long, lpPoint As POINTAPI) As Long

Private Type POINTAPI
  X As Long
  Y As Long
End Type

Sub AquireMouse()
  Dim CursorCoord As POINTAPI

  Call GetCursorPos(CursorCoord)
  Call ScreenToClient(hWnd, CursorCoord)

  On Error GoTo AQUIREERROR

  DIDev.Acquire

  CursorX = CursorCoord.X
  CursorY = CursorCoord.Y

  UpdateCursor
  imgCursor.Visible = True
  On Error GoTo 0
  Exit Sub

AQUIREERROR:
  Exit Sub
End Sub

Sub CleanUp()
  Dim m_point As POINTAPI

  imgCursor.Visible = False
  DIDev.Unacquire

  m_point.X = CursorX
  m_point.Y = CursorY

  Call ClientToScreen(hWnd, m_point)
  Call SetCursorPos(m_point.X, m_point.Y)
End Sub

Sub Initialise()
  CursorX = Me.ScaleWidth \ 2
  CursorY = Me.ScaleHeight \ 2
  Call UpdateToolBox

  Set DI = DX.DirectInputCreate
  Set DIDev = DI.CreateDevice("GUID_SYSMOUSE")
  Call DIDev.SetCommonDataFormat(DIFORMAT_MOUSE)
  Call DIDev.SetCooperativeLevel(Me.hWnd, DISCL_FOREGROUND Or _
       DISCL_EXCLUSIVE)

  Dim Property As DIPROPLONG
  Property.lHow = DIPH_DEVICE
  Property.lObj = 0
  Property.lData = BufferSize
  Property.lSize = Len(Property)
  Call DIDev.SetProperty("DIPROP_BUFFERSIZE", Property)

  EventHandle = DX.CreateEvent(Me)
  Call DIDev.SetEventNotification(EventHandle)

  AquireMouse
End Sub

Sub UpdateCursor()
  If CursorX < 0 Then CursorX = 0
  If CursorX >= Me.ScaleWidth Then CursorX = Me.ScaleWidth - 1

  If CursorY < 0 Then CursorY = 0
  If CursorY >= Me.ScaleHeight Then CursorY = Me.ScaleHeight - 1

  imgCursor.Left = CursorX
  imgCursor.Top = CursorY
End Sub

Sub UpdateToolBox()
  Form2.lblX.Caption = "CurrentX: " & CStr(CursorX)
  Form2.lblY.Caption = "CurrentY: " & CStr(CursorY)
  Form2.lblButton0.Caption = "Button 0: " & CStr(Button_0)
  Form2.lblButton1.Caption = "Button 1: " & CStr(Button_1)
  Form2.lblButton2.Caption = "Button 2: " & CStr(Button_2)
  Form2.lblButton3.Caption = "Button 3: " & CStr(Button_3)
End Sub

Private Sub DirectXEvent_DXCallback(ByVal eventid As Long)

  Dim DIDeviceData(1 To BufferSize) As DIDEVICEOBJECTDATA
  Dim NumItems As Integer
  Dim i As Integer
  Static OldSequence As Long

  On Error GoTo INPUTLOST
  NumItems = DIDev.GetDeviceData(DIDeviceData, 0)
  On Error GoTo 0

  For i = 1 To NumItems
    Select Case DIDeviceData(i).lOfs
      Case DIMOFS_X
        CursorX = CursorX + DIDeviceData(i).lData * _
                Form2.scrlSpeed.Value
        If OldSequence <> DIDeviceData(i).lSequence Then
          UpdateCursor
          OldSequence = DIDeviceData(i).lSequence
        Else
          OldSequence = 0
        End If

      Case DIMOFS_Y
        CursorY = CursorY + DIDeviceData(i).lData * _
                Form2.scrlSpeed.Value
        If OldSequence <> DIDeviceData(i).lSequence Then
          UpdateCursor
          OldSequence = DIDeviceData(i).lSequence
        Else
          OldSequence = 0
        End If

      Case DIMOFS_BUTTON0
        Button_0 = True
        If DIDeviceData(i).lData = 0 Then
          Button_0 = False
        End If

      Case DIMOFS_BUTTON1
        Button_1 = True
        If DIDeviceData(i).lData = 0 Then
          Button_1 = False
        End If

      Case DIMOFS_BUTTON2
        Button_2 = True
        If DIDeviceData(i).lData = 0 Then
          Button_2 = False
        End If

      Case DIMOFS_BUTTON3
        Button_3 = True
        If DIDeviceData(i).lData = 0 Then
          Button_3 = False
        End If
    End Select
  Next i

  UpdateToolBox
  Exit Sub

INPUTLOST:
  If (Err.Number = DIERR_INPUTLOST) Or (Err.Number = _
         DIERR_NOTACQUIRED) Then
     CleanUp
     Exit Sub
  End If
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
  Select Case KeyCode
    Case vbKeyEscape
      NotActive = True
      DIDev.Unacquire
      CleanUp
      Exit Sub
    Case vbKeyReturn
      NotActive = False
  End Select
End Sub

Private Sub Form_Load()
  Form2.Show
  DoEvents
  Initialise
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, _
      X As Single, Y As Single)
  If NotActive = True Then Exit Sub
  Dim didevstate As DIMOUSESTATE

  On Error GoTo NOTYETACQUIRED
  Call DIDev.GetDeviceStateMouse(didevstate)
  On Error GoTo 0
  Exit Sub

NOTYETACQUIRED:
  Call AquireMouse
End Sub

Private Sub Form_Unload(Cancel As Integer)
  Unload Form2
  If EventHandle <> 0 Then DX.DestroyEvent EventHandle
End Sub

Private Sub scrlSpeed_Change()
  Sensitivity = scrlSpeed.Value
End Sub