2013-06-19 07:50

'=======================================================
' Type Objet
' Classe QVideo Version 1.3
'=======================================================
     $IFNDEF TRUE
      $DEFINE True 1
     $ENDIF

     $IFNDEF FALSE
      $DEFINE False 0
     $ENDIF

     $IFNDEF boolean
      $DEFINE boolean INTEGER
     $ENDIF

     CONST VD_CLOSE=0
     CONST VD_PLAY=1
     CONST VD_PAUSE=2
     CONST VD_STOP=3

     DECLARE FUNCTION ShowVideo LIB "user32" ALIAS "ShowWindow" (hwnd AS LONG,nCmdShow AS LONG) AS LONG
     DECLARE FUNCTION mciSendVideo LIB "winmm.dll" ALIAS "mciSendStringA" (lpstrCommand AS STRING,lpstrReturnString AS LONG,uReturnLength AS LONG,hwndCallback AS LONG) AS LONG
     DECLARE FUNCTION mciGetErrorVideo LIB "winmm.dll" ALIAS "mciGetErrorStringA" (dwError AS LONG,Byref lpstrBuffer AS STRING,uLength AS LONG) AS LONG
     DECLARE FUNCTION MoveVideo LIB "user32" ALIAS "MoveWindow" (hwnd AS LONG,x AS INTEGER,y AS INTEGER,nWidth AS INTEGER,nHeight AS INTEGER,bRepaint AS LONG) AS LONG
     DECLARE FUNCTION SetForegroundVideo LIB "user32" ALIAS "SetForegroundWindow" (hwnd AS LONG) AS LONG
     DECLARE FUNCTION GetVideoRect LIB "user32" ALIAS "GetWindowRect" (hwnd AS LONG,lpRect AS QRECT) AS LONG
     DECLARE FUNCTION VideoSetVolume LIB "Winmm" ALIAS "waveOutSetVolume" (wDeviceID AS SHORT,dwVolume AS LONG) AS SHORT
     DECLARE SUB event_change(position AS LONG,timePos AS LONG)

     TYPE QVideo EXTENDS QOBJECT
  '================================
  ' champs et proprietés
  '================================
      TIMER AS QTIMER
      Lenght AS LONG
      LenghtTime AS LONG
      State AS INTEGER
      Handle AS LONG
      FileOpen AS boolean
      ERROR AS STRING
      PARENT AS LONG
      BorderStyle AS INTEGER
      ImgWidth AS SHORT
      ImgHeight AS SHORT
      Left AS SHORT PROPERTY SET SetLeft
      Top AS SHORT PROPERTY SET SetTop
      Width AS SHORT PROPERTY SET SetWidth
      Height AS SHORT PROPERTY SET SetHeight
      CurrentFrame AS LONG PROPERTY SET SetCurrentFrame
      AudioOff AS boolean PROPERTY SET SetAudioOff
      CAPTION AS STRING PROPERTY SET SetCaption
      WindowState AS INTEGER PROPERTY SET SetWindowState
      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
        QVideo.volume=volume
        IF volume>50 THEN
         IF volume=100 THEN
          VideoSetVolume(0,&hffffffff)
         ELSE
          vol=-((32767/50)*(100-volume))
          VideoSetVolume(0,vol+(vol*65536))
         END IF
        ELSE
         vol=(32767/50)*volume
         VideoSetVolume(0,vol+(vol*65536))
        END IF
       END IF
      END PROPERTY

  '====================================
  ' proprieté affichage image du media
  '====================================
      PROPERTY SET SetCurrentFrame(frame AS LONG)
       DIM Retval AS INTEGER
       DIM RetString AS STRING

       IF QVideo.FileOpen THEN
        IF QVideo.State=VD_STOP OR QVideo.State=VD_PAUSE THEN
         IF frame<0 THEN
          QVideo.CurrentFrame=0
         ELSE
          IF frame>QVideo.Lenght THEN
           QVideo.CurrentFrame=QVideo.Lenght
          ELSE
           QVideo.CurrentFrame=frame
          END IF
         END IF
         RetString=SPACE$(128)
         Retval=mciSendVideo("seek MEDIA to "+STR$(QVideo.CurrentFrame),VARPTR(RetString),128,0)
        END IF
       END IF
      END PROPERTY

  '====================================
  ' proprieté position x image du media
  '====================================
      PROPERTY SET SetLeft(left AS SHORT)
       IF QVideo.FileOpen=True AND QVideo.handle<>0 THEN
        QVideo.Left=left
        IF QVideo.PARENT=0 THEN SetForegroundVideo(QVideo.handle)
        MoveVideo(QVideo.handle,QVideo.Left,QVideo.Top,QVideo.Width,QVideo.Height,true)
       END IF
      END PROPERTY

  '====================================
  ' proprieté position y image du media
  '====================================
      PROPERTY SET SetTop(top AS SHORT)
       IF QVideo.FileOpen=True AND QVideo.handle<>0 THEN
        QVideo.Top=top
        IF QVideo.PARENT=0 THEN SetForegroundVideo(QVideo.handle)
        MoveVideo(QVideo.handle,QVideo.Left,QVideo.Top,QVideo.Width,QVideo.Height,true)
       END IF
      END PROPERTY

  '====================================
  ' proprieté largeur image du media
  '====================================
      PROPERTY SET SetWidth(width AS SHORT)
       IF QVideo.FileOpen=True AND QVideo.handle<>0 THEN
        QVideo.Width=width
        IF QVideo.PARENT=0 THEN SetForegroundVideo(QVideo.handle)
        MoveVideo(QVideo.handle,QVideo.Left,QVideo.Top,QVideo.Width,QVideo.Height,true)
       END IF
      END PROPERTY

  '====================================
  ' proprieté hauteur image du media
  '====================================
      PROPERTY SET SetHeight(height AS SHORT)
       IF QVideo.FileOpen=True AND QVideo.handle<>0 THEN
        QVideo.Height=height
        IF QVideo.PARENT=0 THEN SetForegroundVideo(QVideo.handle)
        MoveVideo(QVideo.handle,QVideo.Left,QVideo.Top,QVideo.Width,QVideo.Height,true)
       END IF
      END PROPERTY

  '====================================
  ' proprieté sans son du media
  '====================================
      PROPERTY SET SetAudioOff(audio AS boolean)
       DIM Retval AS INTEGER
       DIM RetString AS STRING

       IF QVideo.FileOpen THEN
        RetString=SPACE$(128)
        IF audio THEN
         Retval=mciSendVideo("set MEDIA audio all off",VARPTR(RetString),128,0)
        ELSE
         Retval=mciSendVideo("set MEDIA audio all on",VARPTR(RetString),128,0)
        END IF
       END IF
      END PROPERTY

  '====================================
  ' proprieté caption du media
  '====================================
      PROPERTY SET SetCaption(CAPTION AS STRING)
       DIM Retval AS INTEGER
       DIM RetString AS STRING

       QVideo.CAPTION=CAPTION
       IF QVideo.FileOpen=True AND QVideo.PARENT=0 THEN
        RetString=SPACE$(128)
        Retval=mciSendVideo("window MEDIA text "+CAPTION,VARPTR(RetString),128,0)
       END IF
      END PROPERTY

  '====================================
  ' proprieté etat fenetre du media
  '====================================
      PROPERTY SET SetWindowState(WindowState AS INTEGER)
       DIM state AS SHORT

       IF QVideo.FileOpen=True AND QVideo.PARENT=0 THEN
        IF WindowState>-1 AND WindowState<3 THEN
         IF WindowState=0 THEN state=1
         IF WindowState=1 THEN state=2
         IF WindowState=2 THEN state=3
         QVideo.WindowState=WindowState
         ShowVideo(QVideo.handle,state)
        ELSE
         QVideo.WindowState=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=mciGetErrorVideo(McierrNr,RetString,200)
       IF Retval THEN
        QVideo.GetMciDescription=RTRIM$(RetString)
       ELSE
        QVideo.GetMciDescription=""
       END IF
      END FUNCTION

  '========================================
  ' Méthode dimension du média
  '========================================
      SUB GetDimension
       DIM rect AS QRECT

       GetVideoRect(QVideo.handle,Rect)
       QVideo.width=rect.right-rect.left
       QVideo.height=rect.bottom-rect.top
      END SUB

  '==================================
  ' méthode position du media
  '==================================
      FUNCTION GetPosition AS LONG
       DIM Retval AS INTEGER
       DIM RetString AS STRING

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

  '========================================
  ' Méthode dimension du média
  '========================================
      SUB GetImgDimension(mediadim AS STRING)
       DIM sPos AS LONG
       DIM ePos AS LONG
       DIM left AS SHORT
       DIM top AS SHORT

       ePos=INSTR(,mediadim," ")
       left=VAL(MID$(mediadim,1,ePos))
       sPos=ePos+1
       ePos=INSTR(sPos,mediadim," ")
       top=VAL(MID$(mediadim,sPos,ePos-sPos))
       sPos=ePos+1
       ePos=INSTR(sPos,mediadim," ")
       QVideo.ImgWidth=VAL(MID$(mediadim,sPos,ePos-sPos))
       sPos=ePos+1
       QVideo.ImgHeight=VAL(MID$(mediadim,sPos,LEN(mediadim)-sPos))
      END SUB

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

       IF QVideo.FileOpen THEN
        RetString=SPACE$(128)
        Retval=mciSendVideo("status MEDIA mode",VARPTR(RetString),128,0)
        IF INSTR(RetString,"stopped")>0 THEN QVideo.GetMode=VD_STOP
        IF INSTR(RetString,"playing")>0 THEN QVideo.GetMode=VD_PLAY
        IF INSTR(RetString,"paused")>0 THEN QVideo.GetMode=VD_PAUSE
       END IF
      END FUNCTION

