How do you make a cd player, what components/controls do I use???
Printable View
How do you make a cd player, what components/controls do I use???
You can play CD songs using the MS Multiedia ActiveX Control or The mciSendString API Function
Here is how to make a CD Player:
Code:'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