CodeItBetter Programming Another VB Programming Blog

'MultiMedia - How to make a CD Player

Option Explicit
 
'Add a Class Module to your project, Rename it to CDAudio and insert the following code:

Private Declare Function mciGetErrorString Lib "winmm.dll" Alias "mciGetErrorStringA" _
    (ByVal dwError As Long, ByVal lpstrBuffer As String, ByVal uLength As Long) As Long
Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" _
    (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Long, _
    ByVal hwndCallback As Long) As Long
 
Function StartPlay()
    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 SetFormat_milliseconds()
    mciSendString "set cd time format milliseconds", 0, 0, 0
End Function
 
Function CheckCD$()
    Dim s As String * 30
    mciSendString "status cd media present", s, Len(s), 0
    CheckCD = s
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
 
Function GetTrackLength$(TrackNum%)
    Dim s As String * 30
    mciSendString "status cd length track " & TrackNum, s, Len(s), 0
    GetTrackLength = s
End Function
 
Function GetCDPosition$()
    Dim s As String * 30
    mciSendString "status cd position", s, Len(s), 0
    GetCDPosition = s
End Function
 
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
 
Function SeekCDtoX(Track%)
    StopPlay
    SetTrack Track
    StartPlay
End Function
 
Function ReadyDevice()
    UnloadAll
    SetCDPlayerReady
    SetFormat_tmsf
End Function
 
Function FastForward(Spd%)
    Dim s As String * 40
    SetFormat_milliseconds
    mciSendString "status cd position wait", s, Len(s), 0
    CheckIfPlaying%
    If CheckIfPlaying = 1 Then
        mciSendString "play cd from " & CStr(CLng(s) + Spd), 0, 0, 0
    Else
        mciSendString "seek cd to " & CStr(CLng(s) + Spd), 0, 0, 0
    End If
    SetFormat_tmsf
End Function
 
Function ReWind(Spd%)
    Dim s As String * 40
    SetFormat_milliseconds
    mciSendString "status cd position wait", s, Len(s), 0
    CheckIfPlaying%
    If CheckIfPlaying = 1 Then
        mciSendString "play cd from " & CStr(CLng(s) - Spd), 0, 0, 0
    Else
        mciSendString "seek cd to " & CStr(CLng(s) - Spd), 0, 0, 0
    End If
    SetFormat_tmsf
End Function
 
'Add 14 Command Buttons and 2 Text Boxes on your form and insert the following code:
'Insert the track number to play on Text1 and Insert the Rewind\FastForward speed in Text2
Dim Snd As CDAudio
 
Private Sub Command1_Click()
    Snd.SeekCDtoX Val(Text1)
End Sub
 
Private Sub Command10_Click()
    MsgBox Snd.CheckIfPlaying
End Sub
 
Private Sub Command11_Click()
    s = Snd.GetCDPosition
    MsgBox "Track: " & CInt(Mid$(s, 1, 2)) & " Min: " & CInt(Mid$(s, 4, 2)) & " Sec: " & CInt(Mid$(s, 7, 2))
    Track = CInt(Mid$(s, 1, 2))
    Min = CInt(Mid$(s, 4, 2))
    Sec = CInt(Mid$(s, 7, 2))
End Sub
 
Private Sub Command12_Click()
    s = Snd.GetCDPosition
    MsgBox Snd.GetTrackLength(CInt(Mid$(s, 1, 2)))
End Sub
 
Private Sub Command13_Click()
    Snd.PausePlay
End Sub
 
Private Sub Command14_Click()
    Snd.StartPlay
End Sub
 
Private Sub Command2_Click()
    s$ = Snd.GetCDLength
    MsgBox "Total length of CD: " & s, , "CD len"
End Sub
 
Private Sub Command3_Click()
    Snd.CloseCD
End Sub
 
Private Sub Command4_Click()
    Snd.EjectCD
End Sub
 
Private Sub Command5_Click()
    Snd.StopPlay
End Sub
 
Private Sub Command6_Click()
    Snd.ReWind Val(Text2) * 1000
End Sub
 
Private Sub Command7_Click()
    Snd.FastForward Val(Text2) * 1000
End Sub
 
Private Sub Command8_Click()
    MsgBox Snd.CheckCD
End Sub
 
Private Sub Command9_Click()
    MsgBox Snd.GetNumTracks
End Sub
 
Private Sub Form_Load()
    Set Snd = New CDAudio
    Snd.ReadyDevice
    Command1.Caption = "Play track"
    Command2.Caption = "Get CD Length"
    Command3.Caption = "Close CD"
    Command4.Caption = "Eject CD"
    Command5.Caption = "Stop"
    Command6.Caption = "Rewind"
    Command7.Caption = "Fast Forward"
    Command8.Caption = "Check if CD in drive"
    Command9.Caption = "Get numbre of tracks"
    Command10.Caption = "Check If Playing"
    Command11.Caption = "Get CD Position"
    Command12.Caption = "Get current track Length"
    Command13.Caption = "Pause"
    Command14.Caption = "Resume"
    Text1.Text = "1"
    Text2.Text = "5"
End Sub
 
Private Sub Form_Unload(Cancel As Integer)
    Snd.StopPlay
    Snd.UnloadAll
End Sub