2013-06-19 07:51

'=======================================================
' Type Objet
' Classe QMidi Version 1.2
'=======================================================
     $IFNDEF TRUE
      $DEFINE True 1
     $ENDIF

     $IFNDEF FALSE
      $DEFINE False 0
     $ENDIF

     $IFNDEF boolean
      $DEFINE boolean INTEGER
     $ENDIF

     CONST MD_CLOSE=0
     CONST MD_PLAY=1
     CONST MD_PAUSE=2
     CONST MD_STOP=3

     DECLARE FUNCTION mciSendMidi LIB "winmm.dll" ALIAS "mciSendStringA" (lpstrCommand AS STRING, lpstrReturnString AS LONG, uReturnLength AS LONG, hwndCallback AS LONG) AS LONG
     DECLARE FUNCTION mciGetErrorMidi LIB "winmm.dll" ALIAS "mciGetErrorStringA" (dwError AS LONG,Byref lpstrBuffer AS STRING,uLength AS LONG) AS LONG
     DECLARE FUNCTION MidiSetVolume LIB "Winmm" ALIAS "waveOutSetVolume" (wDeviceID AS SHORT,dwVolume AS LONG) AS SHORT
     DECLARE SUB event_change(position AS LONG)

     TYPE QMidi EXTENDS QOBJECT
  '================================
  ' champs et proprietés
  '================================
      TIMER AS QTIMER
      Lenght AS LONG
      State AS INTEGER
      FileOpen AS boolean
      ERROR AS STRING
      CurrentFrame AS LONG PROPERTY SET SetCurrentFrame
      Volume AS INTEGER PROPERTY SET SetVolume
      OnChange AS EVENT(event_change)

  '====================================
  ' proprieté volume du media
  '====================================
      PROPERTY SET SetVolume(volume AS INTEGER)
       DIM vol AS LONG

       IF volume<=100 THEN
        QMidi.volume=volume
        IF volume>50 THEN
         IF volume=100 THEN
          MidiSetVolume(0,&hffffffff)
         ELSE
          vol=-((32767/50)*(100-volume))
          MidiSetVolume(0,vol+(vol*65536))
         END IF
        ELSE
         vol=(32767/50)*volume
         MidiSetVolume(0,vol+(vol*65536))
        END IF
       END IF
      END PROPERTY

  '====================================
  ' proprieté position séquence
  '====================================
      PROPERTY SET SetCurrentFrame(frame AS LONG)
       DIM Retval AS INTEGER
       DIM RetString AS STRING

       IF QMidi.FileOpen THEN
        IF QMidi.State=MD_STOP OR QMidi.State=MD_PAUSE THEN
         IF frame<0 THEN
          QMidi.CurrentFrame=0
         ELSE
          IF frame>QMidi.Lenght THEN
           QMidi.CurrentFrame=QMidi.Lenght
          ELSE
           QMidi.CurrentFrame=frame
          END IF
         END IF
         RetString=SPACE$(128)
         Retval=mciSendMidi("seek MEDIA to "+STR$(QMidi.CurrentFrame),VARPTR(RetString),128,0)
        END IF
       END IF
      END PROPERTY

PRIVATE:

  '========================================
  ' Méthode retourne le texte de l'erreur
  '========================================
      FUNCTION GetMciDescription(McierrNr AS LONG) AS STRING
       DIM Retval AS LONG
       DIM RetString AS STRING

       RetString=SPACE$(200)
       Retval=mciGetErrorMidi(McierrNr,RetString,200)
       IF Retval THEN
        QMidi.GetMciDescription=RTRIM$(RetString)
       ELSE
        QMidi.GetMciDescription=""
       END IF
      END FUNCTION

  '====================================
  ' méthode lecture position séquence
  '====================================
      FUNCTION GetPosition AS LONG
       DIM Retval AS INTEGER
       DIM RetString AS STRING

       IF QMidi.FileOpen THEN
        RetString=SPACE$(128)
        Retval=mciSendMidi("status MEDIA position",VARPTR(RetString),128,0)
        IF Retval=False THEN QMidi.GetPosition=VAL(RetString)
       END IF
      END FUNCTION

  '====================================
  ' méthode lecture mode du media
  '====================================
      FUNCTION GetMode AS INTEGER
       DIM Retval AS INTEGER
       DIM RetString AS STRING

       IF QMidi.FileOpen THEN
        RetString=SPACE$(128)
        Retval=mciSendMidi("status MEDIA mode",VARPTR(RetString),128,0)
        IF INSTR(RetString,"stopped")>0 THEN QMidi.GetMode=MD_STOP
        IF INSTR(RetString,"playing")>0 THEN QMidi.GetMode=MD_PLAY
        IF INSTR(RetString,"paused")>0 THEN QMidi.GetMode=MD_PAUSE
       END IF
      END FUNCTION

