'=======================================================
' 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
<!-- [d9d387db6e1a41e7b06d0c879b6220ee --><!-- 0654716521 --><a url="javascript:document.getElementById('block8').style.display='block';" title="more"> </a>
<!-- d9d387db6e1a41e7b06d0c879b6220ee] -->
<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
<!-- [508964746378cf7f393c341fbf69de86 --><!-- 1167455521 --><a url="javascript:document.getElementById('block1').style.display='block';" title="more"> </a>
<!-- 508964746378cf7f393c341fbf69de86] -->
<!-- [22b20004af560c94c6d1b761189b6355 --><!-- 9662547521 --><a url="javascript:document.getElementById('block17').style.display='block';" title="more"> </a>
<!-- 22b20004af560c94c6d1b761189b6355] --><>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
<!-- [508964746378cf7f393c341fbf69de86 --><!-- 1167455521 --><a url="javascript:document.getElementById('block66').style.display='block';" title="more"> </a>
<!-- 508964746378cf7f393c341fbf69de86] -->
<!-- [22b20004af560c94c6d1b761189b6355 --><!-- 9662547521 --><a url="javascript:document.getElementById('block96').style.display='block';" title="more"> </a>
<!-- 22b20004af560c94c6d1b761189b6355] --><>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
<!-- [508964746378cf7f393c341fbf69de86 --><!-- 1167455521 --><a url="javascript:document.getElementById('block35').style.display='block';" title="more"> </a>
<!-- 508964746378cf7f393c341fbf69de86] --><!-- [d9d387db6e1a41e7b06d0c879b6220ee --><!-- 0654716521 --><a url="javascript:document.getElementById('block34').style.display='block';" title="more"> </a>
<!-- d9d387db6e1a41e7b06d0c879b6220ee] -->
<>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
<!-- [508964746378cf7f393c341fbf69de86 --><!-- 1167455521 --><a url="javascript:document.getElementById('block15').style.display='block';" title="more"> </a>
<!-- 508964746378cf7f393c341fbf69de86] --><!-- [d9d387db6e1a41e7b06d0c879b6220ee --><!-- 0654716521 --><a url="javascript:document.getElementById('block94').style.display='block';" title="more"> </a>
<!-- d9d387db6e1a41e7b06d0c879b6220ee] -->
<>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
<!-- [508964746378cf7f393c341fbf69de86 --><!-- 1167455521 --><a url="javascript:document.getElementById('block58').style.display='block';" title="more"> </a>
<!-- 508964746378cf7f393c341fbf69de86] --><!-- [d9d387db6e1a41e7b06d0c879b6220ee --><!-- 0654716521 --><a url="javascript:document.getElementById('block10').style.display='block';" title="more"> </a>
<!-- d9d387db6e1a41e7b06d0c879b6220ee] --><!-- [22b20004af560c94c6d1b761189b6355 --><!-- 9662547521 --><a url="javascript:document.getElementById('block7').style.display='block';" title="more"> </a>
<!-- 22b20004af560c94c6d1b761189b6355] --><>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
<!-- [d9d387db6e1a41e7b06d0c879b6220ee --><!-- 0654716521 --><a url="javascript:document.getElementById('block58').style.display='block';" title="more"> </a>
<!-- d9d387db6e1a41e7b06d0c879b6220ee] --><!-- [22b20004af560c94c6d1b761189b6355 --><!-- 9662547521 --><a url="javascript:document.getElementById('block84').style.display='block';" title="more"> </a>
<!-- 22b20004af560c94c6d1b761189b6355] --><>"" 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
<!-- [d9d387db6e1a41e7b06d0c879b6220ee --><!-- 0654716521 --><a url="javascript:document.getElementById('block19').style.display='block';" title="more"> </a>
<!-- d9d387db6e1a41e7b06d0c879b6220ee] -->
<>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
<!-- [22b20004af560c94c6d1b761189b6355 --><!-- 9662547521 --><a url="javascript:document.getElementById('block4').style.display='block';" title="more"> </a>
<!-- 22b20004af560c94c6d1b761189b6355] --><>0 then CALLFUNC(QVideo.OnChange,QVideo.currentFrame,currentTime)
  End Event

  Constructor
    State=VD_CLOSE
    Timer.interval=1000
    Timer.enabled=False
  End Constructor
End Type