Use the
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
*Make your own CD-Player!* Fixed! Submitted on: 4/23/1999 By: Mike Canejo Level: Not Given User Rating: By 104 Users Compatibility:VB 5.0/6.0, VB 4.0/32 Users have accessed this code 17914 times. (About the author) Fixed it! This is the source that will let you make your own CD Player! Its so easy and will take like 3 minutes to make depending on your knowledge on where everything is in Visual Basics. Enjoy the free source code and like i always say: "Keep up the Programming!" [NOTE: for all of yous that have been having trouble with my coding, i fixed it, please read!] Windows API/Global Declarations: Can't Copy and Paste this? Click here for a copy-and-paste friendly version of this code! '************************************** 'Windows API/Global Declarations for :*M ' ake your own CD-Player!* Fixed! '************************************** 'Copy and Paste the following into a Cla ' ss Module(.cls) 'not a bas 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 code: Can't Copy and Paste this? Click here for a copy-and-paste friendly version of this code! '************************************** ' Name: *Make your own CD-Player!* Fixed ' ! ' Description:Fixed it! This is the sour ' ce that will let you make your own CD Pl ' ayer! Its so easy and will take like 3 m ' inutes to make depending on your knowled ' ge on where everything is in Visual Basi ' cs. Enjoy the free source code and like ' i always say: "Keep up the Programming!" ' [NOTE: for all of yous that have been ha ' ving trouble with my coding, i fixed it, ' please read!] ' By: Mike Canejo ' ' ' Inputs:None ' ' Returns:None ' '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" ' 'Side Effects:'For those who are STILL h ' aving problems 'with my coding, please do the following ' : 'Open up an txt editior(NotePad, WordPad ' Etc...) 'Copy and Paste the below into the NoteP ' ad 'when u finish, rename the text file(.tx ' t) to (.frm) instead 'then start a new project, add the class ' module from the below of this 'and the .frm file u just renamed and yo ' ull be allset! VERSION 5.00 Begin VB.Form frmMain BackColor= &H00C0C0C0& BorderStyle= 1 'Fixed Single Caption = "Cd Player" ClientHeight = 2340 ClientLeft= 5100 ClientTop= 1575 ClientWidth= 3495 LinkTopic= "Form1" MaxButton= 0 'False PaletteMode= 1 'UseZOrder ScaleHeight= 2340 ScaleWidth= 3495 Begin VB.Frame Frame1 BackColor= &H00C0C0C0& Caption = "Track Jump" ForeColor= &H00000000& Height = 855 Left = 120 TabIndex= 2 Top= 960 Width = 3255 Begin VB.CommandButton Command1 Caption = "Play" Height = 375 Left = 1440 TabIndex= 6 Top= 360 Width = 615 End Begin VB.CommandButton Command5 Caption = "Stop" Height = 375 Left = 2400 TabIndex= 5 Top= 360 Width = 615 End Begin VB.TextBox Text1 BackColor= &H80000006& BeginProperty Font Name = "Comic Sans MS" Size = 6.75 Charset = 0 Weight = 400 Underline= 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor= &H00FFFFFF& Height = 285 Left = 720 TabIndex= 3 Text = "1" Top= 360 Width = 375 End Begin VB.Label Label2 BackColor= &H80000012& BorderStyle= 1 'Fixed Single Caption = "Track:" BeginProperty Font Name = "Comic Sans MS" Size = 6.75 Charset = 0 Weight = 400 Underline= 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor= &H00FFFFFF& Height = 285 Left = 120 TabIndex= 4 Top= 360 Width = 615 End End Begin VB.CommandButton Command4 Caption = "Open Tray" Height = 375 Left = 120 TabIndex= 1 Top= 1920 Width = 975 End Begin VB.CommandButton Command3 Caption = "Close Tray" Height = 375 Left = 2400 TabIndex= 0 Top= 1920 Width = 975 End Begin VB.Frame frmTime BackColor= &H00C0C0C0& Caption = "Time Jump" ForeColor= &H00000000& Height = 735 Left = 120 TabIndex= 7 Top= 120 Width = 3255 Begin VB.CommandButton Command7 Caption = ">>" BeginProperty Font Name = "Comic Sans MS" Size = 6.75 Charset = 0 Weight = 400 Underline= 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 375 Left = 2400 TabIndex= 10 Top= 240 Width = 495 End Begin VB.CommandButton Command6 Caption = "<<" BeginProperty Font Name = "Comic Sans MS" Size = 6.75 Charset = 0 Weight = 400 Underline= 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 375 Left = 1800 TabIndex= 9 Top= 240 Width = 495 End Begin VB.TextBox Text2 BackColor= &H00000000& BeginProperty Font Name = "Comic Sans MS" Size = 6.75 Charset = 0 Weight = 400 Underline= 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor= &H00FFFFFF& Height = 285 Left = 120 TabIndex= 8 Text = "5" Top= 240 Width = 495 End Begin VB.Label Label1 BackColor= &H80000012& BorderStyle= 1 'Fixed Single Caption = "Seconds" BeginProperty Font Name = "Comic Sans MS" Size = 6.75 Charset = 0 Weight = 400 Underline= 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor= &H00FFFFFF& Height = 285 Left = 600 TabIndex= 11 Top= 240 Width = 735 End End End Attribute VB_Name = "frmMain" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = ' 'Warranty: 'code provided by Planet Source Code(tm) ' 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 'Well thats it!
Anyway try planetsourcecode. There is an example on the site.
Reply With Quote
mail:
