Звук в реале

[Sirik]

Надо чтобы звук, который снимается с микрофона, поступал на динамик (причём поступал в реальном времени).

Желательно, чтобы звуковой поток можно было как-то сохранить на диск.

ЗЫ: есть такой примерчик (AudioMonitor), так в нём звук снимается с помощью функций из winmm.dll. Я так понимаю, что нечто подобное можно сделать с помощью той же библиотеки.
Но никак не получается

[Sirik]

Вот тут немного переделал AudioMonitor.
Но, звук какой-то не такой
Что я сделал не так (мне кажется что дело может быть буфере, но что именно не знаю)

ЗЫ. Архив не выкладывается, поэтому выложу весь код:
В форму:

Код: Выделить всё

Option Explicit

Dim Msg As String

Private Sub Form_Load()
    picSubOsc.Picture = picMainOsc.Picture
    cmdStop.Enabled = False
    blnWaveOpen = False
    lngFrequency = 44100
End Sub

Private Sub Form_Unload(Cancel As Integer)
    If blnWaveOpen Then Call WaveClose
    End
End Sub

Private Sub cmdStart_Click()
 
    If Not WaveOpen Then
          Msg = "Íå âîçìîæíî îòêðûòü WaveInput äåâàéñ."
          MsgBox Msg, vbCritical, "AudioMonitor - Error"
          Exit Sub
    End If
    blnWaveOpen = True
   
    cmdStart.Enabled = False
    cmdStop.Enabled = True
    Call InputWave
End Sub

Private Sub cmdStop_Click()
    Call WaveClose
   
    cmdStart.Enabled = True
    cmdStop.Enabled = False
End Sub



В модуль:

Код: Выделить всё

Option Explicit

Private Type WAVEFORMATEX
    wFormatTag As Integer
    nChannels As Integer
    nSamplesPerSec As Long
    nAvgBytesPerSec As Long
    nBlockAlign As Integer
    wBitsPerSample As Integer
cbSize As Integer
End Type

Private Type WAVEHDR
    lpData As Long
    dwBufferLength As Long
    dwBytesRecorded As Long
    dwUser As Long
    dwFlags As Long
    dwLoops As Long
    lpNext As Long
    Reserved As Long
End Type


Private hWaveIn As Long, hWaveOut As Long

Private Declare Function waveOutOpen Lib "winmm.dll" (lphWaveOut As Long, ByVal uDeviceID As Long, lpFormat As WAVEFORMATEX, ByVal dwCallback As Long, ByVal dwInstance As Long, ByVal dwFlags As Long) As Long
Private Declare Function waveOutReset Lib "winmm.dll" (ByVal hWaveOut As Long) As Long
Private Declare Function waveOutClose Lib "winmm.dll" (ByVal hWaveOut As Long) As Long
Private Declare Function waveOutPrepareHeader Lib "winmm.dll" (ByVal hWaveOut As Long, lpWaveOutHdr As WAVEHDR, ByVal uSize As Long) As Long
Private Declare Function waveOutWrite Lib "winmm.dll" (ByVal hWaveOut As Long, lpWaveOutHdr As WAVEHDR, ByVal uSize As Long) As Long
Private Declare Function waveOutUnprepareHeader Lib "winmm.dll" (ByVal hWaveOut As Long, lpWaveOutHdr As WAVEHDR, ByVal uSize As Long) As Long

Private Declare Function waveInAddBuffer Lib "winmm.dll" (ByVal hWaveIn As Long, lpWaveInHdr As WAVEHDR, ByVal uSize As Long) As Long
Private Declare Function waveInClose Lib "winmm.dll" (ByVal hWaveIn As Long) As Long
Private Declare Function waveInOpen Lib "winmm.dll" (lphWaveIn As Long, ByVal uDeviceID As Long, lpFormat As WAVEFORMATEX, ByVal dwCallback As Long, ByVal dwInstance As Long, ByVal dwFlags As Long) As Long
Private Declare Function waveInPrepareHeader Lib "winmm.dll" (ByVal hWaveIn As Long, lpWaveInHdr As WAVEHDR, ByVal uSize As Long) As Long
Private Declare Function waveInReset Lib "winmm.dll" (ByVal hWaveIn As Long) As Long
Private Declare Function waveInStart Lib "winmm.dll" (ByVal hWaveIn As Long) As Long
Private Declare Function waveInStop Lib "winmm.dll" (ByVal hWaveIn As Long) As Long
Private Declare Function waveInUnprepareHeader Lib "winmm.dll" (ByVal hWaveIn As Long, lpWaveInHdr As WAVEHDR, ByVal uSize As Long) As Long

