Access ASP SQL Server VBA NET - Форумы по проектированию

LEADERSOFT.ru Разработка на заказ программ и сайтов

Форумы по информационным технологиям

Начало

Forums

Регистрация | Вход

Форумы

Поиск

Список форумов

Программирование

Microsoft Access. Файлы mdb и accdb

Тема: Звук на с...

Тема: Звук на событие

15.06.2007 21:02:08

Валерий3

43 сообщения

Тема: Звук на событие

Еще раз здасьте!
У меня такой вопрос - а как назначить на какое-либо событие звук?
К примеру, чтоб при открыти формы играла музыка.
Спасибочки.

P.S. Общий раздел по формам
Автор: Валерий от 12.03.2002 13:43:26 Источник ...

15.06.2007 21:02:08

Vasya

26 сообщения

RE: Звук на событие

API функция для проигрывания Wav/Midi/AVI файлов:

'****************** Code Start *********************'
Public Const pcsSYNC = 0 ' wait until sound is finished playing
Public Const pcsASYNC = 1 ' don't wait for finish
Public Const pcsNODEFAULT = 2 ' play no default sound if sound doesn't exist
Public Const pcsLOOP = 8 ' play sound in an infinite loop (until next apiPlaySound)
Public Const pcsNOSTOP = 16 ' don't interrupt a playing sound

'Sound APIs
Private Declare Function apiPlaySound Lib "Winmm.dll" Alias "sndPlaySoundA" _
(ByVal lpszSoundName As String, ByVal uFlags As Long) As Long

'AVI APIs
Private Declare Function apimciSendString Lib "Winmm.dll" Alias "mciSendStringA" _
(ByVal lpstrCommand As String, ByVal lpstrReturnString As String, _
ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long

Private Declare Function apimciGetErrorString Lib "Winmm.dll" _
Alias "mciGetErrorStringA" (ByVal dwError As Long, _
ByVal lpstrBuffer As String, ByVal uLength As Long) As Long

Function fPlayStuff(ByVal strFilename As String, _
Optional intPlayMode As Integer) As Long
'MUST pass a filename _with_ extension
'Supports Wav, AVI, MID type files
Dim lngRet As Long
Dim strTemp As String

Select Case LCase(fGetFileExt(strFilename))
Case "wav":
If Not IsMissing(intPlayMode) Then
lngRet = apiPlaySound(strFilename, intPlayMode)
Else
MsgBox "Must specify play mode."
Exit Function
End If
Case "avi", "mid":
strTemp = String$(256, 0)
lngRet = apimciSendString("play " & strFilename, strTemp, 255, 0)
End Select
fPlayStuff = lngRet
End Function
Function fStopStuff(ByVal strFilename As String)
'Stops a multimedia playback
Dim lngRet As Long
Dim strTemp As String
Select Case LCase(fGetFileExt(strFilename))
Case "Wav":
lngRet = apiPlaySound(0, pcsASYNC)
Case "avi", "mid":
strTemp = String$(256, 0)
lngRet = apimciSendString("stop " & strFilename, strTemp, 255, 0)
End Select
fStopStuff = lngRet
End Function

Private Function fGetFileExt(ByVal strFullPath As String) As String
Dim intPos As Integer, intLen As Integer
intLen = Len(strFullPath)
If intLen Then
For intPos = intLen To 1 Step -1
'Find the last \
If Mid$(strFullPath, intPos, 1) = "." Then
fGetFileExt = Mid$(strFullPath, intPos + 1)
Exit Function
End If
Next intPos
End If
End Function

Function fGetError(ByVal lngErrNum As Long) As String
' Translate the error code to a string
Dim lngx As Long
Dim strErr As String

strErr = String$(256, 0)
lngx = apimciGetErrorString(lngErrNum, strErr, 255)
strErr = Left$(strErr, Len(strErr) - 1)
fGetError = strErr
End Function
Function fatest()
Dim a As Long
a = fPlayStuff("C:\winnt\clock.avi")
'a = fStopStuff("C:\winnt\clock.avi")
End Function

'****************** Code End *********************'

P.S. Общий раздел по формам
Автор: Vasya от 12.03.2002 13:56:08 Источник ...

Страница 1 из 1

Программирование

Microsoft Access. Файлы mdb и accdb

Тема: Звук на с...

Поиск

Список форумов

Начало | Forums