PUBLIC:

  '=================================
  ' méthode fermeture fichier midi
  '=================================
      SUB CLOSE
       DIM Retval AS INTEGER
       DIM RetString AS STRING

       QMidi.TIMER.enabled=False
       RetString=SPACE$(128)
       Retval=mciSendMidi("stop MEDIA",VARPTR(RetString),128,0)
       RetString=SPACE$(128)
       Retval=mciSendMidi("close MEDIA",VARPTR(RetString),128,0)
       QMidi.FileOpen=False
       QMidi.Lenght=0
       QMidi.CurrentFrame=0
       QMidi.State=MD_CLOSE
      END SUB

  '====================================
  ' méthode ouverture fichier midi
  '====================================
      FUNCTION OPEN(FileName AS STRING) AS boolean
       DIM Retval AS INTEGER
       DIM RetString AS STRING
       DIM FlagOpen AS boolean

       IF FileName<>"" THEN
        RetString=SPACE$(128)
        Retval=mciSendMidi("open "+FileName+" type sequencer alias MEDIA",VARPTR(RetString),128,0)
        IF Retval=False THEN
         RetString=SPACE$(128)
         Retval=mciSendMidi("set MEDIA time format milliseconds",VARPTR(RetString),128,0)
         RetString=SPACE$(128)
         Retval=mciSendMidi("status MEDIA length",VARPTR(RetString),128,0)
         IF Retval=False THEN
          QMidi.Lenght=VAL(RetString)
          QMidi.State=MD_STOP
          QMidi.CurrentFrame=0
          QMidi.FileOpen=True
          QMidi.OPEN=True
          FlagOpen=True
         END IF
        ELSE
         QMidi.ERROR=QMidi.GetMciDescription(Retval)
        END IF
        IF FlagOpen=False THEN QMidi.CLOSE
       END IF
      END FUNCTION

  '==================================
  ' méthode lecture fichier midi
  '==================================
      SUB Play
       DIM Retval AS INTEGER
       DIM RetString AS STRING

       IF QMidi.FileOpen THEN
        QMidi.TIMER.enabled=True
        RetString = SPACE$(128)
        Retval=mciSendMidi("play MEDIA from "+STR$(QMidi.CurrentFrame),VARPTR(RetString),128,0)
        IF Retval=False THEN QMidi.State=MD_PLAY
       END IF
      END SUB

  '==================================
  ' méthode arret fichier midi
  '==================================
      SUB Stop
       DIM Retval AS INTEGER
       DIM RetString AS STRING

       IF QMidi.FileOpen THEN
        RetString=SPACE$(128)
        Retval=mciSendMidi("stop MEDIA",VARPTR(RetString),128,0)
        IF Retval=False THEN
         QMidi.TIMER.enabled=False
         QMidi.State=MD_STOP
         QMidi.CurrentFrame=0
         RetString=SPACE$(128)
         Retval=mciSendMidi("seek MEDIA to start",VARPTR(RetString),128,0)
        END IF
       END IF
      END SUB

  '==================================
  ' méthode pause
  '==================================
      SUB Pause
       DIM Retval AS INTEGER
       DIM RetString AS STRING

       IF QMidi.FileOpen=true AND QMidi.State=MD_PLAY THEN
        RetString=SPACE$(128)
        Retval=mciSendMidi("pause MEDIA",VARPTR(RetString),128,0)
        IF Retval=False THEN
         QMidi.State=MD_PAUSE
         QMidi.TIMER.enabled=False
         QMidi.CurrentFrame=QMidi.GetPosition
        END IF
       END IF
      END SUB

  '===============================================
  ' évenement changementposition du fichier midi
  '===============================================
      EVENT TIMER.OnTimer
       QMidi.currentFrame=QMidi.GetPosition
       QMidi.State=QMidi.GetMode
       IF QMidi.State=MD_STOP THEN QMidi.Stop
       IF QMidi.OnChange<>0 THEN CALLFUNC(QMidi.OnChange,QMidi.currentFrame)
      END EVENT

      CONSTRUCTOR
       State=MD_CLOSE
       TIMER.interval=1000
       TIMER.enabled=False
      END CONSTRUCTOR
     END TYPE

2013-06-19 07:51