• Home
 · 
• Sound/MP3
 · 
• Play .WAVs and .MIDs from your application. Works everytime! This little piece of code will never l

Play .WAVs and .MIDs from your application. Works everytime! This little piece of code will never l

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



Rate Play .WAVs and .MIDs from your application. Works everytime! This little piece of code will never l

• 1
• 2
• 3
• 4
• 5

(2(2 Vote))

*                  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