Проигрывание звуковых файлов

'------------------------------------------------------------
' Работа со звуком
'------------------------------------------------------------
 
Option Explicit
 
' Функции и константы для проигрывания звуков. Декларации.
Declare Function sndPlaySound Lib "winmm.dll" Alias "sndPlaySoundA" _
(ByVal lpszSoundName As String, ByVal uFlags As Long) As Long
Declare Function sndStopSound Lib "winmm.dll" Alias "sndPlaySoundA" _
(ByVal lpszNull As Long, ByVal uFlags As Long) As Long
 
' Звук воспроизводится синхронно, и функция не возвращает
' управления до окончания его проигрывания.
Global Const SND_SYNC = &H0
 
' Звук воспроизводится асинхронно, функция возвращает управление
' сразу после начала воспроизведения.
Global Const SND_ASYNC = &H1
 
' Для прекращения воспроизведения необходимо вызвать sndPlaySound()
' c NULL  в качестве аргумента-имени файла
 
' Если указанный файл отсутствует, функция неделает ничего.
Global Const SND_NODEFAULT = &H2
 
' Параметр SoundName указывает на звук, образ которого уже
' находится в оперативной памяти.
Global Const SND_MEMORY = &H4
 
' Воспроизведение звука повторяется до тех пор, пока не будет
' вызвана функция sndPlaySound() c NULL  в качестве
Global Const SND_LOOP = &H8
 
' параметра IpszSoundName. Для работы этого флага необходимо
' установить также флаг SND_ASYNC.
 
' Если звук уже воспроизводится, функция не прерывает его
' воспроизведение, а немедленно возвращает FALSE.
Global Const SND_NOSTOP = &H10
 
Function NoiseGet(ByVal FileName) As String
'------------------------------------------------------------
' Загрузка звука в строковую переменную.
'------------------------------------------------------------
Dim buffer As String
Dim f As Integer
Dim SoundBuffer As String
 
   On Error GoTo NoiseGet_Error
 
    buffer = Space$(1024)
    SoundBuffer = ""
    f = FreeFile
    Open FileName For Binary As f
    Do While Not EOF(f)
       Get #f, , buffer    ' Load in 1K chunks
        SoundBuffer = SoundBuffer & buffer
   Loop
   Close f
    NoiseGet = Trim$(SoundBuffer)
Exit Function
 
NoiseGet_Error:
    SoundBuffer = ""
   Exit Function
End Function
 
Sub NoisePlay(SoundBuffer As String, ByVal PlayMode As Integer)
'------------------------------------------------------------
' Проигрывание звука загруженного в память с помощью функции
' NoiseGet().
'------------------------------------------------------------
Dim retcode As Integer
 
   If SoundBuffer = "" Then Exit Sub
 
    ' Stop any sound that may currently be playing.
    retcode = sndStopSound(0, SND_ASYNC) ' код для прекращения звука
 
   ' PlayMode should be SND_SYNC or SND_ASYNC
    ' проигрывание звука
    retcode = sndPlaySound(ByVal SoundBuffer, PlayMode Or SND_MEMORY)
End Sub
 
'------------------------------------------------------------
' Примеры применения
'------------------------------------------------------------
' ' Определение и загрузка звука
'  wavFinal = NoiseGet(App.Path & "" & "finalrealty.wav")
'
' код для прекращения звука (Мало ли, играл раньше)
'  NoisePlay 0, SND_ASYNC
' Проигрывание звука
'  NoisePlay wavFinal, SND_ASYNC