::Главная страница :: Visual Basic :: Статьи

Простой пример - как записать звук с микрофона

Автор - Visual Basic на русском

Private Declare Function mciSendString Lib "winmm.dll" Alias _
"mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As
String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long

Private Sub cmdPlay_Click()
Dim L As Long, Res As String, cb As Long
On Error Resume Next
Res = Space$(128)
L = mciSendString("open new type waveaudio alias sound", Res, 128, cb)
L = mciSendString("set sound time format ms format tag pcm channels 1
samplespersec 22050 bytespersec 44100 alignment 2
bitspersample 16", Res, 128, cb)
L = mciSendString("record sound", Res, 128, cb)
End Sub

Private Sub cmdStop_Click()
Dim L As Long, Res As String, cb As Long
On Error Resume Next
Res = Space$(128)
L = mciSendString("stop sound", Res, 128, cb)
L = mciSendString("close sound", Res, 128, cb)
End Sub

2. Раз уж зашла речь об этой библиотеке (winmm.dll), давайте посмотрим, что с ней можно еше сделать
Вот, например померить время :

Private lngStart As Long
Private Declare Function timeGetTime Lib "winmm.dll" () As Long
Public Sub StartTimer()
lngStart = timeGetTime
End Sub
Public Function StopTimer() As Long
StopTimer = (timeGetTime - lngStart)
End Function


Private Sub Command1_Click()
Print Time
StartTimer
Do While StopTimer < 1000
DoEvents
Loop
Print Time
Debug.Print StopTimer
End Sub


3. Точность такого измерения - во много раз выше точности обычного таймера . Впрочем это не таймер . Но на его основе можно наворотить....

Сдается мне , что это уже проскакивало в моих советах, однако лучше повториться. Любимый способ ребутить подвисший модем, который перегрудвется только нажатием кнопки ресет - к СD-ROM Приставляется каромысло, которое и нажимает кнопку на модеме.

Private Declare Function mciSendString Lib "winmm.dll" _
Alias "mciSendStringA" _
(ByVal lpstrCommand As String, _
ByVal lpstrReturnString As String, _
ByVal uReturnLength As Long, _
ByVal hwndCallback As Long) As Long
'выезжает
Private Sub Command1_Click()
Call mciSendString("Set CDAudio Door Open Wait", 0&, 0&, 0&)
End Sub
'заезжает
Private Sub Command2_Click()
Call mciSendString("Set CDAudio Door Closed Wait", 0&, 0&, 0&)
End Sub


4. Ну, и примерчик - как определить начилие аудиокарты -


Declare Function waveOutGetNumDevs Lib "winmm.dll" () As Long

Private Sub Check_Click()

Dim rtn As Integer 'declare the needed variables

rtn = waveOutGetNumDevs() 'check for a sound card

If rtn = 1 Then 'Когда больше, чем 1- карта работает :-)
MsgBox "Your system supports a sound card."
Else 'А иначе карты нету :-(
MsgBox "Your system cannot play Sound Files."
End If

End Sub

Тематические ссылки
Ваша ссылка Ваша ссылка

Обмен кнопками, ведение статистики, реклама.