CD Player Yapmak

'Projenize 1 adet ClassModül ekleyerek adını CDAudio olarak değiştirin
'Formunuza 14 Command Button ve 2 TextBox ekleyin

Class Modülün Adını CDAudio olarak değiştirin



'Aşağıdaki kodları Class Modüle yapıştırın

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

'Aşağıdaki kodları formunuza kopyalayın

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