Make A CD Player

'Add Class Module to your project (In the menu choose Project -> Add Class Module,
'Then click Open). Change the Class Module name to CDAudio (In the Project
'Explorer press on Class1 and press F4).

'Add 14 Command Buttons and 2 Text Boxes to your form.
'Insert into Text1 the track number to play. Insert into Text2 the Rewind\FastForward
'speed.
'Insert the following code to your Class Module :

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

'Insert the following code to your form:
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

Readmore...

Play MIDI Files

'Add a module to your project (In the menu choose Project -> Add Module, Then click Open)
'Add 2 CommandButtons to your form (named Command1 and Command2).

'When you press the first button the Midi File will start playing.
'When you press the second button the Midi File will stop playing.
'Insert this code to the module :
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

'Insert the following code to your form:
Public Sub StopMIDI(MidiFileName As String)
Call mciSendString("stop " + MidiFileName, 0&, 0, 0)
Call mciSendString("close " + MidiFileName, 0&, 0, 0)
End Sub

Function PlayMIDI(MidiFileName As String)
On Error Resume Next
Call mciSendString("open " + MidiFileName + " type sequencer", 0&, 0, 0)
If mciSendString("play " + MidiFileName + Flags, 0&, 0, 0) = 0 Then
PlayMIDI = 0
Else
PlayMIDI = 1
End If
End Function
Private Sub Command1_Click()
'Replace c:\mydir\song1.mid with the Midi file name you want to play
PlayMIDI ("c:\mydir\song1.mid")
End Sub

Private Sub Command2_Click()
'Replace c:\mydir\song1.mid with the Midi file name you want to stop
StopMIDI ("c:\mydir\song1.mid")
End Sub

Readmore...

Play Avi File In Picture Box

Play an avi file inside a picture box. The AVI file will be resized to the size of the picture box.

Preparations

Add 1 Command Button (named Command1), and 1 Picture Box (named Picture1) to your form.

Module Code

