Модераторы: Akina
  

Поиск:

Ответ в темуСоздание новой темы Создание опроса
> запись звука с источника в RAM, как записать без DirectX 
:(
    Опции темы
Voldemar2004
Дата 16.3.2005, 19:14 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


Профиль
Группа: Завсегдатай
Сообщений: 1650
Регистрация: 25.12.2004

Репутация: 7
Всего: 23
Как без использования DirectX записать звук используя MMControl 6 c микрофонного входа или с линейного, если кто знает, если нельзя, то буду использовать DirectX.
Кто-нибудь знает по WIn-API MMControl ссылочку?


--------------------
i_i 
(';') 
(V)

user posted image
PM MAIL   Вверх
Voldemar2004
Дата 17.3.2005, 18:26 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


Профиль
Группа: Завсегдатай
Сообщений: 1650
Регистрация: 25.12.2004

Репутация: 7
Всего: 23
Код

Option Explicit
Implements DirectXEvent8

'Сам DirectX8
Private objDX8 As DirectX8
'Объект для захвата звука
Private objDSCapture As DirectSoundCapture8
'Буфер, куда пудет записываться звук
Private objDSCaptureBuffer As DirectSoundCaptureBuffer8

'Дескриптор для создания буфера
Private CaptureDesc As DSCBUFFERDESC

'Это для обработки событий буфера
'   последняя позиция, на которой произошло событие
Private lastPos As Long
'   сколько всего байтов записали
Private BytesWritten As Long
'   идентификатор события остановки
Private EventStop As Long
'   идентификатор собый, возникающих во время записи
Private EventNotify As Long

'возможности захватывающего устройства
Private CaptureCaps As DSCCAPS

'Эти три типа нужны для записи в WAV-файл
'   заголовок файла
Private Type FileHeader
  lRiff As Long
  lFileSize As Long
  lWave As Long
  lFormat As Long
  lFormatLength As Long
End Type
'   формат WAV
Private Type WaveFormat
  wFormatTag As Integer
  nChannels As Integer
  nSamplesPerSec As Long
  nAvgBytesPerSec As Long
  nBlockAlign As Integer
  wBitsPerSample As Integer
End Type
Private Type ChunkHeader
  lType As Long
  lLen As Long
End Type

Dim fh As FileHeader
Dim wf As WaveFormat
Dim ch As ChunkHeader


Private Sub cmdCreateBuffer_Click()
    'Здесь создадим и проинициализируем буфер
    
    'Будет 3 уведомления
    Dim tmp(0 To 2)  As DSBPOSITIONNOTIFY
    
    'первые два - по ходу записи
    With tmp(0)
        .lOffset = 10000
        .hEventNotify = EventNotify
    End With
    With tmp(1)
        .lOffset = 30000
        .hEventNotify = EventNotify
    End With
    'а это по завершении
    With tmp(2)
        .lOffset = DSBPN_OFFSETSTOP
        .hEventNotify = EventStop
    End With
    
    'укажем формат захвата звука
    With CaptureDesc.fxFormat
        .nFormatTag = WAVE_FORMAT_PCM
        .nChannels = 2
        .lSamplesPerSec = 22050
        .nBitsPerSample = 16
        .nBlockAlign = .nBitsPerSample / 8 * .nChannels
        .lAvgBytesPerSec = .lSamplesPerSec * .nBlockAlign
        .nSize = 0
    End With
    
    CaptureDesc.lFlags = DSCBCAPS_DEFAULT
    'Размер буфера. В данном случае 5 секунд
    CaptureDesc.lBufferBytes = CaptureDesc.fxFormat.lAvgBytesPerSec * 5
    
    'Создадим буфер
    Set objDSCaptureBuffer = objDSCapture.CreateCaptureBuffer(CaptureDesc)
    
    'Добавим три уведомления
    objDSCaptureBuffer.SetNotificationPositions 3, tmp
End Sub

Private Sub cmdStart_Click()
    
    'Здесь инициализируются необходимые объекты
    '   это для определния поддерживаемых форматов
    Dim lngFormats As CONST_WAVEFORMATFLAGS
    'создаем экзепляр DirectX8
    Set objDX8 = New DirectX8
    
    'Создаем два события
    '   остановка захвата
    EventStop = objDX8.CreateEvent(Me)
    '   во время захвата
    EventNotify = objDX8.CreateEvent(Me)
    
    'Создаем объект для захвата. В параметре указана vbNullString, что означает, что
    'нами будет использоваться устройство захвата по умолчанию
    Set objDSCapture = objDX8.DirectSoundCaptureCreate(vbNullString)
    
    'Получим возможность устройства
    objDSCapture.GetCaps CaptureCaps
    
'---------------------------------------------------------------------------------------------

    'Здесь создадим и проинициализируем буфер
    
    'Будет 3 уведомления
    Dim tmp(0 To 2)  As DSBPOSITIONNOTIFY
    
    'первые два - по ходу записи
    With tmp(0)
        .lOffset = 10000
        .hEventNotify = EventNotify
    End With
    With tmp(1)
        .lOffset = 30000
        .hEventNotify = EventNotify
    End With
    'а это по завершении
    With tmp(2)
        .lOffset = DSBPN_OFFSETSTOP
        .hEventNotify = EventStop
    End With
    
    'укажем формат захвата звука
    With CaptureDesc.fxFormat
        .nFormatTag = WAVE_FORMAT_PCM
        .nChannels = 2
        .lSamplesPerSec = 22050
        .nBitsPerSample = 16
        .nBlockAlign = .nBitsPerSample / 8 * .nChannels
        .lAvgBytesPerSec = .lSamplesPerSec * .nBlockAlign
        .nSize = 0
    End With
    
    CaptureDesc.lFlags = DSCBCAPS_DEFAULT
    'Размер буфера. В данном случае 1 секунда
    CaptureDesc.lBufferBytes = CaptureDesc.fxFormat.lAvgBytesPerSec * 1 '5
    
    'Создадим буфер
    Set objDSCaptureBuffer = objDSCapture.CreateCaptureBuffer(CaptureDesc)
    
    'Добавим три уведомления
    objDSCaptureBuffer.SetNotificationPositions 3, tmp

'---------------------------------------------------------------------------------------------
    
    'Путь к файлу
    Dim strPath As String
    strPath = txtPath.Text
    
    'Откроем файл для двоичного доступа на запись
    Open strPath For Binary Access Write As #1
  
    'Запишем заголовки
    With fh
        .lRiff = &H46464952
        .lFileSize = 0   ' Размер файла узнаем позже
        .lWave = &H45564157
        .lFormat = &H20746D66
        .lFormatLength = Len(wf)
    End With
    Put #1, , fh
    With wf
        .wFormatTag = CaptureDesc.fxFormat.nFormatTag
        .nChannels = CaptureDesc.fxFormat.nChannels
        .nSamplesPerSec = CaptureDesc.fxFormat.lSamplesPerSec
        .wBitsPerSample = CaptureDesc.fxFormat.nBitsPerSample
        .nBlockAlign = CaptureDesc.fxFormat.nBlockAlign
        .nAvgBytesPerSec = CaptureDesc.fxFormat.lAvgBytesPerSec
    End With
    Put #1, , wf
    ch.lType = &H61746164
    Put #1, , ch

'---------------------------------------------------------------------------------------------

    'Начнем запись. DSCBSTART_LOOPING означает, что захват будет вестись бесконечно,
    'пока не будет остановлен вручную.
    objDSCaptureBuffer.Start DSCBSTART_LOOPING
    
End Sub

Private Sub cmdStop_Click()
    'А вот и эта ручная остановка
    objDSCaptureBuffer.Stop
End Sub

'А вот и обработка событий буфера
Private Sub DirectXEvent8_DXCallback(ByVal eventid As Long)
    
    'Здесь будет текущее положение курсора
    Dim curPos As Long
    Dim curs As DSCURSORS
    
    'Это считанные данные
    Dim dataBuf() As Byte
    'А это размер считанных данных
    Dim dataSize As Long
    
    'Узнаем текущую позицию
    objDSCaptureBuffer.GetCurrentPosition curs
    curPos = curs.lWrite  ' Вполть до этой позиции можно считывать данные
       
    
    'Узнаем, сколько байт накопилось с прошлой записи в файл,
    'получив разность между текущим положением курсора и прошлым
    dataSize = curPos - lastPos
    'Если эта разница меньше 0, то значит, что с прошлой записи
    'курсор дошел до конца и запись вновь началась с начала буфера.
    'Тогда размер данных складывается из двух: того, что прошел с начала
    'буфера (curPos), и того, что оставался с момента прошлого вызова:
    '<размер буфера>-lastPos.
    If dataSize < 0 Then
        dataSize = (CaptureDesc.lBufferBytes - lastPos) + curPos
    End If
    
    'Переопределим размер локального буфера
    ReDim dataBuf(dataSize - 1)
    'И считаем в него данные
    objDSCaptureBuffer.ReadBuffer lastPos, dataSize, dataBuf(0), DSCBLOCK_DEFAULT
        
    'Запишем эти данные и увеличим счетчик записанных байтов
    Put #1, , dataBuf
    BytesWritten = BytesWritten + dataSize
    
    lblBytesWritten.Caption = BytesWritten
    lastPos = curPos
    
    'Это так, для отладки
    Select Case eventid
        Case EventStop
            Debug.Print "DxEvent::Stop:: всего байт записали " & BytesWritten
        Case EventNotify
            Debug.Print "DxEvent::Notify:: в этом событии записали " & dataSize & " байт"
    End Select
    
    'Если событие "Остановка", то завершим запись в файл
    If (eventid = EventStop) Then
        CloseFile
    End If

End Sub

Private Sub CloseFile()
  Dim fsize As Long
  
  'А теперь вернемся к прощенному: размер файла - теперь он нам известен
  fsize = Len(fh) + Len(wf) + Len(ch) + BytesWritten
  Put #1, 5, fsize
  
  ' Rewrite data chunk header with size.
  
  'То же и с Chunk
  ch.lLen = BytesWritten
  Put #1, Len(fh) + Len(wf) + 1, ch
  
  Close #1
End Sub

Private Sub Form_Unload(Cancel As Integer)
    'Ну а теперь надо зачистить все за собой
    
    'Для начала проверим, остановлен ли захват
    'Если нет, то нажмем на кнопку "Стоп"
    If (objDSCaptureBuffer.GetStatus And DSCBSTATUS_CAPTURING) > 1 Then
        cmdStop.Value = True
    End If
    
    'Удалим события
    objDX8.DestroyEvent EventStop
    objDX8.DestroyEvent EventNotify
    
    'А теперь уничтожим объекты
    Set objDSCaptureBuffer = Nothing
    Set objDSCapture = Nothing
    Set objDX8 = Nothing
End Sub



вот нашел учебный пример, показывающий запись в Wav-файл с микрофона,
что значит строка

Код

 Set objDSCapture = objDX8.DirectSoundCaptureCreate(vbNullString)


в комментариях написано, что vbNullString - устройство захвата по умолчанию - микрофонных вход на звуковухе что-ли?. Тогда как инициализировать Line-in. Неуж-то никто не знает?



--------------------
i_i 
(';') 
(V)

user posted image
PM MAIL   Вверх
  
 Ответ в темуСоздание новой темы Создание опроса
Правила форума "VB6"
Akina

Запрещается!

1. Публиковать ссылки на вскрытые компоненты

2. Обсуждать взлом компонентов и делиться вскрытыми компонентами

  • Литературу по VB обсуждаем здесь
  • Действия модераторов можно обсудить здесь
  • С просьбами о написании курсовой, реферата и т.п. обращаться сюда
  • Вопросы по реализации алгоритмов рассматриваются здесь
  • Используйте теги [code=vb][/code] для подсветки кода. Используйтe чекбокс "транслит" (возле кнопок кодов) если у Вас нет русских шрифтов.

Если Вам понравилась атмосфера форума, заходите к нам чаще! С уважением, Akina.
 
0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема | VB6 | Следующая тема »

Подписаться на тему | Подписка на этот форум | Скачать/Распечатать тему


 




[ Время генерации скрипта: 0.3734 ]   [ Использовано запросов: 22 ]   [ GZIP включён ]


Реклама на сайте     Информационное спонсорство

 
 По вопросам размещения рекламы пишите на vladimir(sobaka)vingrad.ru
Отказ от ответственности     Powered by Invision Power Board(R) 1.3 © 2003  IPS, Inc.