home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / CODE_UPLOAD154242242001.psc / DInput.bas < prev    next >
Encoding:
BASIC Source File  |  2001-02-21  |  2.0 KB  |  82 lines
  1. Attribute VB_Name = "DInput"
  2. Dim dx As New DirectX7
  3. Dim di As DirectInput
  4. Public diDev As DirectInputDevice
  5. Public diMState As DIMOUSESTATE
  6. Public X As Integer
  7. Public Y As Integer
  8. Public LButton As Boolean
  9. Public RButton As Boolean
  10. Private XBorder As Integer
  11. Private YBorder As Integer
  12. Public MouseRect As RECT
  13. Public HotSpotRect As RECT
  14.  
  15. Public Sub Initialize(prmForm As Form)
  16.     ' Create DI object
  17.     Set di = dx.DirectInputCreate()
  18.     
  19.     ' Create DI device which is a mouse
  20.     Set diDev = di.CreateDevice("GUID_SysMouse")
  21.     
  22.     ' Set the data format,coop level and acquire
  23.     Call diDev.SetCommonDataFormat(DIFORMAT_MOUSE)
  24.     Call diDev.SetCooperativeLevel(prmForm.hWnd, DISCL_FOREGROUND Or DISCL_EXCLUSIVE)
  25.     
  26.     diDev.Acquire
  27.     
  28.     XBorder = SCREEN_WIDTH - 32
  29.     YBorder = SCREEN_HEIGHT - 32
  30.     
  31.     ' Set mouse to center of screen
  32.     X = SCREEN_WIDTH / 2
  33.     Y = SCREEN_HEIGHT / 2
  34. End Sub
  35.  
  36. Public Sub Terminate()
  37.     diDev.Unacquire
  38.     Set diDev = Nothing
  39.     Set di = Nothing
  40. End Sub
  41.  
  42. Public Sub CheckMouse()
  43.     ' Get state
  44.     Call diDev.GetDeviceStateMouse(DInput.diMState)
  45.     
  46.     ' Acquire if we lost it
  47.     If Err.Number <> 0 Then DInput.diDev.Acquire
  48.     
  49.     ' Exit if we cannot acquire
  50.     If Err.Number <> 0 Then Exit Sub
  51.     
  52.     ' Calculate new position of mouse
  53.     X = X + diMState.X * MOUSE_SPEED
  54.     If X < 0 Then X = 0
  55.     If X > XBorder Then X = XBorder
  56.     
  57.     
  58.     Y = Y + diMState.Y * MOUSE_SPEED
  59.     If Y <= 0 Then Y = 0
  60.     If Y > YBorder Then Y = YBorder
  61.     
  62.     ' Check Left Button
  63.     If diMState.buttons(0) <> 0 Then LButton = True
  64.     If diMState.buttons(0) = 0 Then LButton = False
  65.     
  66.     ' Check Right Button
  67.     If diMState.buttons(1) <> 0 Then RButton = True
  68.     If diMState.buttons(1) = 0 Then RButton = False
  69.     
  70.     
  71.     ' Update the hotspot rect
  72.     With HotSpotRect
  73.         .Top = Y + 16
  74.         .Left = X + 16
  75.         .Right = X + 1
  76.         .Bottom = Y + 1
  77.     End With
  78.     
  79. End Sub
  80.  
  81.  
  82.