2013-06-19 07:42

'-----------------------------------------------
'Audioplay.bas for RapidQ version 1.1
'A little player for music files
'Supports many formats (MP3, MID, WAV...)
'Now with volume control
'This version: Bug fix and improvements
'Written 2003 by Dieter Folger
'Email: folger@bnv-bamberg.de
'-----------------------------------------------
     $TYPECHECK ON
     $OPTIMIZE ON
     $INCLUDE "rapidq.inc"
     $OPTION ICON "Music.ico"
     $RESOURCE PlayIcon AS "Music.ico"
     $RESOURCE PlayBmp AS "Play.bmp"
     $RESOURCE StopBmp AS "Stop.bmp"
     $RESOURCE PauseBmp AS "Pause.bmp"
     $RESOURCE BackBmp AS "Backw.bmp"
     $RESOURCE ForBmp AS "Forw.bmp"
     $RESOURCE SpeakBmp AS "Speak.bmp"

     DECLARE FUNCTION mciSendString LIB "winmm.dll" ALIAS  "mciSendStringA" _
      (StrCommand AS STRING, ReturnString AS LONG, _
      ReturnLength AS LONG, hwndCallBack AS LONG) AS INTEGER
     DECLARE FUNCTION GetShortPathName LIB "kernel32" ALIAS "GetShortPathNameA"_
      (lpszLongPath AS STRING, lpszShortPath AS LONG, lBuffer AS LONG) AS LONG
     DECLARE FUNCTION midiOutGetVolume LIB "winmm.dll" ALIAS "midiOutGetVolume"_
      (mDeviceID AS SHORT, dmVolume AS LONG) AS SHORT
     DECLARE FUNCTION midiOutSetVolume LIB "winmm.dll" ALIAS "midiOutSetVolume"_
      (mDeviceID AS SHORT, dmVolume AS LONG) AS SHORT
     DECLARE FUNCTION waveOutGetVolume LIB "winmm.dll" ALIAS "waveOutGetVolume"_
      (wDeviceID AS SHORT, dwVolume AS LONG) AS SHORT
     DECLARE FUNCTION waveOutSetVolume LIB "winmm.dll" ALIAS "waveOutSetVolume"_
      (wDeviceID AS SHORT, dwVolume AS LONG) AS SHORT

     DECLARE FUNCTION PlayTime AS INTEGER
     DECLARE FUNCTION GetPos AS INTEGER
     DECLARE FUNCTION SetPos(Second AS INTEGER) AS INTEGER
     DECLARE FUNCTION TimeString(Seconds AS INTEGER) AS STRING

     DECLARE SUB OpenAudio
     DECLARE SUB GetAudio
     DECLARE SUB PlayAudio
     DECLARE SUB StopAudio
     DECLARE SUB CloseAudio
     DECLARE SUB PauseAudio
     DECLARE SUB ExitProg
     DECLARE SUB Update
     DECLARE SUB Forward
     DECLARE SUB Rewind
     DECLARE SUB MouseUp
     DECLARE SUB Minimize
     DECLARE SUB ShowVol
     DECLARE SUB ChangeVol
     DECLARE SUB QuitVol

     DIM OpenDialog AS QOPENDIALOG
     DIM Pause AS INTEGER
     DIM retVal AS INTEGER
     DIM Playing AS INTEGER
     DIM Mins AS INTEGER
     DIM Second AS INTEGER
     DIM FW AS INTEGER
     DIM RW AS INTEGER
     DIM midi AS INTEGER
     DIM Position AS SINGLE
     DIM Length AS INTEGER
     DIM x AS LONG
     DIM v AS INTEGER
     DIM xh AS STRING
     DIM SoundFile AS STRING
     DIM TimePos AS STRING : TimePos = SPACE$(30)
     DIM mLength AS STRING : mLength = SPACE$(30)
     DIM PathString AS STRING : PathString = SPACE$(164)

     CREATE Form AS QFORM
      Center
      CAPTION = "AudioPlay"
      IcoHandle = PlayIcon
      DelBorderIcons (biMaximize)
      WndProc = Minimize
      Width = 220 : Height = 190
      COLOR = &hABFFFF
      onClose = ExitProg

      CREATE Menu AS QMAINMENU
       CREATE MenuFile AS QMENUITEM
        CAPTION = "&File"
        CREATE MenuLoad AS QMENUITEM
         CAPTION = "&Open"
         Onclick = GetAudio
        END CREATE
        CREATE MenuSep AS QMENUITEM
         CAPTION = "-"
        END CREATE
        CREATE MenuExit AS QMENUITEM
         CAPTION = "Exit"
         onClick = ExitProg
        END CREATE
       END CREATE
      END CREATE

      CREATE PlayBtn AS QCOOLBTN
       Left = 30 : Top = 10
       Width = 28 : Height = 28
       OnClick = PlayAudio
       BMPHandle = PlayBmp
       Enabled = 0
       Hint = "Play file" : ShowHint = 1
      END CREATE
      CREATE RewBtn AS QBUTTON
       Left = 60 : Top = 10
       Width = 28 : Height = 28
       OnMouseDown = Rewind
       OnMouseUp = MouseUp
       BMPHandle = BackBmp
       Enabled = 0
       Hint = "Rewind" : ShowHint = 1
      END CREATE
      CREATE ForwBtn AS QBUTTON
       Left = 90:Top = 10
       Width = 28 : Height = 28
       OnMouseDown = Forward
       OnMouseUp = MouseUp
       BMPHandle = ForBmp
       Enabled = 0
       Hint = "Fast forward" : ShowHint = 1
      END CREATE
      CREATE StopBtn AS QCOOLBTN
       Left = 120 : Top = 10
       Width = 28 : Height = 28
       OnClick = StopAudio
       BMPHandle = StopBmp
       Enabled = 0
       Hint = "Stop" : ShowHint = 1
      END CREATE
      CREATE PauseBtn AS QCOOLBTN
       Left = 150 : Top = 10
       Width = 28 : Height = 28
       onClick = PauseAudio
       BMPHandle = PauseBmp
       Enabled = 0
       Hint = "Pause" : ShowHint = 1
      END CREATE
      CREATE VolBtn AS QCOOLBTN
       Left = 180 : Top = 115
       Height = 23 : Width = 23
       BmpHandle = SpeakBmp
       onClick = ShowVol
       Hint = "Volume" : ShowHint = 1
      END CREATE

      CREATE Trackbar AS QTRACKBAR
       Left = 5 : Top = 60
       Width = 200 : Height = 21
       TickStyle = tsNone
      END CREATE

      CREATE FileLbl AS QLABEL
       Left = 10 : Top = 90
       Width = 200
       CAPTION = "No file to play"
      END CREATE
      CREATE TimeLbl AS QLABEL
       Left = 10 : Top = 110
      END CREATE
      CREATE PlayedLbl AS QLABEL
       Left = 100 : Top = 110
      END CREATE

      CREATE VolForm AS QFORM
       Top = 380 : Left = 335
       Height = 90 : Width = 130
       delBorderIcons(1,2)
       Visible = 0
       onClose = QuitVol
       COLOR = &hABFFFF
       CREATE VolLabel AS QLABEL
        Left = 10 : Top = 32
        CAPTION = "   -      Volume      +"
       END CREATE
       CREATE VolTrack AS QTRACKBAR
        Left = 10 : Top = 10
        Width = 100 : Height = 23
        Min = 0 : Max = 100
        onChange = ChangeVol
       END CREATE
      END CREATE
     END CREATE

     CREATE myTimer AS QTIMER
      Interval = 1000
      onTimer = Update
      Enabled = 0
     END CREATE

     Form.SHOWMODAL

     SUB GetAudio
      DIM ShortName AS LONG
      DIM SFile AS STRING
      OpenDialog.CAPTION = "Select File to play"
      OpenDialog.FileName = ""
      OpenDialog.Filter = "Media files | *.mid; *.rmi; *.wav; *.avi; *.mp3; *.mpg; *.mpe; *.mpeg | All files | *.*"
      IF OpenDialog.EXECUTE THEN
       SoundFile = OpenDialog.FileName
    'Get filename without path and extension
       SFile = MID$(SoundFile,1,LEN(SoundFile) - 4)
       FileLbl.CAPTION = "File: " & LEFT$(MID$(SFile,RINSTR(SFile,"\")+1),32)
       midi = 0
    'flag for MIDI volume control:
       IF RIGHT$(UCASE$(SoundFile),4) = ".MID" THEN midi = 1
       IF RIGHT$(UCASE$(SoundFile),4) = ".RMI" THEN midi = 1
       Shortname = GetShortPathName(SoundFile,VARPTR(PathString),164)
       SoundFile = LEFT$(PathString,ShortName)
       OpenAudio
      END IF
     END SUB

     SUB OpenAudio
      Form.Repaint
      mciSendString("close myfile",0,0,0)
      retval = mciSendString ("open " & SoundFile & " type MpegVideo alias myfile",0,0,0)
      IF Retval THEN
       FileLbl.CAPTION = "Error opening file"
       TimeLbl.CAPTION = ""
       PlayedLbl.CAPTION = ""
      ELSE
       TrackBar.Max = PlayTime
       TrackBar.Min = 0
       Length = TrackBar.Max
       TimeLbl.CAPTION = "Total time: " + TimeString(PlayTime)
       PlayedLbl.CAPTION = "Position: 00:00"
       PlayBtn.Enabled = 1
      END IF
     END SUB

     SUB PlayAudio
      myTimer.Enabled = 1
      mciSendString ("play myfile from 0",0,0,0)
      Playing = 1
      PauseBtn.Enabled = 1
      ForwBtn.Enabled = 1
      RewBtn.Enabled = 1
      StopBtn.Enabled = 1
     END SUB

     SUB StopAudio
      SetPos(0)
      mciSendString ("stop myfile",0,0,0)
      Playing = 0
      TrackBar.Position = 0
      PauseBtn.Enabled = 0
      ForwBtn.Enabled = 0
      RewBtn.Enabled = 0
      PlayBtn.Enabled = 1
      PlayedLbl.CAPTION = "Position: 00:00"
      myTimer.Enabled = 0
     END SUB

     SUB CloseAudio
      mciSendString ("close myfile",0,0,0)
      Playing = 0
      PauseBtn.Enabled = 0
      ForwBtn.Enabled = 0
      RewBtn.Enabled = 0
      PlayBtn.Enabled = 0
      TrackBar.Position = 0
      myTimer.Enabled = 0
     END SUB

     SUB PauseAudio
 'Toggle pause/play
      IF Playing THEN
       Pause = Pause XOR 1
       IF Pause THEN
        PlayBtn.Enabled = 0
        mciSendString ("pause myfile",0,0,0)
       ELSE
        PlayBtn.Enabled = 1
        mciSendString ("play myfile",0,0,0)
       END IF
      END IF
     END SUB

     SUB Update
 'Update trackbar and time label
      IF Playing THEN
       PlayedLbl.CAPTION = "Position: " & TimeString(GetPos)
       TrackBar.Position = GetPos
       TrackBar.SelEnd = 0
      END IF
     END SUB

     SUB ExitProg
      CloseAudio
      END
     END SUB

     SUB Forward
      Position = TrackBar.Position * 1000
      FW = 1
      DO
       DOEVENTS
       INC Position, 5
       TrackBar.SelStart = Position / 1000
       TrackBar.SelEnd = Length
      LOOP UNTIL FW = 0
     END SUB

     SUB Rewind
      Position = TrackBar.Position * 1000
      RW = 1
      DO
       DOEVENTS
       DEC Position, 5
       TrackBar.SelStart = 0
       TrackBar.SelEnd = Position / 1000
      LOOP UNTIL RW = 0
     END SUB

     SUB MouseUp
 'get forward/rewind value
      FW = 0 : RW = 0
      IF Position > Length * 1000 THEN Position = Length * 1000
      IF Position < 0 THEN Position = 0
      SetPos(Position)
     END SUB

     FUNCTION TimeString (Seconds)
 'convert seconds to mm:ss format
      IF Seconds < 60 THEN TimeString = "00:" & RIGHT$("0"+STR$(Seconds),2)
      IF Seconds > 59 THEN
       Mins = INT(Seconds / 60)
       Seconds = Seconds - (Mins * 60)
       TimeString = RIGHT$("0"+STR$(Mins),2) & ":" & RIGHT$("0"+STR$(Seconds),2)
      END IF
     END FUNCTION

     FUNCTION SetPos(Second)
 'set play position after forward/rewind action
      mciSendString ("set myfile time format ms", 0, 0, 0)
      IF Pause THEN
       mciSendString ("seek myfile to " & STR$(Second), 0, 0, 0)
      ELSE
       mciSendString("play myfile from " & STR$(Second), 0, 0, 0)
      END IF
     END FUNCTION

     FUNCTION GetPos
 'get current position of file (seconds)
      mciSendString ("set myfile time format ms", 0, 0, 0)
      mciSendString ("status myfile position ",VARPTR(TimePos),30,0)
      GetPos = ROUND(VAL(MID$(TimePos, 1, 30)) / 1000)
     END FUNCTION

     FUNCTION PlayTime
 'get length of file (seconds)
      mciSendString ("set myfile time format ms", 0, 0, 0)
      mciSendString ("status myfile length ",VARPTR(mLength), 30, 0)
      PlayTime = ROUND(VAL(MID$(mLength, 1, 30)) / 1000)
     END FUNCTION

     SUB ShowVol
      VolForm.Visible = 1
      IF midi THEN
       midiOutGetVolume (1, VARPTR(x))
      ELSE
       waveOutGetVolume (0, VARPTR(x))
      END IF
      xh = CONVBASE$(RIGHT$ (HEX$(x),4),16,10)
      v = ROUND(VAL(xh) / 655.36)
      VolTrack.Position = v
     END SUB

     SUB ChangeVol
 'from D. Glodt's qObject routines
      v = VolTrack.Position
      IF v > 50 THEN
       IF v = 100 THEN
        IF midi THEN
         midiOutSetVolume(1,&hFFFFFFFF)
        ELSE
         waveOutSetVolume(0,&hFFFFFFFF)
        END IF
       ELSE
        x = -((32767/50) * (100-v))
        IF midi THEN
         midiOutSetVolume(1,x+(x*65536))
        ELSE
         waveOutSetVolume(0,x+(x*65536))
        END IF
       END IF
      ELSE
       x = (32767/50) * v
       IF midi THEN
        midiOutSetVolume(1,x+(x*65536))
       ELSE
        waveOutSetVolume(0,x+(x*65536))
       END IF
      END IF
     END SUB

     SUB QuitVol
      VolForm.Visible = 0
     END SUB

2013-06-19 07:42