2013-06-19 07:50

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

     $IFNDEF FALSE
      $DEFINE False 0
     $ENDIF

     $IFNDEF boolean
      $DEFINE boolean INTEGER
     $ENDIF

     CONST WV_CLOSE=0
     CONST WV_PLAY=1
     CONST WV_PAUSE=2
     CONST WV_STOP=3
     CONST WV_RECORD=4
     CONST WV_MONO=1
     CONST WV_STEREO=2
     CONST WV_BIT8=8
     CONST WV_BIT16=16
     CONST WV_KHZ8=8000
     CONST WV_KHZ11=11025
     CONST WV_KHZ22=22050
     CONST WV_KHZ44=44100

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

     TYPE QWave EXTENDS QOBJECT
  '================================
  ' champs et proprietés
  '================================
      TIMER AS QTIMER
      Lenght AS LONG
      State AS INTEGER
      FileOpen AS boolean
      ERROR AS STRING
      CurrentPos AS LONG PROPERTY SET SetCurrentPos
      Bits AS INTEGER PROPERTY SET SetBits
      Frequence AS INTEGER PROPERTY SET SetFrequence
      Mode AS SHORT PROPERTY SET SetMode
      Volume AS INTEGER PROPERTY SET SetVolume
      OnChange AS EVENT(event_change)

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

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

  '====================================
  ' proprieté position Wave
  '====================================
      PROPERTY SET SetCurrentPos(Position AS LONG)
       DIM Retval AS INTEGER
       DIM RetString AS STRING

       IF QWave.FileOpen THEN
        IF QWave.State=WV_STOP OR QWave.State=WV_PAUSE THEN
         IF Position<0 THEN
          QWave.CurrentPos=0
         ELSE
          IF Position>QWave.Lenght THEN
           QWave.CurrentPos=QWave.Lenght
          ELSE
           QWave.CurrentPos=Position
          END IF
         END IF
         RetString=SPACE$(128)
         Retval=mciSendWave("seek sound to "+STR$(QWave.CurrentPos),VARPTR(RetString),128,0)
        END IF
       END IF
      END PROPERTY

  '=========================================
  ' proprieté nombre de bit du fichier Wave
  '=========================================
      PROPERTY SET SetBits(number AS INTEGER)
       DIM Retval AS INTEGER
       DIM RetString AS STRING
       DIM alignement AS INTEGER
       DIM ByteRate AS LONG

       IF number=WV_BIT8 OR number=WV_BIT16 THEN
        IF QWave.FileOpen THEN
         IF QWave.State=WV_STOP OR QWave.State=WV_PAUSE THEN
          QWave.Bits=number
          alignement=((QWave.Bits/8)*QWave.Mode)
          ByteRate=(QWave.Frequence*QWave.Mode*(QWave.Bits/8))
          RetString=SPACE$(128)
          Retval=mciSendWave("set sound BitsPerSample "+STR$(QWave.Bits)+" channels "+STR$(QWave.Mode)+" samplespersec "+STR$(QWave.Frequence)+" alignment "+STR$(alignement)+" bytespersec "+STR$(ByteRate),VARPTR(RetString),128,0)
         END IF
        END IF
       END IF
      END PROPERTY

  '=========================================
  ' proprieté frequence du fichier Wave
  '=========================================
      PROPERTY SET SetFrequence(freq AS INTEGER)
       DIM Retval AS INTEGER
       DIM RetString AS STRING
       DIM alignement AS INTEGER
       DIM ByteRate AS LONG

       IF freq=WV_KHZ8 OR freq=WV_KHZ11 OR freq=WV_KHZ44 THEN
        IF QWave.FileOpen THEN
         IF QWave.State=WV_STOP OR QWave.State=WV_PAUSE THEN
          QWave.Frequence=freq
          alignement=((QWave.Bits/8)*QWave.Mode)
          ByteRate=(QWave.Frequence*QWave.Mode*(QWave.Bits/8))
          RetString=SPACE$(128)
          Retval=mciSendWave("set sound BitsPerSample "+STR$(QWave.Bits)+" channels "+STR$(QWave.Mode)+" samplespersec "+STR$(QWave.Frequence)+" alignment "+STR$(alignement)+" bytespersec "+STR$(ByteRate),VARPTR(RetString),128,0)
         END IF
        END IF
       END IF
      END PROPERTY

  '=========================================
  ' proprieté mode de sortie du fichier Wave
  '=========================================
      PROPERTY SET SetMode(number AS SHORT)
       DIM Retval AS INTEGER
       DIM RetString AS STRING
       DIM alignement AS INTEGER
       DIM ByteRate AS LONG

       IF number=WV_MONO OR number=WV_STEREO THEN
        IF QWave.FileOpen THEN
         IF QWave.State=WV_STOP OR QWave.State=WV_PAUSE THEN
          QWave.Mode=number
          alignement=((QWave.Bits/8)*QWave.Mode)
          ByteRate=(QWave.Frequence*QWave.Mode*(QWave.Bits/8))
          RetString=SPACE$(128)
          Retval=mciSendWave("set sound BitsPerSample "+STR$(QWave.Bits)+" channels "+STR$(QWave.Mode)+" samplespersec "+STR$(QWave.Frequence)+" alignment "+STR$(alignement)+" bytespersec "+STR$(ByteRate),VARPTR(RetString),128,0)
         END IF
        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=mciGetErrorWave(McierrNr,RetString,200)
       IF Retval THEN
        QWave.GetMciDescription=RTRIM$(RetString)
       ELSE
        QWave.GetMciDescription=""
       END IF
      END FUNCTION

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

       IF Wave.FileOpen THEN
        RetString=SPACE$(128)
        Retval=mciSendWave("status sound position",VARPTR(RetString),128,0)
        IF Retval=False THEN QWave.GetPosition=VAL(RetString)
       END IF
      END FUNCTION

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

       IF QWave.FileOpen THEN
        RetString=SPACE$(128)
        Retval=mciSendWave("status sound mode",VARPTR(RetString),128,0)
        IF INSTR(RetString,"stopped")>0 THEN QWave.GetState=WV_STOP
        IF INSTR(RetString,"playing")>0 THEN QWave.GetState=WV_PLAY
        IF INSTR(RetString,"paused")>0 THEN QWave.GetState=WV_PAUSE
       END IF
      END FUNCTION

