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

Class Modulun Adını CDAudio olarak değiştirin





'Aşağıdaki kodları Class Module yapıştırın

Kod:
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

__________________