DirectSound в VB6. / Звук / Форум / Общество изобретателей велосипедов / GameDev.ru

Параллельно с Direct3D9 я делал библиотеку типов и модуль с вспомогательными функциями для DirectSound. В архиве библиотека типов dsvb.tlb и модуль DS_Functions.bas. В дальнейшем добавлю модуль класса для поддержки асинхронных уведомлений, пока можно пользоваться этим. После компиляции никаких зависимостей не остается (ну естественно нужен установленный DirectX).
В модуле DS_Functions содержатся следующие функции:
- DSCreateSoundBufferFromFile - создает объект с интерфейсом IDirectSoundBuffer8 из файла. Поддерживаются только WAVE и MP3 файлы. MP3 файлы могут содержать только ID3v1 и ID3v2 теги, какие-либо другие возможно не распознаются/не будут работать. Слишком длинные (по времени) файлы не поддерживаются. Для потокового воспроизведения нужно писать потоковое декодирование на основе кода функции DSCreateSoundBufferFromMemory. Для MP3 файлов используется конвертирование в WAV, а затем заполнение буфера PCM данными, используя ACM.
- DSCreateSoundBufferFromMemory - тоже самое, но вместо файла передается указатель на данные файла в памяти и их размер.
Также в архиве содержится пример WAVE/MP3 плеера который реализует некоторые методы IDirectSoundBuffer8 интерфейса (громкость, панорама, частота, эффекты).
TLB также особо сильно не тестировалась, поэтому что-то может не работать.

Скачать

AWPStar
Постоялец

#1
9:37, 2 фев 2016

Разобрался Точнее Mikle помог разобраться).
Я просто думал, что lpFmt - это указатель на данные.

Привет. Для конкурса 32К начал урезать все, что можно. Но есть косяк. В P-коде вылетает, причем если добавить одну неиспользуемую переменную, то все ок.
Переменная reserved в процедуре DSCreateSoundBufferFromMemory. Если её убираю - все крашится.
Сможешь посмотреть?

+ Показать

− Скрыть

Public Function DSCreateSoundBufferFromMemory(ByVal ds As DirectSound8, _
                                              ByVal lpData As Long, _
                                              ByVal szData As Long, _
                                              ByRef bufDesc As DSBUFFERDESC) As IDirectSoundBuffer

    Dim lpFmt   As Long
    Dim lpDat   As Long
    Dim szDat   As Long
    Dim ptr     As Long
    Dim reserved As Long

    lpFmt = lpData + 20
    lpDat = lpData + 44
    szDat = szData - 44

    bufDesc.dwSize = Len(bufDesc)
    bufDesc.dwBufferBytes = szDat
    bufDesc.lpwfxFormat = lpFmt

    ds.CreateSoundBuffer bufDesc, DSCreateSoundBufferFromMemory, ByVal 0&

    DSCreateSoundBufferFromMemory.Lock 0, 0, ptr, szDat, 0, 0, DSBLOCK_ENTIREBUFFER
    memcpy ByVal ptr, ByVal lpDat, szDat
    DSCreateSoundBufferFromMemory.Unlock ptr, szDat, 0, 0
End Function

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

https://yadi.sk/d/baG7qf-co9S6Y

В Оригинальная убрал обработку mp3, чтобы в окно влазла).

+ Показать

− Скрыть

Public Function DSCreateSoundBufferFromMemory(ByVal ds As DirectSound8, _
                                              ByVal lpData As Long, _
                                              ByVal szData As Long, _
                                              ByRef bufDesc As DSBUFFERDESC) As IDirectSoundBuffer
    Dim chkData As CHUNK
    Dim subChnk As CHUNK
    Dim chkType As Long
    Dim lpFmt   As Long
    Dim szFmt   As Long
    Dim lpDat   As Long
    Dim szDat   As Long
    Dim size    As Long
    Dim ptr     As Long
    Dim ret     As Long
    Dim hdr(9)  As Byte
    
    ' // Check size
    If szData < 4 Then GoTo ERROR_OUTOFMEMORY
    ' // Check RIFF
    If IsBadReadPtr(ByVal lpData, szData) Then GoTo ERROR_OUTOFMEMORY
    GetMem4 ByVal lpData, chkData
    
        ' // Wave
        If IsBadReadPtr(ByVal lpData, 8) Then GoTo ERROR_OUTOFMEMORY
        GetMem8 ByVal lpData, chkData
        ' // Check size
        If chkData.szData > szData Then GoTo ERROR_OUTOFMEMORY
        lpData = lpData + 8
        If IsBadReadPtr(ByVal lpData, chkData.szData) Or chkData.szData < 4 Then GoTo ERROR_OUTOFMEMORY
        GetMem4 ByVal lpData, chkType
        If chkType <> WAVE_SIGNATURE Then GoTo ERROR_FORMAT
        
        lpData = lpData + 4
        chkData.szData = chkData.szData - 4
        ' // Find chunks
        Do While (chkData.szData >= 8) And Not (lpFmt > 0 And lpDat > 0)
            
            GetMem8 ByVal lpData, subChnk
            lpData = lpData + 8
            
            If subChnk.szData > chkData.szData - 8 Then GoTo ERROR_OUTOFMEMORY
            
            Select Case subChnk.id
            Case FMT_SIGNATURE
            
                If lpFmt Then GoTo ERROR_FORMAT
                lpFmt = lpData
                szFmt = subChnk.szData
                
            Case DATA_SIGNATURE
                
                If lpDat Then GoTo ERROR_FORMAT
                lpDat = lpData
                szDat = subChnk.szData

            End Select
            lpData = lpData + subChnk.szData + (subChnk.szData And 1)
            
            chkData.szData = chkData.szData - 8 - subChnk.szData
            
        Loop
        
        If lpFmt <> 0 And lpDat <> 0 And szFmt > 0 And szDat > 0 Then
            
            bufDesc.dwSize = Len(bufDesc)
            bufDesc.dwBufferBytes = szDat
            bufDesc.lpwfxFormat = lpFmt
            
            ds.CreateSoundBuffer bufDesc, DSCreateSoundBufferFromMemory, ByVal 0&
            
            DSCreateSoundBufferFromMemory.Lock 0, 0, ptr, szDat, 0, 0, DSBLOCK_ENTIREBUFFER
            memcpy ByVal ptr, ByVal lpDat, szDat
            DSCreateSoundBufferFromMemory.Unlock ptr, szDat, 0, 0
            
        Else:   GoTo ERROR_FORMAT
        End If
  
    Exit Function
    