PUBLIC:

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

       QWave.TIMER.enabled=False
       RetString=SPACE$(128)
       Retval=mciSendWave("stop sound",VARPTR(RetString),128,0)
       RetString=SPACE$(128)
       Retval=mciSendWave("close sound",VARPTR(RetString),128,0)
       QWave.FileOpen=False
       QWave.Lenght=0
       QWave.CurrentPos=0
       QWave.State=WV_CLOSE
      END SUB

  '====================================
  ' méthode ouverture fichier Wave
  '====================================
      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=mciSendWave("open "+FileName+" type waveaudio alias sound",VARPTR(RetString),128,0)
        IF Retval=False THEN
         RetString=SPACE$(128)
         Retval=mciSendWave("set sound time format milliseconds",VARPTR(RetString),128,0)
         RetString=SPACE$(128)
         Retval=mciSendWave("status sound length",VARPTR(RetString),128,0)
         IF Retval=False THEN
          QWave.Lenght=VAL(RetString)
          RetString=SPACE$(128)
          Retval=mciSendWave("status sound bitspersample",VARPTR(RetString),128,0)
          IF Retval=False THEN QWave.Bits=VAL(RetString)
          RetString=SPACE$(128)
          Retval=mciSendWave("status sound samplespersec",VARPTR(RetString),128,0)
          IF Retval=False THEN QWave.Frequence=VAL(RetString)
          RetString=SPACE$(128)
          Retval=mciSendWave("status sound channels",VARPTR(RetString),128,0)
          IF Retval=False THEN QWave.Mode=VAL(RetString)
          QWave.State=WV_STOP
          QWave.CurrentPos=0
          QWave.FileOpen=True
          QWave.OPEN=True
          FlagOpen=True
         END IF
        ELSE
         QWave.ERROR=QWave.GetMciDescription(Retval)
        END IF
        IF FlagOpen=False THEN QWave.CLOSE
       END IF
      END FUNCTION

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

       IF QWave.FileOpen THEN
        QWave.TIMER.enabled=True
        RetString = SPACE$(128)
        Retval=mciSendWave("play sound from "+STR$(QWave.CurrentPos),VARPTR(RetString),128,0)
        IF Retval=False THEN QWave.State=WV_PLAY
       END IF
      END SUB

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

       IF QWave.FileOpen THEN
        RetString=SPACE$(128)
        Retval=mciSendWave("stop sound",VARPTR(RetString),128,0)
        IF Retval=False THEN
         RetString=SPACE$(128)
         Retval=mciSendWave("status sound length",VARPTR(RetString),128,0)
         IF Retval=False THEN QWave.Lenght=VAL(RetString)
         QWave.TIMER.enabled=False
         QWave.State=WV_STOP
         QWave.CurrentPos=0
         RetString=SPACE$(128)
         Retval=mciSendWave("seek sound 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 QWave.FileOpen=true AND QWave.State=WV_PLAY THEN
        RetString=SPACE$(128)
        Retval=mciSendWave("pause sound",VARPTR(RetString),128,0)
        IF Retval=False THEN
         QWave.State=WV_PAUSE
         QWave.TIMER.enabled=False
         QWave.CurrentPos=QWave.GetPosition
        END IF
       END IF
      END SUB

  '==================================
  ' méthode new,nouveau fichier wave
  '==================================
      SUB New
       DIM Retval AS INTEGER
       DIM RetString AS STRING
       DIM FlagOpen AS boolean

       IF QWave.FileOpen=false THEN
        RetString=SPACE$(128)
        Retval=mciSendWave("open new type waveaudio alias sound",VARPTR(RetString),128,0)
        IF Retval=False THEN
         RetString=SPACE$(128)
         Retval=mciSendWave("set sound time format milliseconds",VARPTR(RetString),128,0)
         RetString=SPACE$(128)
         Retval=mciSendWave("status sound bitspersample",VARPTR(RetString),128,0)
         IF Retval=False THEN QWave.Bits=VAL(RetString)
         RetString=SPACE$(128)
         Retval=mciSendWave("status sound samplespersec",VARPTR(RetString),128,0)
         IF Retval=False THEN QWave.Frequence=VAL(RetString)
         RetString=SPACE$(128)
         Retval=mciSendWave("status sound channels",VARPTR(RetString),128,0)
         IF Retval=False THEN QWave.Mode=VAL(RetString)
         QWave.State=WV_STOP
         QWave.TIMER.enabled=False
         QWave.CurrentPos=0
         QWave.FileOpen=True
         FlagOpen=True
        END IF
        IF FlagOpen=False THEN QWave.CLOSE
       END IF
      END SUB

  '==================================
  ' méthode record
  '==================================
      SUB Record
       DIM Retval AS INTEGER
       DIM RetString AS STRING

       IF QWave.FileOpen=true AND (QWave.State=WV_STOP OR QWave.State=WV_PAUSE) THEN
        RetString=SPACE$(128)
        Retval=mciSendWave("record sound to "+STR$(QWave.Lenght),VARPTR(RetString),128,0)
        IF Retval=False THEN
         QWave.State=WV_RECORD
         QWave.TIMER.enabled=True
        END IF
       END IF
      END SUB

  '==================================
  ' méthode save
  '==================================
      FUNCTION Save(FileName AS STRING) AS boolean
       DIM Retval AS INTEGER
       DIM RetString AS STRING

       IF FileName<>"" THEN
        IF QWave.FileOpen=true AND QWave.State=WV_STOP THEN
         RetString=SPACE$(128)
         Retval=mciSendWave("save sound "+FileName,VARPTR(RetString),128,0)
         IF Retval=False THEN QWave.Save=True
        END IF
       END IF
      END FUNCTION

  '==================================
  ' méthode delete
  '==================================
      SUB Delete(pos1 AS LONG,pos2 AS LONG)
       DIM Retval AS INTEGER
       DIM RetString AS STRING

       IF QWave.FileOpen=true AND QWave.State=WV_STOP THEN
        IF pos2>QWave.lenght THEN pos2=QWave.lenght
        IF pos1<0 THEN pos1=0
        RetString=SPACE$(128)
        Retval=mciSendWave("delete sound from "+STR$(pos1)+" to "+STR$(pos2),VARPTR(RetString),128,0)
        IF Retval=False THEN
         RetString=SPACE$(128)
         Retval=mciSendWave("status sound length",VARPTR(RetString),128,0)
         IF Retval=False THEN QWave.Lenght=VAL(RetString)
        END IF
       END IF
      END SUB

  '===============================================
  ' évenement changementposition du fichier Wave
  '===============================================
      EVENT TIMER.OnTimer
       QWave.CurrentPos=QWave.GetPosition
       QWave.State=QWave.GetState
       IF QWave.State=WV_STOP THEN QWave.Stop
       IF QWave.OnChange<>0 THEN CALLFUNC(QWave.OnChange,QWave.CurrentPos)
      END EVENT

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

2013-06-19 07:50