Kod: 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" As Long Private Declare Function mciSendString Lib "winmm. dll" Alias "mciSendStringA" As Long Function StartPlay mciSendString "play cd", 0, 0, 0 End Function Function SetTrack mciSendString "seek cd to " & Str , 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 , 0 CheckCD = s End Function Function GetNumTracks% Dim s As String 30 mciSendString "status cd number of tracks wait", s, Len , 0 GetNumTracks = CInt(Mid$(s, 1, 2)) End Function Function GetCDLength$ Dim s As String 30 mciSendString "status cd length wait", s, Len , 0 GetCDLength = s End Function Function GetTrackLength$ Dim s As String 30 mciSendString "status cd length track " & TrackNum, s, Len , 0 GetTrackLength = s End Function Function GetCDPosition$ Dim s As String 30 mciSendString "status cd position", s, Len , 0 GetCDPosition = s End Function Function CheckIfPlaying% CheckIfPlaying = 0 Dim s As String 30 mciSendString "status cd mode", s, Len , 0 If Mid$(s, 1, 7) = "playing" Then CheckIfPlaying = 1 End Function Function SeekCDtoX StopPlay SetTrack Track StartPlay End Function Function ReadyDevice UnloadAll SetCDPlayerReady SetFormat_tmsf End Function Function FastForward Dim s As String 40 SetFormat_milliseconds mciSendString "status cd position wait", s, Len , 0 CheckIfPlaying% If CheckIfPlaying = 1 Then mciSendString "play cd from " & CStr(CLng + Spd), 0, 0, 0 Else mciSendString "seek cd to " & CStr(CLng + Spd), 0, 0, 0 End If SetFormat_tmsf End Function Function ReWind Dim s As String 40 SetFormat_milliseconds mciSendString "status cd position wait", s, Len , 0 CheckIfPlaying% If CheckIfPlaying = 1 Then mciSendString "play cd from " & CStr(CLng - Spd), 0, 0, 0 Else mciSendString "seek cd to " & CStr(CLng - 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 Snd. StopPlay Snd. UnloadAll End Sub alıntıdır...