[VB6] - 3D sound using DirectSound.
Hello everyone.
The example shows an implementation of 3D sound, every object in three-dimensional space "assigned" the sound. To work need a library dx8vb.dll. Shift / Ctrl - deceleration of 10 times, the left button to rotate the camera, right tilt left / right. Spheres - sound sources, each can be turned on / off. Commented only work with sound:
Code:
Option Explicit
Dim dx As DirectX8 ' Объект DirectX8
Dim dxs As DirectSound8 ' Объект DirectSound
Dim dl As DirectSound3DListener8 ' Слушатель
Dim dp As DirectSoundPrimaryBuffer8 ' Первичный буфер
Dim ds() As DirectSoundSecondaryBuffer8 ' Вторичные буфера
Dim db() As DirectSound3DBuffer8 ' 3D буфера
Dim dev As Direct3DDevice8 ' Для визуализации ...
Dim d3d As Direct3D8 ' ...
Dim d3msh As D3DXMesh ' ...
Dim d3pln As D3DXMesh ' ...
Private Const CountSources = 3 ' Количество источников звука
' // Отключение/включение звука
Private Sub chkSound_Click(Index As Integer)
' Если стоит галочка, то
If chkSound(Index).Value = vbChecked Then
' Проигрываем звук с зацикливанием по кругу
ds(Index).Play DSBPLAY_LOOPING
Else
' Иначе останавливаем
ds(Index).Stop
End If
End Sub
' // Процедура обрабтки нажатий клавиш
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
Dim curPos As D3DVECTOR ' Текущая позиция слушателя
Dim curOrt As D3DVECTOR ' Текущий вектор ориентации
Dim curTop As D3DVECTOR ' Текущий вектор "макушки" слушателя
Dim curLft As D3DVECTOR ' Вектор влево относительно ориентации слушателя
' Получаем позицию слушателя
dl.GetPosition curPos
' Получаем ориентацию и направление вверх
dl.GetOrientation curOrt, curTop
' С помощью векторного произведения находим препендикуляр к этим двум векторам, т.е. вектор влево
D3DXVec3Cross curLft, curOrt, curTop
' Если нажата Shift/Ctrl
If Shift Then
' Уменьшаем размер в 10 раз
D3DXVec3Scale curOrt, curOrt, 0.1 ' вектора ориентации
D3DXVec3Scale curLft, curLft, 0.1 ' вектора влево
End If
' Получение кода нажатой клавиши
Select Case KeyCode
Case vbKeyW, vbKeyUp
' Вперед. Прибавляем к текущим координатам вектор ориентации
D3DXVec3Add curPos, curPos, curOrt
Case vbKeyA, vbKeyLeft
' Влево. Прибавляем к текущим координатам вектор влево
D3DXVec3Add curPos, curPos, curLft
Case vbKeyD, vbKeyRight
' Вправо. Вычитаем из текущих координат вектор влево
D3DXVec3Subtract curPos, curPos, curLft
Case vbKeyS, vbKeyDown
' Назад. Вычитаем из текущих координат ориентацию
D3DXVec3Subtract curPos, curPos, curOrt
End Select
' Устанавливаем измененную позицию
dl.SetPosition curPos.X, curPos.Y, curPos.z, DS3D_IMMEDIATE
' Визуализация
Render
End Sub
' // Процедура загрузки формы
Private Sub Form_Load()
' Создаем объект DirectX8
Set dx = New DirectX8
' Создаем объект DirectSound
Set dxs = dx.DirectSoundCreate(vbNullString)
' Настраиваем совместный доступ
dxs.SetCooperativeLevel Me.hWnd, DSSCL_NORMAL
' Описатель буфера
Dim bd As DSBUFFERDESC
' Это первичный буфер и возможность контролировать положение и ориентацию в пространстве
bd.lFlags = DSBCAPS_PRIMARYBUFFER Or DSBCAPS_CTRL3D
' Создаем первичный буфер
Set dp = dxs.CreatePrimarySoundBuffer(bd)
' Получаем объект слушателя
Set dl = dp.GetDirectSound3DListener()
' Для других буферов возможность контролировать положение и ориентацию в пространстве
bd.lFlags = DSBCAPS_CTRL3D
' Задаем ориентацию вперед
dl.SetOrientation 0, 0, 1, 0, 1, 0, DS3D_DEFERRED
Dim i As Long ' Временная переменная
Dim fil As Boolean ' В IDE - загрузка из файла, в EXE из ресурсов
ReDim ds(CountSources - 1) ' Массив вторичных буферов (источников)
ReDim db(CountSources - 1) ' Массив 3D буферов
Randomize
For i = 0 To CountSources - 1
Debug.Assert InIDE(fil)
' Загружаем из файла или из ресурса в зависимости от режима работы
If fil Then
Set ds(i) = dxs.CreateSoundBufferFromFile(Choose(i + 1, "Sound.wav", "Moto.wav", "Police.wav"), bd)
Else
Set ds(i) = dxs.CreateSoundBufferFromResource(App.EXEName & ".exe", Choose(i + 1, "#101", "#102", "#103"), bd)
End If
' Получаем объект 3D буфера
Set db(i) = ds(i).GetDirectSound3DBuffer()
' Задаем рандомную позицию
db(i).SetPosition Rnd * 50 - 25, Rnd * 50, Rnd * 50 - 25, DS3D_DEFERRED
' Включаем воспроизведение
ds(i).Play DSBPLAY_LOOPING
Next
' Запуск просчета изменений
dl.CommitDeferredSettings
' Для визуализации (не комментирую)
' //----//----//----//----//----//
Dim pp As D3DPRESENT_PARAMETERS
Dim dm As D3DDISPLAYMODE
Set d3d = dx.Direct3DCreate()
d3d.GetAdapterDisplayMode D3DADAPTER_DEFAULT, dm
pp.BackBufferFormat = dm.Format
pp.Windowed = 1
pp.SwapEffect = D3DSWAPEFFECT_DISCARD
pp.EnableAutoDepthStencil = 1
pp.AutoDepthStencilFormat = D3DFMT_D16
Set dev = d3d.CreateDevice(D3DADAPTER_DEFAULT, D3DDEVTYPE_HAL, pic.hWnd, D3DCREATE_HARDWARE_VERTEXPROCESSING, pp)
Dim mtx As D3DMATRIX
D3DXMatrixPerspectiveFovLH mtx, 3.14 / 180 * 80, pic.ScaleHeight / pic.ScaleWidth, 0.1, 200
dev.SetTransform D3DTS_PROJECTION, mtx
dev.SetRenderState D3DRS_ZENABLE, D3DZB_TRUE
dev.SetRenderState D3DRS_LIGHTING, 1
Dim d3 As D3DX8
Dim dat() As Byte
Set d3 = New D3DX8
Set d3msh = d3.CreateSphere(dev, 1, 16, 8, Nothing)
Set d3pln = d3.CreatePolygon(dev, 100, 4, Nothing)
Dim lth As D3DLIGHT8
Dim mat As D3DMATERIAL8
lth.Type = D3DLIGHT_POINT
lth.diffuse = col(1, 1, 1)
lth.Position = vec3(0, 100, -100)
lth.Attenuation1 = 0.01
lth.Range = 400
dev.SetLight 0, lth
dev.LightEnable 0, 1
mat.diffuse = col(1, 1, 1)
dev.SetMaterial mat
' //----//----//----//----//----//
End Sub
' // Визуализация
Private Sub Render()
Dim idx As Long
Dim v1 As D3DVECTOR
Dim v2 As D3DVECTOR
Dim v3 As D3DVECTOR
Dim mtx As D3DMATRIX
dev.Clear 0, ByVal 0, D3DCLEAR_ZBUFFER Or D3DCLEAR_TARGET, &HAFFFFF, 1, 0
dev.BeginScene
dev.SetVertexShader d3msh.GetFVF
dl.GetPosition v1: dl.GetOrientation v2, v3
D3DXVec3Add v2, v1, v2
D3DXMatrixLookAtLH mtx, v1, v2, v3
dev.SetTransform D3DTS_VIEW, mtx
D3DXMatrixTranslation mtx, 0, -3, 0
dev.SetTransform D3DTS_WORLD, mtx
D3DXMatrixRotationX mtx, -3.14 / 2
dev.MultiplyTransform D3DTS_WORLD, mtx
d3pln.DrawSubset 0
For idx = 0 To CountSources - 1
db(idx).GetPosition v1
D3DXMatrixTranslation mtx, v1.X, v1.Y, v1.z
dev.SetTransform D3DTS_WORLD, mtx
d3msh.DrawSubset 0
Next
dev.EndScene
dev.Present ByVal 0, ByVal 0, 0, ByVal 0
End Sub
' // Функция сздания векторов
Private Function vec3(ByVal X As Single, ByVal Y As Single, ByVal z As Single) As D3DVECTOR
vec3.X = X: vec3.Y = Y: vec3.z = z
End Function
' // Функция создания цветов
Private Function col(r As Single, g As Single, b As Single) As D3DCOLORVALUE
col.r = r
col.g = g
col.b = b
col.a = 1
End Function
' // Процедура выгрузки формы
Private Sub Form_Unload(Cancel As Integer)
Dim i As Long
' Проход по всем буферам
For i = 0 To CountSources - 1
' Остановка
ds(i).Stop
' Удаление и очистка
Set ds(i) = Nothing
Set db(i) = Nothing
Next
Set dl = Nothing
Set dp = Nothing
Set dxs = Nothing
Set dx = Nothing
End Sub
' // Процедура обработки мыши
Private Sub pic_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Static ox As Single, oy As Single
Dim mtx As D3DMATRIX
Dim qt1 As D3DQUATERNION
Dim qt2 As D3DQUATERNION
Dim v1 As D3DVECTOR
Dim v2 As D3DVECTOR
Dim v3 As D3DVECTOR
' При движении с зажатой левой кнопкой изменяем ориентацию
If Button = vbLeftButton Then
dl.GetOrientation v1, v2
D3DXVec3Cross v3, v1, v2
D3DXQuaternionRotationAxis qt1, v2, (X - ox) / 50
D3DXQuaternionRotationAxis qt2, v3, -(Y - oy) / 50
D3DXQuaternionMultiply qt1, qt1, qt2
D3DXMatrixRotationQuaternion mtx, qt1
D3DXVec3TransformCoord v1, v1, mtx
D3DXVec3TransformCoord v2, v2, mtx
dl.SetOrientation v1.X, v1.Y, v1.z, v2.X, v2.Y, v2.z, DS3D_IMMEDIATE
Render
' При правой кнопке - наклон (направление вверх)
ElseIf Button = vbRightButton Then
dl.GetOrientation v1, v2
D3DXQuaternionRotationAxis qt1, v1, (X - ox) / 50
D3DXMatrixRotationQuaternion mtx, qt1
D3DXVec3TransformCoord v1, v1, mtx
D3DXVec3TransformCoord v2, v2, mtx
dl.SetOrientation v1.X, v1.Y, v1.z, v2.X, v2.Y, v2.z, DS3D_IMMEDIATE
Render
End If
ox = X: oy = Y
End Sub
Private Sub pic_Paint()
Render
End Sub
Private Function InIDE(z As Boolean) As Boolean
z = True: InIDE = z
End Function
Download source code.
