2004-01-29 05:13

' QJoystick component by Dreadsoft® Corporation <dreadsoft@yahoo.it>

     $TYPECHECK ON
     CONST JOY_POVCENTERED = -1
     CONST JOY_POVFORWARD = 0
     CONST JOY_POVRIGHT = 9000
     CONST JOY_POVLEFT = 27000
     CONST JOY_RETURNX = &H1
     CONST JOY_RETURNY = &H2
     CONST JOY_RETURNZ = &H4
     CONST JOY_RETURNR = &H8
     CONST JOY_RETURNU = &H10
     CONST JOY_RETURNV = &H20
     CONST JOY_RETURNPOV = &H40
     CONST JOY_RETURNBUTTONS = &H80
     CONST JOY_RETURNRAWDATA = &H100
     CONST JOY_RETURNPOVCTS = &H200
     CONST JOY_RETURNCENTERED = &H400
     CONST JOY_USEDEADZONE = &H800
     CONST JOY_RETURNALL =   JOY_RETURNX OR JOY_RETURNY OR JOY_RETURNZ OR _
      JOY_RETURNR OR JOY_RETURNU OR JOY_RETURNV OR _
      JOY_RETURNPOV OR JOY_RETURNBUTTONS

     CONST JOY_CAL_READALWAYS = &H10000
     CONST JOY_CAL_READRONLY = &H2000000
     CONST JOY_CAL_READ3 = &H40000
     CONST JOY_CAL_READ4 = &H80000
     CONST JOY_CAL_READXONLY = &H100000
     CONST JOY_CAL_READYONLY = &H200000
     CONST JOY_CAL_READ5 = &H400000
     CONST JOY_CAL_READ6 = &H800000
     CONST JOY_CAL_READZONLY = &H1000000
     CONST JOY_CAL_READUONLY = &H4000000
     CONST JOY_CAL_READVONLY = &H8000000

     CONST JOY_OFFSET = 10000

     TYPE TJOYINFOEX
      dwSize AS LONG
      dwFlags AS LONG
      dwXpos AS LONG
      dwYpos AS LONG
      dwZpos AS LONG
      dwRpos AS LONG
      dwUpos AS LONG
      dwVpos AS LONG
      dwButtons AS LONG
      dwButtonNubmer AS LONG
      dwPOV AS LONG
      dwReserved1 AS LONG
      dwReserved2 AS LONG
     END TYPE


     DECLARE FUNCTION JoyGetPosEx LIB "WINMM" ALIAS "joyGetPosEx" _
      (uJoyID AS LONG, JoyInfo AS TJOYINFOEX) AS LONG
     DECLARE FUNCTION JoyReleaseCapture LIB "WINMM" ALIAS "joyReleaseCapture" _
      (uJoyID AS LONG) AS LONG
     DECLARE FUNCTION JoySetCapture LIB "WINMM" ALIAS "joySetCapture" _
      (hWnd AS LONG, uJoyID AS LONG, uPeriod AS LONG, _
      fChanged AS LONG) AS LONG

'______________________________________________________________________________


     DECLARE SUB QJOYSTICK_SW_MOVE (L AS LONG, R AS LONG, D AS LONG, U AS LONG)
     DECLARE SUB QJOYSTICK_SW_BTNPRESS (BtnMap AS STRING)

     TYPE QJoystick EXTENDS QOBJECT
PRIVATE:
      info AS TJOYINFOEX
      clock AS QTIMER


      CONSTRUCTOR
       WITH info
        .dwSize = 52
        .dwFlags = JOY_RETURNALL
        .dwXpos = 0
        .dwYpos = 0
        .dwZpos = 0
        .dwRpos = 0
        .dwUpos = 0
        .dwVpos = 0
        .dwButtons = 0
        .dwButtonNubmer = 0
        .dwPOV = 0
        .dwReserved1 = 0
        .dwReserved2 = 0
       END WITH
       clock.enabled = 0
      END CONSTRUCTOR


PUBLIC:
      ID AS LONG
      RefreshRate AS INTEGER
      ButtonMap AS STRING

      Enabled AS LONG PROPERTY SET Enable_Joystick

      PROPERTY SET Enable_Joystick(IsEnabled AS LONG)
       IF IsEnabled = 1 THEN
        JoySetCapture(Application.Handle,QJoystick.id,QJoystick.RefreshRate,0)
        JoyReleaseCapture(QJoystick.id)
        QJoystick.clock.interval = QJoystick.RefreshRate
        QJoystick.clock.enabled = 1
       ELSEIF IsEnabled = 0 THEN
        JoyReleaseCapture(QJoystick.id)
        QJoystick.clock.enabled = 0
       END IF
      END PROPERTY

      OnBtnPress AS EVENT(QJOYSTICK_SW_BTNPRESS)
      OnMove AS EVENT (QJOYSTICK_SW_MOVE)


      SUB GetPosition
       DIM IMS AS QMEMORYSTREAM 'Info memory stream
       DIM mL AS LONG
       DIM mR AS LONG
       DIM mD AS LONG
       DIM mU AS LONG
       mL = 0
       mR = 0
       mD = 0
       mU = 0

       IMS.writeUDT(Qjoystick.info)
       JoyGetPosEx(QJoystick.ID, IMS.pointer)
       IMS.position = 0
       IMS.ReadUDT(QJoystick.info)
       IF QJoystick.Info.dwXpos = 65280    THEN mR = 1
       IF QJoystick.Info.dwXpos = 0        THEN mL = 1
       IF QJoystick.Info.dwYpos = 65280    THEN mD = 1
       IF QJoystick.Info.dwYpos = 0        THEN mU = 1

       CALLFUNC QJoystick.OnMove, mL, mR, mD, mU

       DIM tmpbtnstring AS STRING
       tmpbtnstring = reverse$(BIN$(QJoystick.Info.dwButtons))
       IF LEN(tmpbtnstring) < 32 THEN _
        tmpbtnstring = tmpbtnstring + STRING$(32 - LEN(tmpbtnstring), "0")
       QJoystick.ButtonMap = tmpbtnstring
       IF QJoystick.Info.dwButtons > 0 THEN _
        CALLFUNC (QJoystick.OnBtnPress, tmpbtnstring)
       IMS.position = 0
      END SUB

      FUNCTION Pressed(number AS INTEGER) AS INTEGER
       result = VAL(MID$(QJoystick.ButtonMap, number, 1))
      END FUNCTION


      CONSTRUCTOR
       clock.ontimer = QJoystick.GetPosition
       ID = 0
       RefreshRate = 10
      END CONSTRUCTOR

     END TYPE

2004-01-29 05:13