ОСТАНОВИТЬ ЗВУК

16K

03 марта 2006 года

Kopirator

4 / / 03.03.2006

Вот модуль в котором содержатся все необходимые объявления и константы. Проверено работает.

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
'------------------end module--------------------

'------------------------------------------------------------
' Примеры применения
'------------------------------------------------------------
Dim wavFinal As String
Private Sub Command1_Click()
' Проигрывание звука
NoisePlay wavFinal, SND_ASYNC
End Sub

Private Sub Command2_Click()
' код для прекращения звука
NoisePlay 0, SND_ASYNC
End Sub

Private Sub Form_Load()
' Определение и загрузка звука
wavFinal = NoiseGet("G:\Musik\AnnB\GOOFY.wav")
End Sub

Вот собственно и всё

16K

04 марта 2006 года

Kopirator

4 / / 03.03.2006

Я а на чём проверял как ты думаеш, не на Win 95.

Вот файлик - проект все то, что уже сказал