Private Declare Function BitBlt& Lib "gdi32" (ByVal hDestDC&, ByVal x1&, ByVal y1&, ByVal nWidth&, ByVal nHeight&, ByVal hSrcDC&, ByVal xSrc&, ByVal ySrc&, ByVal dwRop&)

Public blnWaveOpen As Boolean
Public lngFrequency As Long

Private Const WAVE_FORMAT_PCM = 1
Private Const WAVE_MAPPER = -1&
Private Const CALLBACK_FUNCTION = &H30000
Private Const CALLBACK_WINDOW = &H10000
Private Const MM_WIM_DATA = &H3C0
Private bBufferFull As Boolean
Private WaveOsc(255) As Byte

Public Function WaveOpen() As Boolean
    Dim Ret As Long
    Dim WF As WAVEFORMATEX
    Dim WHOut As WAVEFORMATEX
    Dim resOut As Long
   
    With WF
        .wFormatTag = WAVE_FORMAT_PCM
        .nChannels = 2
        .nSamplesPerSec = lngFrequency
        .nBlockAlign = 1
        .nAvgBytesPerSec = (.nSamplesPerSec * .nBlockAlign) '\ 8
        .wBitsPerSample = 8
        .cbSize = 0
    End With
   
    Ret = waveInOpen(hWaveIn, WAVE_MAPPER, WF, AddressOf waveInProc, 0, CALLBACK_FUNCTION)
 
    With WHOut
        .wFormatTag = WAVE_FORMAT_PCM
        .nChannels = 2
        .nSamplesPerSec = lngFrequency
        .nBlockAlign = 1
        .nAvgBytesPerSec = (.nSamplesPerSec * .nBlockAlign) '\ 8
        .wBitsPerSample = 8
        .cbSize = 0
    End With
   
    resOut = waveOutOpen(hWaveOut, WAVE_MAPPER, WHOut, AddressOf waveOutProc, 0, CALLBACK_FUNCTION)
 
    If Ret <> 0 Or resOut <> 0 Then
          WaveOpen = False
    Else
          WaveOpen = True
    End If
End Function

Public Sub InputWave()
    Dim WH As WAVEHDR
    Dim WHOut As WAVEHDR
   
    waveInStart hWaveIn
    With WH
        .lpData = VarPtr(WaveOsc(0))
        .dwBufferLength = 256
        .dwFlags = 0
    End With
    With WHOut
        .lpData = VarPtr(WaveOsc(0))
        .dwBufferLength = 256
        .dwFlags = 0
    End With
   
    Do
        waveInPrepareHeader hWaveIn, WH, Len(WH)
        bBufferFull = False
        waveInAddBuffer hWaveIn, WH, Len(WH)
       
        waveOutPrepareHeader hWaveOut, WHOut, Len(WHOut)
        waveOutWrite hWaveOut, WHOut, Len(WHOut)
       
        Do
            DoEvents
        Loop Until bBufferFull Or hWaveIn = 0
       
       
        waveInUnprepareHeader hWaveIn, WH, Len(WH)
        waveOutUnprepareHeader hWaveOut, WHOut, Len(WHOut)
       
        Call DrawData
        DoEvents
    Loop Until hWaveIn = 0
    frmMain.picMainOsc.Cls
End Sub

Public Sub WaveClose()
    waveOutReset hWaveOut
    waveOutClose hWaveOut
    hWaveOut = 0

    waveInReset hWaveIn
    waveInStop hWaveIn
    waveInClose hWaveIn
    hWaveIn = 0
    blnWaveOpen = False
End Sub

Private Sub DrawData()
  Dim n As Byte
 
  With frmMain
    .picSubOsc.Cls
    For n = 0 To 254
      .picSubOsc.Line (n, WaveOsc(n) \ 4)-(n + 1, WaveOsc(n + 1) \ 4), &H80000005
    Next
    BitBlt .picMainOsc.hDC, 0, 0, 256, 64, .picSubOsc.hDC, 0, 0, vbSrcCopy
   
  End With
End Sub

Private Sub waveInProc(ByVal hwi&, ByVal uMsg&, ByVal dwInstance&, ByVal dwParam1&, ByVal dwParam2&)
    If uMsg = MM_WIM_DATA Then bBufferFull = True
