Cd player yapımı

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