by EM Dixson (6 Submissions)
Category: Sound/MP3
Compatability: Visual Basic 5.0
Difficulty: Unknown Difficulty
Originally Published: Wed 10th March 1999
Date Added: Mon 8th February 2021
Rating: 
(1 Votes)
Play .WAVs and .MIDs from your application. Works everytime! This little piece of code will never let you down. Easy and Fune to use! Enjoy!
API Declarations
http://developer.ecorp.net
VBcoders
* http://developer.ecorp.net *
Author: Dragon
When you create games or screensavers it may sometimes be desirable
to have a few different soundfiles that play in a continuos loop, so
that when one sound reaches the end the next file starts playing, and
when the last sound has played the whole loop starts all over again.
Here I have a few functions to help you with this task. These functions
allow both midis and wavs to be used.
*********************************************************
This is how to do it:
First create a timer on your form, and set Enabled = False. You
should also set the interval to an appropriate value, 1000 is a
good value.
Then insert this code into the timer's 'Timer' event:
Call LoopChecker(Me.tmrMusic)
Replace 'tmrMusic' with the name of your timer.
*********************************************************
To start playing the files do this:
Dim clSoundFiles As New Collection
clSoundFiles.Add "C:\MyFolder\sound1.wav"
clSoundFiles.Add "C:\MyFolder\sound2.mid"
Call PlayFiles(Form1.tmrMusic, clSoundFiles)
Replace Form1 with the name of the form you placed the timer on, and
tmnrMusic with the name of your timer.
You can add as many sounds as you want, midifiles or wavefiles through
the Add command shown above.
*********************************************************
If you want to stop the loop just call the function StopPlaying like
this:
Call StopPlaying(Form1.tmrMusic)
Again, replace Form1 with the name of the form you placed the timer on,
and tmrMusic with the actual name of your timer.
*********************************************************
Put the following code in a bas module
'//*********************************//'
Private Const MAX_PATH As Integer = 260
Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As Any, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long
Public Declare Function mciExecute Lib "winmm.dll" (ByVal lpstrCommand As String) As Long
Private Declare Function GetShortPathName Lib "kernel32" Alias "GetShortPathNameA" (ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long
Public Sub LoopChecker(tmrTimer As Timer)
Dim sngLen As Single
Dim sngPos As Single '0 <= sngPos <= 1
'Get length
sngLen = Val(MCICommand("status mySound length"))
If sngLen Then
'Get current position as a value between 0 and 1
sngPos = Val(MCICommand("status mySound position")) / sngLen
'If we have reached the end we'll call the
'playfiles function to jump to the next song
If sngPos >= 1 Then Call PlayFiles(tmrTimer)
End If
End Sub
Public Function GetShortName(ByVal strLongFileName As String) As String
'Convert long filenames to 8.3 style filenames
Dim lngRetVal As Long
' Initialize string
GetShortName = String$(MAX_PATH, 0)
' Call API function
lngRetVal = GetShortPathName(strLongFileName, GetShortName, Len(GetShortName))
'Remove trailing nulls
GetShortName = Left$(GetShortName, lngRetVal)
End Function
Private Function MCICommand(strCmd As String) As String
Dim lngRet As Long
Dim strBuffer As String
Dim lngCB As Long
'Initialize buffer
strBuffer = Space$(128)
'Send command
lngRet = mciSendString(strCmd, strBuffer, Len(strBuffer), lngCB)
'Trim spaces and return string
MCICommand = Trim$(strBuffer)
End Function
Public Sub PlayFiles(tmrClock As Timer, Optional clFileList As Collection)
Static intPlaying As Integer
Static clFiles As New Collection
If Not clFileList Is Nothing Then 'New collection of files to play
Dim SoundFile
'Disable timer
tmrClock.Enabled = False
'Clear collection
Set clFiles = Nothing
'Assign function param collection to
'our static collection
For Each SoundFile In clFileList
clFiles.Add SoundFile
Next
intPlaying = 1
'Check if a sound is already open
If MCICommand("status mySound media present") <> Chr(0) Then
'Yep, so stop & close it
Call mciExecute("stop mySound")
Call mciExecute("close mySound")
End If
'Play first song in collection
Call mciExecute("open " & GetShortName(clFiles.Item(1)) & " alias mySound")
Call mciExecute("play mySound")
'Enable timer
tmrClock.Enabled = True
Else 'Jump to next song
'Disable timer
tmrClock.Enabled = False
'Some error checking
If clFiles Is Nothing Then Exit Sub
If clFiles.Count = 0 Then Exit Sub
'Next song
intPlaying = intPlaying + 1
'Back to first song if we have reached the end
If intPlaying > clFiles.Count Then intPlaying = 1
'Check if a sound is already open (just to be on the safe side)
If MCICommand("status mySound media present") <> Chr(0) Then
'Yep, so stop & close it
Call mciExecute("stop mySound")
Call mciExecute("close mySound")
End If
'Play next song
Call mciExecute("open " & GetShortName(clFiles.Item(intPlaying)) & " alias mysound")
Call mciExecute("play mySound")
'Enabled timer
tmrClock.Enabled = True
End If
End Sub
Public Sub StopPlaying(tmrTimer As Timer)
'Diable timer
tmrTimer.Enabled = False
'Check if a sound is open
If MCICommand("status mySound media present") <> Chr(0) Then
'Yep, so stop & close it
Call mciExecute("stop mySound")
Call mciExecute("close mySound")
End If
End Sub
No comments have been posted about Play .WAVs and .MIDs from your application. Works everytime! This little piece of code will never l. Why not be the first to post a comment about Play .WAVs and .MIDs from your application. Works everytime! This little piece of code will never l.
