Making a cd player

[VIP3R]

How do you make a cd player, what components/controls do I use???

[Vlatko]

You can play CD songs using the MS Multiedia ActiveX Control or The mciSendString API Function

Here is how to make a CD Player:

'Author: Mike Canejo
'Origin: http://www.planet-source-code.com
'Purpose: *Make your own CD-Player!* Fixed!
'Version: VB4+ 


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


Sub GetCDPosition(Track%, Min%, Sec%)
    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))
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
'|---------------------|
'|---Automated Tasks---|
'V---------------------V


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


'Assumes:'Ok here are the directions bef
'     ore you start making the CD Player. Plea
'     se follow 'the directions and dont skip 
'     anything!!
Before you Do anytihng, add a new Class Module To the project
1.)Make a TextBox and name it "Time" and make its text "5"
2.)Make a TextBox and name it "TrackNumber" and make its caption "1"
3.)Make a Label and name it "Seconds" and make its caption "Seconds"
4.)Make a Label and name it "Track" and make its caption "Track:"
5.)Make a CommandButton and name it "FastRVS" and make its caption "<<"
6.)Make a CommandButton and name it "FastFWD" and make its caption ">>"
7.)Make a CommandButton and name it "Play" and make its caption "Play"
8.)Make a CommandButton and name it "Stop" and make its caption "Stop"
9.)Make a CommandButton and name it "CloseTray" and make its caption "CloseTray"
10.)Make a CommandButton and name it "OpenTray" and make its caption "OpenTray"


Dim Snd As CDAudio


Private Sub Play_Click()
    Snd.SeekCDtoX Val(TrackNumber)
End Sub


Private Sub CloseTray_Click()
    Snd.CloseCD
End Sub


Private Sub OpenTray_Click()
    Snd.EjectCD
End Sub


Private Sub Stop_Click()
    Dim x As Integer


    For x = 1 To 10000
        Snd.StopPlay
    Next x
End Sub


Private Sub FastRVS_Click()
    Snd.ReWind Val(Time) * 1000
End Sub


Private Sub FastFWD_Click()
    Snd.FastForward Val(Time) * 1000
End Sub


Private Sub Form_Load()
    
    Set Snd = New CDAudio
    Snd.ReadyDevice
End Sub


Private Sub Form_Unload(Cancel As Integer)
    Snd.StopPlay
    Snd.UnloadAll
End Sub