by Travis (1 Submission)
Category: Sound/MP3
Compatability: VB 6.0
Difficulty: Unknown Difficulty
Originally Published: Thu 25th October 2001
Date Added: Mon 8th February 2021
Rating: 
(1 Votes)
Cd player
API Declarations
Dim CurTrack As Integer
Dim play As Integer
Dim track As Integer
Dim min As Integer
Dim sec As Integer
VBcoders
mciSendString "play cd", 0, 0, 0
End Function
Function SetTrack(track%)
mciSendString "seek cd to " & Str(track), 0, 0, 0
End Function
Function StopPlay()
mciSendString "stop cd wait", 0, 0, 0
End Function
Function PausePlay()
mciSendString "pause cd", 0, 0, 0
End Function
Function EjectCD()
mciSendString "set cd door open", 0, 0, 0
End Function
Function CloseCD()
mciSendString "set cd door closed", 0, 0, 0
End Function
Function UnloadAll()
mciSendString "close all", 0, 0, 0
End Function
Function SetCDPlayerReady()
mciSendString "open cdaudio alias cd wait shareable", 0, 0, 0
End Function
Function SetFormat_tmsf()
mciSendString "set cd time format tmsf wait", 0, 0, 0
End Function
Function GetNumTracks%()
Dim s As String * 30
mciSendString "status cd number of tracks wait", s, Len(s), 0
GetNumTracks = CInt(Mid$(s, 1, 2))
End Function
Function GetCDLength$()
Dim s As String * 30
mciSendString "status cd length wait", s, Len(s), 0
GetCDLength = s
End Function
Sub GetCDPosition()
Dim s As String * 30
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))
Label2.Caption = "[" & Format(track, "00") & "] " & Format(min, "00") _
& ":" & Format(sec, "00")
Label1.Caption = ""
End Sub
Function CheckIfPlaying%()
CheckIfPlaying = 0
Dim s As String * 30
mciSendString "status cd mode", s, Len(s), 0
If Mid$(s, 1, 7) = "playing" Then CheckIfPlaying = 1
End Function
Private Sub Command1_Click()
play = CheckIfPlaying%
If (play = 0) Then
Timer1.Enabled = True
StartPlay
Else
PausePlay
End If
End Sub
Private Sub Command2_Click()
Timer1.Enabled = False
Label2.Caption = GetCDLength$
Label1.Caption = GetNumTracks%
StopPlay
SetTrack (1)
End Sub
Private Sub Command3_Click()
StopPlay
Timer1.Enabled = True
If (CurTrack < GetNumTracks%) And (CurTrack <> 1) Then
CurTrack = CurTrack - 1
SetTrack (CurTrack)
StartPlay
Else
If (CurTrack = 1) Then
CurTrack = GetNumTracks%
SetTrack (CurTrack)
StartPlay
End If
End If
End Sub
Private Sub Command4_Click()
StopPlay
Timer1.Enabled = True
If (CurTrack < GetNumTracks%) Then
CurTrack = CurTrack + 1
SetTrack (CurTrack)
StartPlay
Else
If (CurTrack = GetNumTracks%) Then
CurTrack = 1
SetTrack (CurTrack)
StartPlay
End If
End If
End Sub
Private Sub Command5_Click()
EjectCD
End Sub
Private Sub Form_Load()
UnloadAll
SetCDPlayerReady
SetFormat_tmsf
Label2.Caption = GetCDLength$
Label1.Caption = GetNumTracks%
CurTrack = 1
SetTrack (CurTrack)
Timer1.Enabled = False
End Sub
Private Sub Timer1_Timer()
GetCDPosition
End Sub
