• Home
 · 
• Sound/MP3
 · 
• Cd player

Cd player

Cd player

API Declarations


Dim CurTrack As Integer
Dim play As Integer
Dim track As Integer
Dim min As Integer
Dim sec As Integer



Rate Cd player

• 1
• 2
• 3
• 4
• 5

(2(2 Vote))

    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