Declare Function mciSendString Lib "winmm" Alias "mciSendStringA" _
(ByVal lpstrCommand As String, ByVal lpstrReturnString As String, _
ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long Declare Function mciGetErrorString Lib "winmm" Alias _
"mciGetErrorStringA" (ByVal dwError As Long, ByVal lpstrBuffer As String, _
ByVal uLength As Long) As Long
Declare Function GetShortPathName Lib "kernel32" Alias _
"GetShortPathNameA" (ByVal lpszLongPath As String, _
ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long
Public Const WS_CHILD = &H40000000

Form Code

Sub PlayAVIPictureBox(FileName As String, ByVal Window As PictureBox)
Dim RetVal As Long
Dim CommandString As String
Dim ShortFileName As String * 260
Dim deviceIsOpen As Boolean
'Retrieve short file name format
RetVal = GetShortPathName(FileName, ShortFileName, Len(ShortFileName))
FileName = Left$(ShortFileName, RetVal)
'Open the device
CommandString = "Open " & FileName & " type AVIVideo alias AVIFile parent " _
& CStr(Window.hWnd) & " style " & CStr(WS_CHILD)
RetVal = mciSendString(CommandString, vbNullString, 0, 0&)
If RetVal Then GoTo error
'remember that the device is now opendeviceIsOpen = True
'Resize the movie to PictureBox size
CommandString = "put AVIFile window at 0 0 " & CStr(Window.ScaleWidth / _
Screen.TwipsPerPixelX) & " " & CStr(Window.ScaleHeight / _
Screen.TwipsPerPixelY)
RetVal = mciSendString(CommandString, vbNullString, 0, 0&)
If RetVal <> 0 Then GoTo error
'Play the file
CommandString = "Play AVIFile wait"
RetVal = mciSendString(CommandString, vbNullString, 0, 0&)
If RetVal <> 0 Then GoTo error
'Close the deviceCommandString = "Close AVIFile"
RetVal = mciSendString(CommandString, vbNullString, 0, 0&)
If RetVal <> 0 Then GoTo error
Exit Sub
error:
'An error occurred.
'Get the error description
Dim ErrorString As String
ErrorString = Space$(256)
mciGetErrorString RetVal, ErrorString, Len(ErrorString)
ErrorString = Left$(ErrorString, InStr(ErrorString, vbNullChar) - 1)
'close the device if necessary
If deviceIsOpen Then
CommandString = "Close AVIFile"
mciSendString CommandString, vbNullString, 0, 0&
End If
'raise a custom error, with the proper description
Err.Raise 999, , ErrorString
End Sub
Private Sub Command1_Click()
'replace 'c:\myfile.avi' with the name of the AVI file you want to play
    PlayAVIPictureBox "c:\myfile.avi", Picture1
End Sub

Readmore...

Play AVI File

'Add a module to your project (In the menu choose Project -> Add Module, Then click Open)
'Add 2 CommandButtons to your form (named Command1 and Command2).

'When you press the first button the AVI movie will start to play.
'Even after the AVI Finish playing, it is still takes memory.
'To remove it from the memory press the second button.
'Insert this code to the module :
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

'Insert the following code to your form:
Private Sub Command1_Click()
Dim returnstring As String
Dim FileName As String
returnstring = Space(127)
'Replace c:\MyMovie.avi with the AVI file you want to play
FileName = "c:\MyMovie.avi"
erg = mciSendString("open " & Chr$(34) & FileName & _
Chr$(34) & " type avivideo alias video", returnstring, 127, 0)
erg = mciSendString("set video time format ms", returnstring, 127, 0)
erg = mciSendString("play video from 0", returnstring, 127, 0)
End Sub

Private Sub Command2_Click()
erg = mciSendString("close video", returnstring, 127, 0)
End Sub

Readmore...

Play WAV File

'Add a module to your project (In the menu choose Project -> Add Module, Then click Open)
'Insert this code to the module :
Declare Function sndPlaySound Lib "winmm.dll" Alias "sndPlaySoundA" _
(ByVal lpszSoundName As String, ByVal uFlags As Long) As Long

'Insert this code to your form:
Private Sub Form_Load()
'replace c:\music\myfile.wav with the WAV file you want to play
sndPlaySound "c:\music\myfile.wav", 1
'the '1' following the file means that the program should not stop to play the file.
'The sound will play and other events can be happening.
'If you want the whole program to stop while the sound is playing, just change the '1' to '0'.
End Sub

Readmore...

Play MP3 Files Using Windows Media Player

You can use Microsoft Windows Media Player in your VB application to play MP3 files.
To do that you must have Windows Media Player installed on your computer.

Preparations

Add Windows Media Player to your form:
From VB menu choose Project->Components... then mark the Windows Media Player check box and press OK. Now drag the Windows Media Player Control to your form.

If you want that Windows Media Player will be invisible, set its Visible property to False.

Add 3 Command Buttons to your form.
Press the first to play the MP3 file, press the second to stop it, and press the third to Pause/Resume.

Form Code

Private Sub Command1_Click()
' replace the "D:\MP3\MyFile.mp3" below with the Mp3 file
' you want to play
    MediaPlayer1.Open "D:\MP3\MyFile.mp3"
End Sub
Private Sub Command2_Click()
    MediaPlayer1.Stop
End Sub
Private Sub Command3_Click()
' if PlayState is 2: the file is currently playing.
' if PlayState is 1: the file is in pause mode.
    If MediaPlayer1.PlayState = 2 Then
        MediaPlayer1.Pause
    Else
        MediaPlayer1.Play
    End If
End Sub

Readmore...

Detect If Sound Card Can Play Sound Files

'Add a module to your project (In the menu choose Project -> Add Module, Then click Open)
'Insert this code to the module :
Declare Function waveOutGetNumDevs Lib "winmm.dll" () As Long

'Insert this code to your form:
Private Sub Form_Load()
Dim I As Integer
I = waveOutGetNumDevs()
If  I > 0 Then
MsgBox "Your system can play sound files."
Else
MsgBox "Your system can not play sound files."
End If
End Sub

Readmore...

Retrieve The Length Of WAV, AVI And MIDI Files

Know how much time run any WAV, AVI and MIDI file.

Module Code

Declare Function mciSendString Lib "winmm" Alias "mciSendStringA" (ByVal _
    lpstrCommand As String, ByVal lpstrReturnString As String, _
    ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long

 

Form Code

Function GetMediaLength(FileName As String)
    Dim MediaLength As Long
    Dim RetString As String * 256
    Dim CommandString As String
    'open the media file
    CommandString = "Open " & FileName & " alias MediaFile"
    mciSendString CommandString, vbNullString, 0, 0&
    'get the media file length
    CommandString = "Set MediaFile time format milliseconds"
    mciSendString CommandString, vbNullString, 0, 0&
    CommandString = "Status MediaFile length"
    mciSendString CommandString, RetString, Len(RetString), 0&
    GetMediaLength = CLng(RetString)
    'close the media file    CommandString = "Close MediaFile"
    mciSendString CommandString, vbNullString, 0, 0&
End Function

Private Sub Form_Load()
    Dim Seconds, Minutes As Integer
    Dim MilliSeconds As Long
    ' replace "c:\my_media_file.wav" with the path to your media file    MilliSeconds = GetMediaLength("c:\my_media_file.wav")
    ' the function GetMediaLength return the media length in milliseconds,
    ' so we will calculate the total minutes and seconds
    Seconds = Int(MilliSeconds / 1000) Mod 60
    Minutes = Int(MilliSeconds / 60000)
    MilliSeconds = MilliSeconds Mod 1000
    TotalTime = Minutes & ":" & Seconds & ":" & MilliSeconds
    MsgBox (TotalTime)
   
End Sub

Readmore...