PUBLIC:

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

       QVideo.TIMER.enabled=False
       RetString=SPACE$(128)
       Retval=mciSendVideo("stop MEDIA",VARPTR(RetString),128,0)
       RetString=SPACE$(128)
       Retval=mciSendVideo("close MEDIA",VARPTR(RetString),128,0)
       QVideo.FileOpen=False
       QVideo.Lenght=0
       QVideo.LenghtTime=0
       QVideo.Left=0
       QVideo.Top=0
       QVideo.Width=0
       QVideo.Height=0
       QVideo.ImgWidth=0
       QVideo.ImgHeight=0
       QVideo.CurrentFrame=0
       QVideo.State=VD_CLOSE
      END SUB

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

       IF FileName<>"" THEN
        RetString=SPACE$(128)
        IF QVideo.PARENT<>0 THEN
         Retval=mciSendVideo("open "+FileName+" alias MEDIA parent "+ STR$(QVideo.PARENT)+" style child",VARPTR(RetString),128,0)
        ELSE
         IF QVideo.BorderStyle=0 THEN Style="popup"
         IF QVideo.BorderStyle<>0 THEN Style="overlapped"
         Retval=mciSendVideo("open "+FileName+" alias MEDIA style "+Style,VARPTR(RetString),128,0)
        END IF
        IF Retval=False THEN
         IF QVideo.PARENT=0 THEN
          IF QVideo.CAPTION<>"" THEN
           RetString=SPACE$(128)
           Retval=mciSendVideo("window MEDIA text "+QVideo.CAPTION,VARPTR(RetString),128,0)
          ELSE
           RetString=SPACE$(128)
           Retval=mciSendVideo("info MEDIA window text",VARPTR(RetString),128,0)
           IF Retval=False THEN QVideo.CAPTION=RetString
          END IF
         END IF
         RetString=SPACE$(128)
         Retval=mciSendVideo("set MEDIA time format milliseconds",VARPTR(RetString),128,0)
         RetString=SPACE$(128)
         Retval=mciSendVideo("status MEDIA length",VARPTR(RetString),128,0)
         IF Retval=False THEN QVideo.LenghtTime=VAL(RetString)/1000
         RetString=SPACE$(128)
         Retval=mciSendVideo("set MEDIA time format frames",VARPTR(RetString),128,0)
         RetString=SPACE$(128)
         Retval=mciSendVideo("status MEDIA length",VARPTR(RetString),128,0)
         IF Retval=False THEN
          QVideo.Lenght=VAL(RetString)
          RetString=SPACE$(128)
          Retval=mciSendVideo("where MEDIA source",VARPTR(RetString),128,0)
          IF Retval=False THEN
           QVideo.GetImgDimension(RetString)
           RetString=SPACE$(128)
           Retval=mciSendVideo("status MEDIA window handle",VARPTR(RetString),128,0)
           IF Retval=False THEN
            QVideo.handle=VAL(RetString)
            IF QVideo.PARENT<>0 THEN
             QVideo.Width=QVideo.ImgWidth
             QVideo.Height=QVideo.ImgHeight
            ELSE
             QVideo.GetDimension
            END IF
            QVideo.State=VD_STOP
            QVideo.CurrentFrame=0
            QVideo.FileOpen=True
            QVideo.OPEN=True
            FlagOpen=True
           END IF
          END IF
         END IF
        ELSE
         QVideo.ERROR=QVideo.GetMciDescription(Retval)
        END IF
        IF FlagOpen=False THEN QVideo.CLOSE
       END IF
      END FUNCTION

  '=================================
  ' méthode affichage media
  '=================================
      SUB Show
       DIM Retval AS INTEGER
       DIM RetString AS STRING

       IF QVideo.FileOpen THEN
        IF QVideo.PARENT=0 THEN SetForegroundVideo(QVideo.handle)
        RetString=SPACE$(128)
        Retval=mciSendVideo("window MEDIA state show",VARPTR(RetString),128,0)
       END IF
      END SUB

  '==================================
  ' méthode lecture du media
  '==================================
      SUB Play
       DIM Retval AS INTEGER
       DIM RetString AS STRING

       IF QVideo.FileOpen THEN
        QVideo.TIMER.enabled=True
        IF QVideo.PARENT=0 THEN SetForegroundVideo(QVideo.handle)
        RetString = SPACE$(128)
        Retval=mciSendVideo("play MEDIA from "+STR$(QVideo.CurrentFrame),VARPTR(RetString),128,0)
        IF Retval=False THEN QVideo.State=VD_PLAY
       END IF
      END SUB

  '==================================
  ' méthode arret du media
  '==================================
      SUB Stop
       DIM Retval AS INTEGER
       DIM RetString AS STRING

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

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

       IF QVideo.FileOpen=true AND QVideo.State=VD_PLAY THEN
        RetString=SPACE$(128)
        Retval=mciSendVideo("pause MEDIA",VARPTR(RetString),128,0)
        IF Retval=False THEN
         QVideo.State=VD_PAUSE
         QVideo.TIMER.enabled=False
         QVideo.CurrentFrame=QVideo.GetPosition
        END IF
       END IF
      END SUB

  '=======================================
  ' évenement changementposition du media
  '=======================================
      EVENT TIMER.OnTimer
       DIM currentTime AS LONG

       QVideo.currentFrame=QVideo.GetPosition
       currentTime=INT(QVideo.currentFrame*(QVideo.LenghtTime/QVideo.Lenght))
       QVideo.State=QVideo.GetMode
       IF QVideo.State=VD_STOP THEN QVideo.Stop
       IF QVideo.OnChange<>0 THEN CALLFUNC(QVideo.OnChange,QVideo.currentFrame,currentTime)
      END EVENT

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

2013-06-19 07:50