End Sub

Private Sub waveOutProc(ByVal hwi&, ByVal uMsg&, ByVal dwInstance&, ByVal dwParam1&, ByVal dwParam2&)
    If uMsg = MM_WIM_DATA Then bBufferFull = True
End Sub



На форме должно быть две кнопки (cmdStart и cmdStop) и PictureBox (picMainOsc)

[Sirik]

Я вижу интерес к моей теме не очень велик.

Если кому интересно, то проблеммы со звуком были в следующем: буфер записи и воспроизведения был слишком мал, поэтому и были слышни шумы.
Я увеличил размер буфера, но появилась следующая проблемма: запись и воспроизведение не происходят одновременно, а по очереди. Как это обойти? Может создать второй процесс, тогда как?

[Ramzes]

Почему, велик, вот я уже третий раз заглядиваю, и все смотрю как ты сам отвечаешь на свой вопрос.

[Sirik]

Почему, велик, вот я уже третий раз заглядиваю, и все смотрю как ты сам отвечаешь на свой вопрос.

Просто я не только задаю вопрос (как не которые), но еще и думаю над его ответом.

А насчёт последнего, может кто-то что-то посоветует?

[Ramzes]

Может и посоветует, но лично я ничем тебе помочь немогу , сам не знаю просто.

[Ennor]

...
Я увеличил размер буфера, но появилась следующая проблемма: запись и воспроизведение не происходят одновременно, а по очереди. Как это обойти? Может создать второй процесс, тогда как?

Ты уверен, что асинхронность появилась после увеличения буферов? Если да, то, боюсь, тебе ничего не поможет - дрова-то для звуковухи все используют одни и те же...

Насчет многопоточной записи - не уверен, у тебя ведь одна карточка, не так ли?

Если только попробовать поизвращаться и сделать то же самое через DirectSound - должно быть поточнее, имхо. Или попробовать поиграться с дровами звуковухи - тоже может помочь. Тут же все относительно и неопределенно, сам понимаешь...

[Sirik]

Нет (может я просто не хорошо объяснил), асинхронность не появилась. Просто звук стал лучше и чище. А синхронность стала ещё больше.

На счёт одна или две звуковой карты, разве нельзя воспроизводить и записываю одновремённо? ИМХО, можно, только как?

[Ennor]

Можно одновременно, конечно - во всяком случае, SoundForge это как-то делает. Другой вопрос, как именно... Работать с программами по обработке звука я, конечно, работал, но вот чтобы самому писать такие... никогда не приходилось.

[GM]

который снимается с микрофона, поступал на динамик

Я в Volume Control в воспроизвидение просто подключал Микрофон.

[Sirik]

который снимается с микрофона, поступал на динамик

Я в Volume Control в воспроизвидение просто подключал Микрофон.

Ага, я что по-твоему подключаю? Линейный вход?
В принципе какая разница что подключать на вход? Надо чтобы звук был в реале!

ЗЫ. Кто-то мне предлагал сделать захват звука через DirectSound. Но есть одна проблемма: разные версии этого самого DS. А ставить версию под которую я буду писать никто не захочет

[GSerg]

Не понял
Любой DX совместим со всеми своими прошлыми версиями. Пиши на 7. Будет работать на всех, начиная с 7...

[Sirik]

Не понял
Любой DX совместим со всеми своими прошлыми версиями. Пиши на 7. Будет работать на всех, начиная с 7...

Это я понимаю, но все примеры которые я видел, реализованы на 6 версии (которой у меня нет).
Примеров хотя бы на 7 - я не встречал, может ты поможешь?

ЗЫ. Но прежде чем искать, скажи - с помощью DirectSound есть возможность одновременно записывать и воспроизводить записанное?

[GSerg]

С помощью DX вообще всё можно делать... SoundBuffer создаём и извращаем его как угодно...
Но! Я тебе в этом не помощник

Бери DX8 SDK, вот там есть инфа... В частности, хороший chm там есть...

[Sirik]

Пасибо. Значит лучше использовать DX8!
Буду пробовать, о результатах сообщу позже...

[GM]

Sirik возможно ты меня не понял. Вообщем тут пример у меня по захвату звука есть на DX, так как закачка не работает я тебе в личные сообщения скину.

[Sirik]

2 GM
Большое спасибо, буду разбиратся.