2004-02-23 07:10

' RQ_DvixPlayer_V1_0.bas for RapidQ
' Coded by Gérald VERDIER - BinoclaR (°-°) software
' February 2004
' email : gerald.verdier@club-internet.fr
' PURPOSE : Dvix player with options
'
     DECLARE FUNCTION GetShortPathName LIB "kernel32" ALIAS "GetShortPathNameA" (lpszLongPath AS STRING, lpszShortPath AS LONG, lBuffer AS LONG) AS LONG
     DECLARE FUNCTION mciSendString LIB "winmm.dll" ALIAS "mciSendStringA" (lpstrComd AS STRING, lpstrRStr AS LONG, uRLength AS LONG, hwndCallb AS LONG) AS LONG
     DECLARE FUNCTION GetKeyState LIB "user32"  ALIAS "GetKeyState" (nVirtKey AS LONG) AS INTEGER
     DECLARE FUNCTION GetShortPath(strFileName AS STRING) AS STRING
     DECLARE FUNCTION FormatTime(lTime AS LONG) AS STRING
     DECLARE SUB OpenAVI
     DECLARE SUB Quit
     DECLARE SUB ShortPath
     DECLARE SUB play
     DECLARE SUB stop
     DECLARE SUB pause
     DECLARE SUB CLOSE
     DECLARE SUB timerDV
     DECLARE SUB totalframes
     DECLARE SUB TotalTime
     DECLARE SUB posBarChg
     DECLARE SUB Mute
     DECLARE SUB volume
     DECLARE SUB init
     DECLARE SUB Fullscreen
     DECLARE SUB Nscreen
     DECLARE SUB BoxChecked
     DECLARE SUB seconds5(sender AS QBUTTON)
     DECLARE SUB findcodec
     DECLARE SUB fourcc
     DECLARE SUB openIE
     DECLARE SUB Speed(sender AS QBUTTON)
     DECLARE SUB About

     CONST clMarine = &H5F1315
     CONST clGreyBlue = &H9C7C7B
     CONST False = 0
     CONST True = 1

     DIM MemF AS QMEMORYSTREAM
     DIM Nfile AS QFILESTREAM

     DIM cdg AS QOPENDIALOG
     DIM LogoFont AS QFONT
     LogoFont.name = "Webdings"
     LogoFont.size = 18
     DIM Logo2Font AS QFONT
     Logo2Font.name = "Webdings"
     Logo2Font.size = 16
     Logo2Font.COLOR = clGreyBlue
     DIM Bfont AS QFONT
     Bfont.name = "Arial"
     Bfont.AddStyles(fsBold)
     Bfont.size = 14
     BFont.COLOR = clMarine
     DIM Sfont AS QFONT
     Sfont.AddStyles(fsBold)
     Sfont.size = 11
     DIM dvTimer AS QTIMER
     dvTimer.onTimer = TimerDV
     dvTimer.interval = 1
     dvTimer.enabled = false

     DIM ff$
     DIM f$
     DIM file$
     DIM mvalue AS STRING * 256
     DIM sTime$
     DIM sPos$
     DIM top$
     DIM w$
     DIM h$
     DIM fourcc$
     DIM codec$
     DIM fscreen AS BYTE
     DIM playing AS BYTE

     Application.ShowHint = 1

     CREATE FormC AS QFORM
      CAPTION = "Find the AVI file codec and open internet site with links for codec"
      Width = 400
      Height = 100
      BorderStyle = 4
      Center
      Borderstyle = 4
      CREATE PanelC AS QPANEL
       CAPTION = "Look at : www.fourcc.org for informations on codec"
       Left = 5
       Top = 4
       CAPTION = ""
       Width = 386
       Height = 70
       CREATE LabelC AS QLABEL
        CAPTION = "FourCC - Codec = "
        Left = 8
        Top = 8
        Width = 100
        Height = 21
        Transparent = 1
       END CREATE
       CREATE infoCodecLbl AS QLABEL
        CAPTION = ""
        font = sfont
        Left = 142
        Top = 8
        Width = 256
        Height = 21
        Transparent = 1
       END CREATE
       CREATE ieBt AS QCOOLBTN
        left = 280
        height = 20
        top = 8
        Width = 100
        CAPTION = "Internet !"
        ShowHint = 1
        hint = "Click to open www.fourcc.org"
        onClick = openIE
       END CREATE
      END CREATE
     END CREATE

     CREATE DVForm AS QFORM
      COLOR = 0
      Borderstyle = 0
     END CREATE

     CREATE Form AS QFORM
      COLOR = clGreyBlue
      CAPTION = "RQ Dvix player v1.0"
      Width = 605
      Height = 124
      top = screen.height - 170
      left = (screen.width/2) - (form.width/2)
      Borderstyle = 4
      onShow = init
      onClose = Quit
      CREATE Panel1 AS QPANEL
       Left = 2
       Top = 1
       Width = 595
       Height = 48
       CREATE lblSpide AS QLABEL
        CAPTION = CHR$(184) '"!"
        font = Logofont
        Left = 1
        Top = 2
        Width = 20
            'LabelStyle = 2
       END CREATE
       CREATE lblTime AS QLABEL
        CAPTION = "-"
        font = Bfont
        Left = 30
        Top = 2
        Width = 100
        LabelStyle = 2
       END CREATE
       CREATE lblTotalT AS QLABEL
        CAPTION = "-"
        font = Bfont
        Left = 120
        Top = 2
        Width = 100
        LabelStyle = 2
       END CREATE
       CREATE lblFrmTotal AS QLABEL
        CAPTION = "-"
        font = Sfont
        Left = 240
        Top = 5
        Width = 200
        Transparent = 1
        LabelStyle = 2
       END CREATE
       CREATE lblWatch AS QLABEL
        CAPTION = CHR$(161)
        font = Logo2Font
        Left = 210
        Top = 1
        Width = 25
       END CREATE
       CREATE PositionGauge AS QGAUGE
        Left = 24
        Top = 25
        Width = 548
        Height = 9
        kind = gkHorizontalBar
        ShowText = false
        BackColor = clGreyBlue
        ForeColor = clPaleYellow
       END CREATE
       CREATE DVslide AS QSCROLLBAR
        Left = 7
        Top = 35
        Width = 582
        Height = 9
        onChange = posBarChg
        SmallChange = 100
        LargeChange = 1000
       END CREATE
       CREATE volumeSlide AS QSCROLLBAR
        Left = 450
        Top = 8
        Width = 140
        Height = 9
        Max = 100
        onChange = volume
       END CREATE
       CREATE lblvolume AS QLABEL
        Left = 378
        Top = 6
        Width = 50
        Height = 29
       END CREATE
       CREATE lblEar AS QLABEL
        CAPTION = "X"
        font = Logo2Font
        Left = 350
        Top = 1
        Width = 25
       END CREATE
      END CREATE
      CREATE Panel2 AS QPANEL
       Left = 2
       Top = 50
       Width = 595
       Height = 40
       CREATE lblcodec AS QLABEL
        CAPTION = "Codec"
        Left = 505
        Top = 3
        Width = 50
        ShowHint = 1
        hint = "Codec in use"
       END CREATE
       CREATE codecB AS QBUTTON
        CAPTION = "?"
        font = sFont
        Left = 540
        Top = 2
        Width = 50
        Height = 18
        ShowHint = 1
        hint = "Click for informations about this Codec"
        onClick = fourcc
       END CREATE
       CREATE lblspeed AS QLABEL
        CAPTION = "Speed"
        Left = 505
        Top = 23
        Width = 50
        ShowHint = 1
        hint = "Slow motion/Speeded up"
       END CREATE
       CREATE Speed1B AS QBUTTON
        CAPTION = "-"
        font = sFont
        Left = 540
        Top = 22
        Width = 16
        Height = 15
        ShowHint = 1
        hint = "Speed -"
        onClick = Speed
        Tag = 101
       END CREATE
       CREATE Speed2B AS QBUTTON
        CAPTION = "+"
        font = sFont
        Left = 574
        Top = 22
        Width = 16
        Height = 15
        ShowHint = 1
        hint = "Speed +"
        onClick = Speed
        Tag = 102
       END CREATE
       CREATE SpeedNB AS QBUTTON
        CAPTION = "I"
        font = sFont
        Left = 557
        Top = 22
        Width = 16
        Height = 15
        ShowHint = 1
        hint = "Normal speed"
        onClick = Speed
        Tag = 100
       END CREATE
      END CREATE

      CREATE RewB AS QBUTTON
       CAPTION = "7"
       font = LogoFont 'Bfont
       Left = 43
       Top = 52
       Width = 35
       Height = 33
       Tag = 2
       ShowHint = 1
       hint = "-5 seconds"
       onClick = seconds5
      END CREATE
      CREATE PauseB AS QBUTTON
       CAPTION = ";"
       font = LogoFont
       Left = 78
       Top = 52
       Width = 35
       Height = 33
       Tag = 0
       ShowHint = 1
       hint = "Pause/Play"
       onClick = pause
      END CREATE
      CREATE captureB AS QBUTTON
       CAPTION = "?"
       font = BFont
       Left = 8
       Top = 52
       Width = 35
       Height = 33
       ShowHint = 1
       hint = "About"
       onClick = About
       Tag = 1
      END CREATE
      CREATE StopB AS QBUTTON
       CAPTION = "<"
       font = LogoFont
       Left = 113
       Top = 52
       Width = 35
       Height = 33
       ShowHint = 1
       hint = "Stop"
       onClick = stop
       Tag = 3
      END CREATE
      CREATE FFB AS QBUTTON
       CAPTION = "8"
       font = LogoFont
       Left = 148
       Top = 52
       Width = 35
       Height = 33
       ShowHint = 1
       hint = "+5 seconds"
       Tag = 4
       onClick = seconds5
      END CREATE
      CREATE CloseB AS QBUTTON
       CAPTION = "r"
       font = LogoFont
       Left = 183
       Top = 52
       Width = 35
       Height = 33
       ShowHint = 1
       hint = "Close Dvix"
       onClick = CLOSE
       Tag = 5
      END CREATE
      CREATE OpenB AS QBUTTON
       CAPTION = "5"
       font = LogoFont
       Left = 218
       Top = 52
       Width = 35
       Height = 33
       onClick = OpenAVI
       ShowHint = 1
       hint = "Open Dvix"
       Tag = 6
      END CREATE
      CREATE QuitB AS QBUTTON
       CAPTION = CHR$(211)
       font = LogoFont
       Left = 253
       Top = 52
       Width = 35
       Height = 33
       ShowHint = 1
       hint = "Quit"
       onClick = Quit
       Tag = 7
      END CREATE
      CREATE RadioButton1 AS QRADIOBUTTON
       CAPTION = "Elapsed time"
       Left = 300
       Top = 70
       Width = 100
      END CREATE
      CREATE RadioButton2 AS QRADIOBUTTON
       CAPTION = "Time remaining"
       Left = 405
       Top = 70
       Width = 100
      END CREATE
      CREATE MuteBox AS QCHECKBOX
       CAPTION = "Mute"
       Left = 300
       Top = 52
       Width = 100
       onClick = mute
      END CREATE
      CREATE VisibleBox AS QCHECKBOX
       CAPTION = "Full screen"
       Left = 405
       Top = 52
       Width = 100
       onClick = BoxChecked
      END CREATE
      SHOWMODAL
     END CREATE

     SUB init
      RadioButton1.Checked = true
      volumeSlide.position = 100
      lblVolume.CAPTION = "Audio = " + STR$(INT(volumeSlide.position)) + "%"
      f$ = ""
     END SUB


     SUB OpenAVI
      cdg.Filter = "Média (*.avi)|*.avi"
      cdg.FilterIndex = 1
      cdg.CAPTION = "Select File AVI"
      IF cdg.EXECUTE THEN
       df$=""
       f$ = cdg.filename
       findcodec
       FOR i = LEN(f$) TO 1 STEP -1
        a$ = MID$(f$,i,1)
        IF a$ = "\" THEN EXIT FOR
        df$ = df$+a$
       NEXT
       file$ = reverse$(df$)
       ff$ = GetShortPath(f$)
       mciSendString ("open " + ff$ + " type MpegVideo " + "parent " + STR$(DVform.handle) + " style 1073741824" , 0, 0, 0)
       mciSendString ("set " + ff$ + " still file format jpeg", 0, 0, 0)
       mciSendString ("Where " + ff$ + " destination", VARPTR(mvalue), LEN(mvalue)-1,0)
       totaltime
       Nscreen
       play
       findcodec
      END IF
     END SUB

     SUB Quit
      mciSendString ("close all", 0, 0, 0)
      Application.Terminate
     END SUB

     SUB Nscreen
      IF VisibleBox.checked = false THEN
       mStart = INSTR(1, mValue, " ")
       mPosition = INSTR(mStart + 1, mValue, " ")
       mStart = INSTR(mPosition + 1, mValue, " ")
       Width$ = MID$(mValue, mPosition, mStart - mPosition)
       Height$ = MID$(mValue, mStart + 1)
       IF dvform.Height <> (VAL(Height$) + 20) THEN
        dvform.Height = VAL(Height$) + 20
       END IF
       IF dvform.Width <> (VAL(Width$) + 20) THEN
        dvform.Width = VAL(Width$) + 20
       END IF
       DVform.top = screen.height - (INT(form.height*1.5) + (VAL(Height$))+5)
       DVform.left = (screen.width/2) - (dvform.width/2)
       mciSendString ("put " + Ff$ + " window at 10 10 " + Width$ + " " + Height$, 0, 0, 0)
       DVform.show
       fscreen = false
      END IF
     END SUB

     SUB play
      DVtimer.enabled = true
      mciSendString ("play " + Ff$ + " from " + STR$(DVslide.position), 0, 0, 0)
      form.CAPTION = file$ + "    Play"
      playing = true
     END SUB

     SUB stop
      IF playing = true THEN
       pauseB.CAPTION = "4"
       form.CAPTION = file$ + "    Stop"
       DVslide.position = 0
       positionGauge.position = 0
       mciSendString ("play " + Ff$ + " from " + STR$(DVslide.position), 0, 0, 0)
       mciSendString ("stop " + ff$,0,0,0)
       playing = false
      END IF
     END SUB

     SUB CLOSE
      mciSendString ("close " + ff$, 0, 0, 0)
      playing = false
      form.CAPTION = file$ + "    No Dvix"
      DVslide.position = 0
      DVform.CLOSE
     END SUB

     SUB Pause
      pausedv = false
      IF Playing = true THEN
       mciSendString ("pause " + ff$, 0, 0, 0)
       Playing = False
       pausedv = true
       form.CAPTION = file$ + "    Pause"
       pauseB.CAPTION = "4"
      END IF
      IF pausedv = false THEN
       mciSendString ("resume " + ff$, 0, 0, 0)
       pausedv = false
       playing = true
       form.CAPTION = file$ + "    Lecture"
       pauseB.CAPTION = ";"
      END IF
     END SUB

     FUNCTION GetShortPath(strFileName AS STRING) AS STRING
      DIM lngRes AS LONG
      strPath$ = STRING$(165, 0)
      lngRes = GetShortPathName(strFileName, VARPTR(strPath$), 164)
      GetShortPath = LEFT$(strPath$, lngRes)
     END FUNCTION

     FUNCTION FormatTime(gpos AS LONG) AS STRING
      DIM lHour AS LONG
      DIM lMinute AS LONG
      DIM lSecond AS LONG
      lTime = lTime / 1000
      lHour = INT(lTime / 3600)
      lMinute = INT((lTime - 3600 * lHour) / 60)
      lSecond = lTime - 3600 * lHour - 60 * lMinute
      IF lSecond < 10 AND lMinute < 10 THEN
       FormatTime = STR$(lHour) + ":0" + STR$(lMinute) + ":0" + STR$(lSecond)
      END IF
      IF lSecond < 10 AND lMinute > 9 THEN
       FormatTime = STR$(lHour) + ":" + STR$(lMinute) + ":0" + STR$(lSecond)
      END IF
      IF lSecond > 9 AND lMinute < 10 THEN
       FormatTime = STR$(lHour) + ":0" + STR$(lMinute) + ":" + STR$(lSecond)
      END IF
      IF lSecond > 9 AND lMinute > 9 THEN
       FormatTime = STR$(lHour) + ":" + STR$(lMinute) + ":" + STR$(lSecond)
      END IF
     END FUNCTION

     SUB TimerDV
      IF GetKeyState (&h02) < 0 AND fscreen = true THEN form.show
      IF playing = true THEN
       DIM cpos$ AS STRING * 32
       mciSendString ("status " + ff$ + " position", VARPTR(cpos$), 32, 0&) '&h2)
       gpos = VAL(cpos$)
       sPos$ = LEFT$(cpos$, INSTR(cpos$, CHR$(0)) - 1)
       IF RadioButton1.checked = true THEN
        lblTime.CAPTION = FormatTime(VAL(spos$))
       ELSE
        lblTime.CAPTION = FormatTime(VAL(sTime$) - VAL(spos$))
       END IF
       lblFrmTotal.CAPTION = "[ " + TIME$ + " ]"
       positionGauge.position = INT(VAL(spos$)/1000)
      END IF
     END SUB

     SUB TotalTime
      DIM TTime$ AS STRING * 128
      mciSendString ("set " + ff$ + " time format milliseconds", VARPTR(TTime$), 128, 0&)
      mciSendString ("status " + ff$ + " length", VARPTR(TTime$), 128, 0&)
      mciSendString ("set " + ff$ + " time format frames", 0&, 0&, 0&)
      lTTime = VAL(TTime$)
      sTime$ = LEFT$(TTime$, INSTR(TTime$, CHR$(0))-1)
      lblTotalT.CAPTION = FormatTime(VAL(sTime$))
      positionGauge.max = INT(lTTime/1000)
      DVslide.max = INT(lTTime/1000)
     END SUB

     SUB posBarChg
      DVpos = DVslide.position
      mciSendString ("pause " + ff$, 0, 0, 0)
      mciSendString ("play " + Ff$ + " from " + STR$(DVslide.position*1000), 0, 0, 0)
     END SUB

     SUB mute
      IF muteBox.checked = true THEN
       mciSendString ("set " + ff$ + " audio all off", 0&, 0&, 0&)
       Form.CAPTION = file$ + "    Lecture "+"- audio : Mute"
      ELSE
       mciSendString ("set " + ff$ + " audio all on", 0&, 0&, 0&)
       form.CAPTION = file$ + "    Lecture"
      END IF
     END SUB

     SUB volume
      mciSendString ("setaudio " + ff$ + " volume to " + STR$(INT(volumeSlide.position)), 0, 0, 0)
      lblVolume.CAPTION = "Audio = " + STR$(INT(volumeSlide.position)) + "%"
     END SUB

     SUB seconds5(sender AS QBUTTON)
      opt = sender.tag
      SELECT CASE opt
      CASE 2
       mciSendString ("play " + Ff$ + " from " + STR$(VAL(spos$) - 5000), 0, 0, 0)
      CASE 4
       mciSendString ("play " + Ff$ + " from " + STR$(VAL(spos$) + 5000), 0, 0, 0)
      END SELECT
     END SUB

     SUB fullscreen
      IF VisibleBox.checked = true THEN
       mStart = INSTR(1, mValue, " ")
       mPosition = INSTR(mStart + 1, mValue, " ")
       mStart = INSTR(mPosition + 1, mValue, " ")
       Width$ = MID$(mValue, mPosition, mStart - mPosition)
       Height$ = MID$(mValue, mStart + 1)
       ratio = VAL(height$) / VAL(Width$)
       w$ = STR$(screen.width)
       h$ = STR$(INT(screen.width * ratio))
       top = (INT(screen.height - VAL(h$)) / 2)
       top$ = STR$(top)
       DVform.top = 0
       DVform.left = 0
       DVform.height = screen.height
       DVform.width = screen.width
       mciSendString ("put " + Ff$ + " window client at 0 " + top$ + " " + W$ + " " + h$, 0, 0, 0)
       DVform.show
       fscreen = true
      END IF
      form.show
     END SUB

     SUB BoxChecked
      IF VisibleBox.checked = true THEN
       fullscreen
      ELSE
       Nscreen
      END IF
     END SUB

     SUB speed(sender AS QBUTTON)
      rspeed = 1
      speedOpt = sender.tag
      SELECT CASE speedOpt
      CASE 101
       rspeed = 2
       IF playing = true THEN
        mciSendString ("set " + Ff$ + " speed " + STR$(1000 / rspeed), 0, 0, 0)
       END IF
      CASE 102
       rspeed = 2
       IF playing = true THEN
        mciSendString ("set " + Ff$ + " speed " + STR$(1000 * rspeed), 0, 0, 0)
       END IF
      CASE 100
       rspeed = 2
       IF playing = true THEN
        mciSendString ("set " + Ff$ + " speed 1000", 0, 0, 0)
       END IF
      END SELECT
     END SUB

     SUB findCodec   '==============find Codec===========
      f = FILEEXISTS("c:\windows\fonts\Webdings.ttf")
      Nfile.OPEN(f$, FmOpenRead)
      IF f$ = "" OR f = false THEN
       SHOWMESSAGE "You must have Webdings font on your computer"
       NFile.CLOSE
       EXIT SUB
      END IF
      MemF.CopyFrom(NFile,200 )
      NFile.Position = 188
      MemF.Position = 0
      MemF.position = 188
      codec$=MemF.readStr(4)
      CodecB.CAPTION = codec$
      NFile.CLOSE
      memF.CLOSE
     END SUB

     SUB fourcc
      formC.show
      IF f$ = "" THEN
       labelC.CAPTION = "Open a Dvix to know the codec"
      ELSE
       labelC.CAPTION = "FourCC - Codec = "
       infoCodecLbl.CAPTION = codec$
      END IF
     END SUB

     SUB openIE
      SHELL ("explorer.exe http://www.fourcc.org/index.php?http%3A//www.fourcc.org/links.php")
     END SUB

     SUB About
      SHOWMESSAGE "______By  Gérald VERDIER______"+CHR$(13)+_
       "______RQ Divix player v1.0_____"+CHR$(13)+_
       "_gerald.verdier@club-internet.fr_"+CHR$(13)+_
       "____________________________"
     END SUB

2004-02-23 07:10