ERROR_OUTOFMEMORY:
    Err.Raise 7:    Exit Function
ERROR_FORMAT:
    Err.Raise 5:    Exit Function
    
End Function

the trick
Постоялец

#2
11:14, 2 фев 2016

AWPStar
Нет, там действительно была ошибка, и в моем модуле тоже, спасибо за тестирование.
Нужно в DSCreateSoundBufferFromMemory, где я передавал 0 передавать 0&, иначе функция считает что это Integer (2 байта). Когда ты передавал reserved то функция писала оставшиеся 2 байта в первую половину reserved, а когда убирал переменная ptr частично затиралась. Так что просто нужно передавать 0&.
На самом деле так не нужно создавать так создавать буфер через временный файл - пиши данные сразу:

Option Explicit

Private Declare Function memcpy Lib "kernel32" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long) As Long

Public 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

Function GetSound(ByVal ds As DirectSound8, b() As Byte) As IDirectSoundBuffer
    Dim bd  As DSBUFFERDESC
    Dim wf  As WAVEFORMATEX
    Dim ptr As Long
    Dim cb  As Long
    
    ' // Set format
    wf.wFormatTag = 1
    wf.wBitsPerSample = 8
    wf.nSamplesPerSec = 44100
    wf.nChannels = 1
    wf.nBlockAlign = (wf.wBitsPerSample \ 8) * wf.nChannels
    wf.nAvgBytesPerSec = wf.nSamplesPerSec * wf.nBlockAlign
    
    ' // Set buffer descriptor
    bd.dwFlags = DSBCAPS_CTRLVOLUME Or DSBCAPS_CTRLPAN Or DSBCAPS_CTRLFREQUENCY Or DSBCAPS_CTRLFX
    bd.dwSize = Len(bd)
    bd.lpwfxFormat = VarPtr(wf)
    bd.dwBufferBytes = UBound(b) + 1
    
    ' // Create buffer
    ds.CreateSoundBuffer bd, GetSound, ByVal 0&
    ' // Lock buffer
    GetSound.Lock 0, 0, ptr, cb, 0&, 0&, DSBLOCK_ENTIREBUFFER
    ' // Copy audio data
    memcpy ByVal ptr, b(0), cb
    ' // Unlock buffer
    GetSound.Unlock ptr, cb, 0&, 0&
    
End Function

Это намного быстрее и короче. API объяви в tlb, чтобы они меньше места занимали и быстрее работали.

AWPStar
Постоялец

#3
0:53, 29 авг 2016

Не совсем по теме. Сделал тут небольшй(совсем) движек.
https://yadi.sk/d/rcWIJlnQuYycR
Компилировал на FreeBasic. Исходники в архиве.

Правда надо бы константы добавить, но они стандартные.

+ функции

− Скрыть

functions:
snd_INIT(ByVal hWnd As Long) As Long
snd_FREE() As Long
snd_LastError() As Long

snd_Load_WAVByVal szFile As String) As Long ' returns sound ID
snd_Load_RAW(ByVal fmt As WAVEFORMATEX, ByVal DataPtr As Long, ByVal Length As Long) As Long ' returns sound ID
snd_Update_RAW(ByVal i As Long, ByVal fmt As WAVEFORMATEX, ByVal DataPtr As Long, ByVal Length As Long) As Long

snd_Close(ByVal id As Long) As Long
snd_Status(ByVal id As Long) As Long

snd_Play(ByVal id As Long, ByVal PlayLoop As Long) As Long
snd_Stop(ByVal id As Long) As Long
snd_Pause(ByVal id As Long) As Long

snd_SetPosition(ByVal id As Long, ByVal Position As Long) As Long
snd_GetPosition(ByVal id As Long) As Long
snd_MaxPosition(ByVal id As Long) As Long

snd_SetVolume(ByVal id As Long, ByVal Position As Long) As Long
snd_GetVolume(ByVal id As Long) As Long

snd_SetPanorama(ByVal id As Long, ByVal Position As Long) As Long
snd_GetPanorama(ByVal id As Long) As Long

snd_SetFrequency(ByVal id As Long, ByVal Position As Long) As Long
snd_GetFrequency(ByVal id As Long) As Long