2013-06-19 07:42

'----------------------------
'CDPLAY.BAS
'CD player for RapidQ
'Written 2003 by D. Folger
'Email: folger@bnv-bamberg.de
'----------------------------
     $OPTION ICON "cd.ico"
     $TYPECHECK ON
     $INCLUDE "Rapidq.inc"

     $RESOURCE PlayBmp AS "play.bmp"
     $RESOURCE StopBmp AS "stop.bmp"
     $RESOURCE PauseBmp AS "pause.bmp"
     $RESOURCE RewindBmp AS "rewind.bmp"
     $RESOURCE ForwardBmp AS "forward.bmp"
     $RESOURCE EjectBmp AS "eject.bmp"
     $RESOURCE NextBmp AS "next.bmp"
     $RESOURCE PrevBmp AS "prev.bmp"
     $RESOURCE CDIcon AS "cd.ico"

     DECLARE SUB PlayCD()
     DECLARE SUB OpenCD()
     DECLARE SUB StopCD()
     DECLARE SUB CloseCD
     DECLARE SUB PauseCD()
     DECLARE SUB EjectCD()
     DECLARE SUB NextTrack()
     DECLARE SUB PreviousTrack()
     DECLARE SUB Forward()
     DECLARE SUB Rewind()
     DECLARE SUB MouseUp()
     DECLARE SUB Update()
     DECLARE SUB getTrackLength(Track AS INTEGER)
     DECLARE SUB getCDLength()
     DECLARE SUB SetTrack(Track AS INTEGER)
     DECLARE SUB SetPos()
     DECLARE SUB GetTrack()
     DECLARE SUB Minimize()
     DECLARE FUNCTION mciSendString LIB "winmm.dll" ALIAS  "mciSendStringA" _
      (StrCommand AS STRING, ReturnString AS LONG, _
      ReturnLength AS LONG, hwndCallBack AS LONG) AS INTEGER

     DIM Pause AS INTEGER, Playing AS INTEGER
     DIM Track AS INTEGER, Tracks AS INTEGER
     DIM Fw AS INTEGER, Rw AS INTEGER
     DIM CDOpen AS INTEGER, retVal AS INTEGER
     Pause = 0 : Playing = 0
     FW = 0 : RW = 0

     CREATE myFont AS QFONT
      Name = "Arial"
      Size = 15
      COLOR =clGreen
     END CREATE

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

     CREATE Form AS QFORM
      CAPTION="CD Player"
      Width=280 : Height=160
      Center : COLOR = &hE1F7D8
      DelBorderIcons (2)
      onClose=CloseCD
      onShow=OpenCD
      WndProc = Minimize
      IcoHandle = CDIcon
      CREATE PlayBtn AS QCOOLBTN
       BmpHandle=PlayBmp
       Left=10 : Top=10
       Width=84 : Height=28
       Hint="Play" : ShowHint=1
       onClick=PlayCD
      END CREATE
      CREATE StopBtn AS QCOOLBTN
       BmpHandle=StopBmp
       Left=94 : Top=10
       Width=28 : Height=28
       Hint="Stop" : ShowHint=1
       Enabled=0
       onClick=StopCD
      END CREATE
      CREATE PauseBtn AS QCOOLBTN
       BmpHandle=PauseBmp
       Left=122 : Top=10
       Width=28 : Height=28
       Hint="Pause" : ShowHint=1
       onClick=PauseCD
       Enabled=0
      END CREATE

      CREATE PrevBtn AS QCOOLBTN
       BmpHandle=PrevBmp
       Left=10 : Top=40
       Width=28 : Height=28
       Hint="Previous track" : ShowHint=1
       onClick=PreviousTrack
       Enabled = 0
      END CREATE
      CREATE RewindBtn AS QBUTTON
       BmpHandle=RewindBmp
       Left=38 : Top=40
       Width=28 : Height=28
       Hint="Rewind" : ShowHint=1
       onMouseDown = Rewind
       Enabled=0
      END CREATE
      CREATE ForwardBtn AS QBUTTON
       BmpHandle=ForwardBmp
       Left=66 : Top=40
       Width=28 : Height=28
       onMouseDown = Forward
       Hint="Forward" : ShowHint=1
       Enabled=0
      END CREATE
      CREATE NextBtn AS QCOOLBTN
       BmpHandle=NextBmp
       Left=94 : Top=40
       Width=28 : Height=28
       Hint="Next track" : ShowHint=1
       onClick=NextTrack
       Enabled = 0
      END CREATE
      CREATE EjectBtn AS QCOOLBTN
       BmpHandle=EjectBmp
       Left=122 : Top=40
       Width=28 : Height=28
       Hint="Eject" : ShowHint=1
       onClick=EjectCD
      END CREATE

      CREATE InfoBar AS QSTATUSBAR
       SizeGrip=0
       AddPanels "Tracks: ","Total time: ","Track time: "
       Panel(0).width=58
       Panel(1).width=90
      END CREATE
      CREATE TimeLabel AS QPANEL
       Left = 25 : Top = 75
       Width = 110 : Height = 30
       COLOR = clBlack : CAPTION = "[01] 00:00"
       Font = myFont
       BevelOuter = 1
      END CREATE
      CREATE ListBox AS QLISTBOX
       Top = 10 : Left = 160
       Width = 100 : Height = 60
       onClick = GetTrack
      END CREATE
     END CREATE

     Form.SHOWMODAL

     SUB OpenCD
      DIM retval AS INTEGER
      DIM i AS INTEGER
      DIM s AS STRING : s = SPACE$(30)
      mciSendString("close all",0,0,0)
      cdOpen = 0
      retval = mciSendString("open CDAudio alias cd",0,0,0)
      IF retVal = 0 THEN
       mciSendString("set cd time format tmsf",0,0,0)
       mcisendstring("status cd media present",VARPTR(s),30,0)
       IF INSTR (s,"false") THEN
        TimeLabel.CAPTION = " no disc"
        CDOpen = 0
       ELSE
        cdOpen = 1
        mciSendString("status cd number of tracks wait",VARPTR(s),30,0)
        Tracks = VAL(s)
        FOR i = 1 TO Tracks
         ListBox.AddItems "Track " & STR$(i)
        NEXT
        ListBox.ItemIndex = 0
        InfoBar.Panel(0).CAPTION = "Tracks: " & STR$(Tracks)
        Track = 1
        getTrackLength(Track)
        getCDLength
        PlayBtn.Enabled = 1
        CDOpen = 1
       END IF
      ELSE
       TimeLabel.CAPTION = "error"
      END IF
     END SUB

     SUB SetTrack(Track)
      mciSendString("seek cd to " & STR$(Track),0,0,0)
     END SUB

     SUB NextTrack
      IF Track < Tracks THEN
       INC Track
       setTrack(Track)
       getTrackLength(Track)
       IF Track = Tracks THEN NextBtn.Enabled = 0
       IF Playing THEN PlayCD
      END IF
     END SUB

     SUB PreviousTrack
      IF Track > 1 THEN
       DEC Track
       setTrack(Track)
       getTrackLength(Track)
       IF Track = 1 THEN PrevBtn.Enabled = 0
       IF Playing THEN PlayCD
      END IF
     END SUB

     SUB Update
      DIM retval AS INTEGER
      DIM s AS STRING : s = SPACE$(30)
      IF Fw = 0 AND Rw = 0 THEN
       retval = mciSendString("status cd position", VARPTR(s),30,0)
       IF retval THEN
        TimeLabel.CAPTION = "no disc"
        openCD
       ELSE
        Timelabel.CAPTION = "[" & MID$(s,1,2) & "] " & MID$(s,4,5)
       END IF
       GetTrackLength( VAL( MID$(s,1,2)))
      ELSE
       Timelabel.CAPTION = "- - : - -"
      END IF
     END SUB

     SUB getTrackLength(Track)
      DIM s AS STRING : s = SPACE$(30)
      mciSendString("status cd length track " & STR$(Track),VARPTR(s),30,0)
      InfoBar.Panel(2).CAPTION = "Track time: " & LEFT$(s,5)
      IF Track = Tracks THEN NextBtn.Enabled = 0
      IF Track = 1 THEN PrevBtn.Enabled = 0
     END SUB

     SUB getCDLength
      DIM s AS STRING : s = SPACE$(30)
      mciSendString("status cd length",VARPTR(s),30,0)
      InfoBar.Panel(1).CAPTION = "Total time: " & LEFT$(s,5)
     END SUB

     SUB PlayCD
      IF CDOpen = 0 THEN OpenCD
      myTimer.Enabled = 1
      StopBtn.enabled = 1
      PauseBtn.Enabled = 1
      ForwardBtn.Enabled = 1
      RewindBtn.Enabled = 1
      IF Track > 1 THEN PrevBtn.Enabled = 1
      IF Track < Tracks THEN NextBtn.Enabled = 1
      setTrack(Track)
      retval = mciSendString ("play cd from " & STR$(Track),0,0,0)
      Playing = 1
     END SUB

     SUB StopCD
      mciSendString("stop cd",0,0,0)
      mciSendString("seek cd to start",0,0,0)
      myTimer.Enabled = 0
      PauseBtn.Enabled = 0
      ForwardBtn.Enabled = 0
      RewindBtn.Enabled = 0
      StopBtn.Enabled = 0
      PrevBtn.Enabled = 0
      IF Track > 1 THEN PrevBtn.Enabled = 1
      NextBtn.Enabled = 0
      IF Track < Tracks THEN NextBtn.Enabled = 1
      Playing = 0
     END SUB

     SUB CloseCD
      myTimer.Enabled = 0
      StopCD
      mciSendString("close cd",0,0,0)
      CDOpen = 0
     END SUB

     SUB PauseCD
      Pause = Pause XOR 1
      IF Pause THEN
       myTimer.Enabled = 0
       PrevBtn.Enabled = 0
       NextBtn.Enabled = 0
       RewindBtn.Enabled = 0
       ForwardBtn.Enabled = 0
       EjectBtn.Enabled = 0
       TimeLabel.CAPTION = "Pause"
       mciSendString("pause cd",0,0,0)
      ELSE
       RewindBtn.Enabled = 1
       ForwardBtn.Enabled = 1
       IF Track < Tracks THEN NextBtn.Enabled = 1
       IF Track > 1 THEN PrevBtn.Enabled = 1
       EjectBtn.Enabled = 1
       myTimer.Enabled = 1
       mciSendString("play cd",0,0,0)
      END IF
     END SUB

     SUB GetTrack
 ' get track number from ListView
      Track= ListBox.ItemIndex + 1
      SetTrack(Track)
      IF Track = 1 THEN PrevBtn.Enabled = 0
      IF Track = Tracks THEN NextBtn.Enabled = 0
      IF Playing THEN PlayCD
     END SUB


     SUB EjectCD
      myTimer.Enabled = 0
      mciSendString("set cd door open" ,0,0,0)
      CloseCD
     END SUB

     SUB Forward
      Fw = 1 : SetPos
     END SUB

     SUB Rewind
      Rw = 1 : SetPos
     END SUB

     SUB SetPos
      DIM  s AS STRING : s = SPACE$(30)
      DIM Second AS INTEGER
      mciSendString("set cd time format ms",0,0,0)
      mciSendString("status cd position ",VARPTR(s),30,0)
      Second = VAL(s)
      DO
       DOEVENTS
       IF Fw THEN INC Second, 1000 ELSE DEC Second,1000
       SLEEP .05
       ForwardBtn.onMouseup = MouseUp
       RewindBtn.onMouseup = MouseUp
      LOOP UNTIL Fw = 0 AND Rw = 0
      mciSendString("play cd from " & STR$(second),0,0,0)
      mciSendString("set cd time format tmsf",0,0,0)
     END SUB

     SUB MouseUp
      Fw = 0 : Rw = 0
     END SUB

2013-06-19 07:42