Option Explicit

Dim fastForwardSpeed As Long ' farten vid snabbspolning ff/rew
Dim fPlaying As Boolean ' true om CD spelas
Dim fCDLoaded As Boolean ' true om CD finns i spelaren
Dim numTracks As Integer ' antal spår på CD'n
Dim trackLength() As String ' array innehållande längden på varje spår
Dim track As Integer ' aktuellt spår
Dim min As Integer ' aktuell tid i minuter på spåret
Dim sec As Integer ' aktuell tid på spåret
Dim cmd As String ' sträng som lagrar mci kommandon

' Sänder ett MCI kommando
' Om fShowError är true, visas en meddelandebox med fel
Private Function SendMCIString(cmd As String, fShowError As Boolean) As Boolean
Static rc As Long
Static errStr As String * 200

rc = mciSendString(cmd, 0, 0, hWnd)
If (fShowError And rc <> 0) Then
mciGetErrorString rc, errStr, Len(errStr)
MsgBox errStr
End If
SendMCIString = (rc = 0)
End Function

Private Sub Form_Load()
' Om vi redan kör, avsluta
If (App.PrevInstance = True) Then
End
End If

' Initialiserar variabler
Timer1.Enabled = False
fastForwardSpeed = 5
fCDLoaded = False

' Om cd'n används- avsluta
If (SendMCIString("open cdaudio alias cd wait shareable", True) = False) Then
End
End If

SendMCIString "set cd time format tmsf wait", True
Timer1.Enabled = True

End Sub

Private Sub Form_Unload(Cancel As Integer)
'Stäng alla MCI enheter som öppnats av programmet
SendMCIString "close all", False
End Sub

' Spela CD'n
Private Sub play_Click()
SendMCIString "play cd", True
fPlaying = True
End Sub

' Stoppa spelningen
Private Sub stopbtn_Click()
SendMCIString "stop cd wait", True
cmd = "seek cd to " & track
SendMCIString cmd, True
fPlaying = False
Update
End Sub

' Pause på CD'n
Private Sub pause_Click()
SendMCIString "pause cd", True
fPlaying = False
Update
End Sub

' Eject CD
Private Sub eject_Click()
SendMCIString "set cd door open", True
Update
End Sub

' snabbspola framåt
Private Sub ff_Click()
Dim s As String * 40
SendMCIString "set cd time format milliseconds", True
mciSendString "status cd position wait", s, Len(s), 0
If (fPlaying) Then
cmd = "play cd from " & CStr(CLng(s) + fastForwardSpeed * 1000)
Else
cmd = "seek cd to " & CStr(CLng(s) + fastForwardSpeed * 1000)
End If
mciSendString cmd, 0, 0, 0
SendMCIString "set cd time format tmsf", True
Update
End Sub

' Återspola CD'n
Private Sub rew_Click()
Dim s As String * 40

SendMCIString "set cd time format milliseconds", True
mciSendString "status cd position wait", s, Len(s), 0
If (fPlaying) Then
cmd = "play cd from " & CStr(CLng(s) - fastForwardSpeed * 1000)
Else
cmd = "seek cd to " & CStr(CLng(s) - fastForwardSpeed * 1000)
End If
mciSendString cmd, 0, 0, 0
SendMCIString "set cd time format tmsf", True
Update
End Sub

' Framåt ett spår
Private Sub ftrack_Click()
If (track < numTracks) Then
If (fPlaying) Then
cmd = "play cd from " & track + 1
SendMCIString cmd, True
Else
cmd = "seek cd to " & track + 1
SendMCIString cmd, True
End If
Else
SendMCIString "seek cd to 1", True
End If
Update
End Sub

' Bakåt ett spår
Private Sub btrack_Click()
Dim from As String
If (min = 0 And sec = 0) Then
If (track > 1) Then
from = CStr(track - 1)
Else
from = CStr(numTracks)
End If
Else
from = CStr(track)
End If
If (fPlaying) Then
cmd = "play cd from " & from
SendMCIString cmd, True
Else
cmd = "seek cd to " & from
SendMCIString cmd, True
End If
Update
End Sub

' Updatera displayen och state variabler
Private Sub Update()
Static s As String * 30

' Är CD' i spelaren
mciSendString "status cd media present", s, Len(s), 0
If (CBool(s)) Then
' Aktiverar alla kontroller, hämtar CD information
If (fCDLoaded = False) Then
mciSendString "status cd number of tracks wait", s, Len(s), 0
numTracks = CInt(Mid$(s, 1, 2))
eject.Enabled = True

' Om cd'n endast har 1 track, är det troligen en data CD
If (numTracks = 1) Then
Exit Sub
End If

mciSendString "status cd length wait", s, Len(s), 0
totalplay.Caption = "Tracks: " & numTracks & " Total tid: " & s
ReDim trackLength(1 To numTracks)

Dim i As Integer
For i = 1 To numTracks
cmd = "status cd length track " & i
mciSendString cmd, s, Len(s), 0
trackLength(i) = s
Next

play.Enabled = True
pause.Enabled = True
ff.Enabled = True
rew.Enabled = True
ftrack.Enabled = True
btrack.Enabled = True
stopbtn.Enabled = True
fCDLoaded = True
SendMCIString "seek cd to 1", True
End If

' Updaterar track tiden i displayen
mciSendString "status cd position", s, Len(s), 0
track = CInt(Mid$(s, 1, 2))
min = CInt(Mid$(s, 4, 2))
sec = CInt(Mid$(s, 7, 2))
timeWindow.Text = "[" & Format(track, "00") & "] " & Format(min, "00") _
& ":" & Format(sec, "00")
tracktime.Caption = "Track tid: " & trackLength(track)

' Kontroll om CD'n spelar
mciSendString "status cd mode", s, Len(s), 0
fPlaying = (Mid$(s, 1, 7) = "playing")
Else
eject.Enabled = False

' Disable alla controls, rensa displayen
If (fCDLoaded = True) Then
play.Enabled = False
pause.Enabled = False
ff.Enabled = False
rew.Enabled = False
ftrack.Enabled = False
btrack.Enabled = False
stopbtn.Enabled = False
fCDLoaded = False
fPlaying = False
totalplay.Caption = ""
tracktime.Caption = ""
timeWindow.Text = ""
End If
End If
End Sub

' Sätter fast-forward speed
Private Sub ffspeed_Click()
Dim s As String
s = InputBox("Ange ny snabbspolningsfart i sekunder", "Snabbspolings fart", CStr(fastForwardSpeed))
If IsNumeric(s) Then
fastForwardSpeed = CLng(s)
End If
End Sub

Private Sub Timer1_Timer()
Update
End Sub