Sources
Delphi Russian Knowledge Base
DRKB - это самая большая и удобная в использовании база знаний по Дельфи в рунете, составленная Виталием Невзоровым

Как использовать в своей программе API DirectSound и DirectSound3D?

01.01.2007

Представляю вашему вниманию рабочий пример использования DirectSound на Delphi + несколько полезных процедур. В этом примере создается один первичный SoundBuffer и 2 статических, вторичных; в них загружаются 2 WAV файла. Первичный буфер создается процедурой AppCreateWritePrimaryBuffer, а любой вторичный - AppCreateWritePrimaryBuffer. Так как вторичный буфер связан с WAV файлом, то при создании буфера нужно определить его параметры в соответствии со звуковым файлом, эти характеристики (Samples, Bits, IsStereo) задаются в виде параметров процедуры. Time - время WAV'файл в секундах (округление в сторону увеличения). При нажатии на кнопку происходит микширование из вторичных буферов в первичный. AppWriteDataToBuffer позволяет записать в буфер PCM сигнал. Процедура CopyWAVToBuffer открывает WAV файл, отделяет заголовок, читает чанк 'data' и копирует его в буфер (при этом сначала считывается размер данных, так как в некоторых WAV файлах существует текстовый довесок, и если его не убрать, в динамиках возможен треск).

Пример 1-ый

unit Unit1;
 
interface
 
uses
 
Windows, Messages, SysUtils, Classes, Graphics, Controls,
 
Forms, Dialogs, DSound, MMSystem, StdCtrls, ExtCtrls;
 
type
  TForm1
= class(TForm)
    Button1
: TButton;
    Timer1
: TTimer;
    procedure
FormCreate(Sender: TObject);
    procedure
FormDestroy(Sender: TObject);
    procedure Button1Click
(Sender: TObject);
 
private
   
{ Private declarations }
   
DirectSound : IDirectSound;
   
DirectSoundBuffer : IDirectSoundBuffer;
   
SecondarySoundBuffer : array[0..1] of IDirectSoundBuffer;
    procedure
AppCreateWritePrimaryBuffer;
    procedure
AppCreateWriteSecondaryBuffer(var Buffer: IDirectSoundBuffer;
     
SamplesPerSec: Integer; Bits: Word; isStereo:Boolean; Time: Integer);
    procedure
AppWriteDataToBuffer(Buffer: IDirectSoundBuffer;
     
OffSet: DWord; var SoundData; SoundBytes: DWord);
    procedure
CopyWAVToBuffer(name: PChar; var Buffer: IDirectSoundBuffer);
 
public
   
{ Public declarations }
end;
 
var
  Form1
: TForm1;
 
implementation
 
{$R *.DFM}
 
procedure TForm1
.FormCreate(Sender: TObject);
begin
 
if DirectSoundCreate(nil, DirectSound, nil) <> DS_OK then
   
raise Exception.Create('Failed to create IDirectSound object');
 
AppCreateWritePrimaryBuffer;
 
AppCreateWriteSecondaryBuffer(SecondarySoundBuffer[0], 22050,8,False,10);
 
AppCreateWriteSecondaryBuffer(SecondarySoundBuffer[1], 22050,16,True,1);
end;
 
procedure TForm1
.FormDestroy(Sender: TObject);
var
  i
: ShortInt;
begin
 
if Assigned(DirectSoundBuffer) then
   
DirectSoundBuffer.Release;
 
for i:=0 to 1 do
   
if Assigned(SecondarySoundBuffer[i]) then
     
SecondarySoundBuffer[i].Release;
 
if Assigned(DirectSound) then
   
DirectSound.Release;
end;
 
procedure TForm1
.AppWriteDataToBuffer;
var
  AudioPtr1
, AudioPtr2 : Pointer;
  AudioBytes1
, AudioBytes2 : DWord;
  h
: HResult;
 
Temp : Pointer;
begin
  H
:=Buffer.Lock(OffSet, SoundBytes, AudioPtr1, AudioBytes1, AudioPtr2, AudioBytes2, 0);
 
if H = DSERR_BUFFERLOST then
 
begin
   
Buffer.Restore;
   
if Buffer.Lock(OffSet, SoundBytes, AudioPtr1, AudioBytes1, AudioPtr2, AudioBytes2, 0) <> DS_OK then
     
raise Exception.Create('Unable to Lock Sound Buffer');
 
end
 
else
 
if H <> DS_OK then
   
raise Exception.Create('Unable to Lock Sound Buffer');
 
Temp := @SoundData;
 
Move(Temp^, AudioPtr1^, AudioBytes1);
 
if AudioPtr2 <> nil then
 
begin
   
Temp := @SoundData; Inc(Integer(Temp), AudioBytes1);
   
Move(Temp^, AudioPtr2^, AudioBytes2);
 
end;
 
if Buffer.UnLock(AudioPtr1, AudioBytes1,AudioPtr2, AudioBytes2) <> DS_OK then
   
raise Exception.Create('Unable to UnLock Sound Buffer');
end;
 
procedure TForm1
.AppCreateWritePrimaryBuffer;
var
 
BufferDesc: DSBUFFERDESC;
 
Caps: DSBCaps;
  PCM
: TWaveFormatEx;
begin
 
FillChar(BufferDesc, SizeOf(DSBUFFERDESC),0);
 
FillChar(PCM, SizeOf(TWaveFormatEx),0);
 
with BufferDesc do
 
begin
    PCM
.wFormatTag:=WAVE_FORMAT_PCM;
    PCM
.nChannels:=2;
    PCM
.nSamplesPerSec:=22050;
    PCM
.nBlockAlign:=4;
    PCM
.nAvgBytesPerSec:=PCM.nSamplesPerSec * PCM.nBlockAlign;
    PCM
.wBitsPerSample:=16;
    PCM
.cbSize:=0;
    dwSize
:=SizeOf(DSBUFFERDESC);
    dwFlags
:=DSBCAPS_PRIMARYBUFFER;
    dwBufferBytes
:=0;
    lpwfxFormat
:=nil;
 
end;
 
if DirectSound.SetCooperativeLevel(Handle,DSSCL_WRITEPRIMARY) <> DS_OK then
   
raise Exception.Create('Unable to set Coopeative Level');
 
if DirectSound.CreateSoundBuffer(BufferDesc,DirectSoundBuffer,nil) <> DS_OK then
   
raise Exception.Create('Create Sound Buffer failed');
 
if DirectSoundBuffer.SetFormat(PCM) <> DS_OK then
   
raise Exception.Create('Unable to Set Format ');
 
if DirectSound.SetCooperativeLevel(Handle,DSSCL_NORMAL) <> DS_OK then
   
raise Exception.Create('Unable to set Coopeative Level');
end;
 
procedure TForm1
.AppCreateWriteSecondaryBuffer;
var
 
BufferDesc: DSBUFFERDESC;
 
Caps: DSBCaps;
  PCM
: TWaveFormatEx;
begin
 
FillChar(BufferDesc, SizeOf(DSBUFFERDESC),0);
 
FillChar(PCM, SizeOf(TWaveFormatEx),0);
 
with BufferDesc do
 
begin
    PCM
.wFormatTag:=WAVE_FORMAT_PCM;
   
if isStereo then
      PCM
.nChannels:=2
   
else
      PCM
.nChannels:=1;
    PCM
.nSamplesPerSec:=SamplesPerSec;
    PCM
.nBlockAlign:=(Bits div 8)*PCM.nChannels;
    PCM
.nAvgBytesPerSec:=PCM.nSamplesPerSec * PCM.nBlockAlign;
    PCM
.wBitsPerSample:=Bits;
    PCM
.cbSize:=0;
    dwSize
:=SizeOf(DSBUFFERDESC);
    dwFlags
:=DSBCAPS_STATIC;
    dwBufferBytes
:=Time*PCM.nAvgBytesPerSec;
    lpwfxFormat
:=@PCM;
 
end;
 
if DirectSound.CreateSoundBuffer(BufferDesc,Buffer,nil) <> DS_OK then
   
raise Exception.Create('Create Sound Buffer failed');
end;
 
procedure TForm1
.CopyWAVToBuffer;
var
 
Data : PChar;
 
FName : TFileStream;
 
DataSize : DWord;
 
Chunk : string[4];
 
Pos : Integer;
begin
 
FName:=TFileStream.Create(name,fmOpenRead);
 
Pos:=24;
 
SetLength(Chunk,4);
  repeat
   
FName.Seek(Pos, soFromBeginning);
   
FName.read(Chunk[1],4);
   
Inc(Pos);
 
until
   
Chunk = 'data';
 
FName.Seek(Pos+3, soFromBeginning);
 
FName.read(DataSize, SizeOf(DWord));
 
GetMem(Data,DataSize);
 
FName.read(Data^, DataSize);
 
FName.Free;
 
AppWriteDataToBuffer(Buffer,0,Data^,DataSize);
 
FreeMem(Data,DataSize);
end;
 
procedure TForm1
.Button1Click(Sender: TObject);
begin
 
CopyWAVToBuffer('1.wav',SecondarySoundBuffer[0]);
 
CopyWAVToBuffer('flip.wav',SecondarySoundBuffer[1]);
 
 
if SecondarySoundBuffer[0].Play(0,0,0) <> DS_OK then
   
ShowMessage('Can not play the Sound');
 
 
if SecondarySoundBuffer[1].Play(0,0,0) <> DS_OK then
   
ShowMessage('Can not play the Sound');
end;
 
end.

Пример 2-ой

Представляю вашему вниманию очередной пример работы с DirectSound на Delphi. В этом примере показан принцип работы с 3D буфером. Итак, процедуры AppCreateWritePrimaryBuffer, AppWriteDataToBuffer, CopyWAVToBuffer я оставил без изменения (см. письма с до этого). Процедура AppCreateWriteSecondary3DBuffer является полным аналогом процедуры AppCreateWriteSecondaryBuffer, за исключением флага DSBCAPS_CTRL3D, который указывает на то, что со статическим вторичным буфером будет связан еще один буфер - SecondarySound3DBuffer. Чтобы его инициализировать, а также установить некоторые начальные значения (положение в пространстве, скорость и .т.д.) вызывается процедура AppSetSecondary3DBuffer, в качестве параметров которой передаются сам SecondarySoundBuffer и связанный с ним SecondarySound3DBuffer. В этой процедуре SecondarySound3DBuffer инициализируется с помощью метода QueryInterface c соответствующим флагом. Кроме того, здесь же устанавливается положение источника звука в пространстве: SetPosition(Pos,1,1,0). X,Y,Z Таким образом в начальный момент времени источник находится на высоте 1 м (ось Y направлена вертикально вверх, а ось Z - "в экран"). Если смотреть сверху :

^ Z

|

|

|

O----------------> X

Точка O (фактически вы) имеет координаты (0,0), источник звука А(-25,1). Разумеется понятие "метр" весьма условно. При нажатии на кнопку в буфер SecondarySoundBuffer загружается звук 'xhe4.wav'. Это звук работающего винта вертолета, его длина (звука) ровно 3.99 с (а размер буфера ровно 4 с). Далее происходит микширование из вторичного буфера в первичный с флагом DSBPLAY_LOOPING, что позволяет сделать многократно повторяющийся звук; время в 0.01 с ухом практически не улавливается и получается непрерывный звук летящего вертолета. После этого запускется таймер (поле INTERVAL в Инспекторе Оъектов установлено в 1). Разумеется вам совсем необязательно делать именно так, это просто пример. В процедуре Timer1Timer просто меняется координата X с шагом 0.1. В итоге получаем летящий вертолет слева направо. Заодно можете проверить, правильно ли у вас расположены колонки.

unit Unit1;
 
interface
 
uses
 
Windows, Messages, SysUtils, Classes, Graphics, Controls,
 
Forms, Dialogs, DSound, MMSystem, StdCtrls, ExtCtrls;
 
type
  TForm1
= class(TForm)
    Button1
: TButton;
    Timer1
: TTimer;
    procedure
FormCreate(Sender: TObject);
    procedure
FormDestroy(Sender: TObject);
    procedure Button1Click
(Sender: TObject);
    procedure Timer1Timer
(Sender: TObject);
 
private
   
{ Private declarations }
   
DirectSound : IDirectSound;
   
DirectSoundBuffer : IDirectSoundBuffer;
   
SecondarySoundBuffer : IDirectSoundBuffer;
    SecondarySound3DBuffer
: IDirectSound3DBuffer;
    procedure
AppCreateWritePrimaryBuffer;
    procedure AppCreateWriteSecondary3DBuffer
(var Buffer: IDirectSoundBuffer;
   
SamplesPerSec: Integer;
   
Bits: Word;
    isStereo
:Boolean;
   
Time: Integer);
    procedure AppSetSecondary3DBuffer
(var Buffer: IDirectSoundBuffer;
   
var _3DBuffer: IDirectSound3DBuffer);
    procedure
AppWriteDataToBuffer(Buffer: IDirectSoundBuffer;
   
OffSet: DWord; var SoundData;
   
SoundBytes: DWord);
    procedure
CopyWAVToBuffer(name: PChar; var Buffer: IDirectSoundBuffer);
 
public
   
{ Public declarations }
end;
 
var
  Form1
: TForm1;
 
implementation
 
{$R *.DFM}
 
procedure TForm1
.FormCreate(Sender: TObject);
var
 
Result: HResult;
begin
 
if DirectSoundCreate(nil, DirectSound, nil) <> DS_OK then
   
raise Exception.Create('Failed to create IDirectSound object');
 
AppCreateWritePrimaryBuffer;
  AppCreateWriteSecondary3DBuffer
(SecondarySoundBuffer, 22050,8,False,4);
  AppSetSecondary3DBuffer
(SecondarySoundBuffer, SecondarySound3DBuffer);
  Timer1
.Enabled:=False;
end;
 
procedure TForm1
.FormDestroy(Sender: TObject);
var
  i
: ShortInt;
begin
 
if Assigned(DirectSoundBuffer) then
   
DirectSoundBuffer.Release;
 
if Assigned(SecondarySound3DBuffer) then
    SecondarySound3DBuffer
.Release;
 
if Assigned(SecondarySoundBuffer) then
   
SecondarySoundBuffer.Release;
 
if Assigned(DirectSound) then
   
DirectSound.Release;
end;
 
procedure TForm1
.AppCreateWritePrimaryBuffer;
var
 
BufferDesc: DSBUFFERDESC;
 
Caps: DSBCaps;
  PCM
: TWaveFormatEx;
begin
 
FillChar(BufferDesc, SizeOf(DSBUFFERDESC),0);
 
FillChar(PCM, SizeOf(TWaveFormatEx),0);
 
with BufferDesc do
 
begin
    PCM
.wFormatTag:=WAVE_FORMAT_PCM;
    PCM
.nChannels:=2;
    PCM
.nSamplesPerSec:=22050;
    PCM
.nBlockAlign:=4;
    PCM
.nAvgBytesPerSec:=PCM.nSamplesPerSec * PCM.nBlockAlign;
    PCM
.wBitsPerSample:=16;
    PCM
.cbSize:=0;
    dwSize
:=SizeOf(DSBUFFERDESC);
    dwFlags
:=DSBCAPS_PRIMARYBUFFER;
    dwBufferBytes
:=0;
    lpwfxFormat
:=nil;
 
end;
 
if DirectSound.SetCooperativeLevel(Handle,DSSCL_WRITEPRIMARY) <> DS_OK then
   
raise Exception.Create('Unable to set Cooperative Level');
 
if DirectSound.CreateSoundBuffer(BufferDesc,DirectSoundBuffer,nil) <> DS_OK then
   
raise Exception.Create('Create Sound Buffer failed');
 
if DirectSoundBuffer.SetFormat(PCM) <> DS_OK then
   
raise Exception.Create('Unable to Set Format ');
 
if DirectSound.SetCooperativeLevel(Handle,DSSCL_NORMAL) <> DS_OK then
   
raise Exception.Create('Unable to set Cooperative Level');
end;
 
procedure TForm1
.AppCreateWriteSecondary3DBuffer;
var
 
BufferDesc: DSBUFFERDESC;
 
Caps: DSBCaps;
  PCM
: TWaveFormatEx;
begin
 
FillChar(BufferDesc, SizeOf(DSBUFFERDESC),0);
 
FillChar(PCM, SizeOf(TWaveFormatEx),0);
 
with BufferDesc do
 
begin
    PCM
.wFormatTag:=WAVE_FORMAT_PCM;
   
if isStereo then
      PCM
.nChannels:=2
   
else
      PCM
.nChannels:=1;
    PCM
.nSamplesPerSec:=SamplesPerSec;
    PCM
.nBlockAlign:=(Bits div 8)*PCM.nChannels;
    PCM
.nAvgBytesPerSec:=PCM.nSamplesPerSec * PCM.nBlockAlign;
    PCM
.wBitsPerSample:=Bits;
    PCM
.cbSize:=0;
    dwSize
:=SizeOf(DSBUFFERDESC);
    dwFlags
:=DSBCAPS_STATIC or DSBCAPS_CTRL3D;
    dwBufferBytes
:=Time*PCM.nAvgBytesPerSec;
    lpwfxFormat
:=@PCM;
 
end;
 
if DirectSound.CreateSoundBuffer(BufferDesc, Buffer, nil) <> DS_OK then
   
raise Exception.Create('Create Sound Buffer failed');
end;
 
procedure TForm1
.AppWriteDataToBuffer;
var
  AudioPtr1
, AudioPtr2 : Pointer;
  AudioBytes1
, AudioBytes2 : DWord;
  h
: HResult;
 
Temp : Pointer;
begin
  H
:=Buffer.Lock(OffSet, SoundBytes, AudioPtr1, AudioBytes1,
  AudioPtr2
, AudioBytes2, 0);
 
if H = DSERR_BUFFERLOST then
 
begin
   
Buffer.Restore;
   
if Buffer.Lock(OffSet, SoundBytes, AudioPtr1, AudioBytes1, AudioPtr2, AudioBytes2, 0) <> DS_OK then
     
raise Exception.Create('Unable to Lock Sound Buffer');
 
end
 
else
 
if H <> DS_OK then
   
raise Exception.Create('Unable to Lock Sound Buffer');
 
Temp:=@SoundData;
 
Move(Temp^, AudioPtr1^, AudioBytes1);
 
if AudioPtr2 <> nil then
 
begin
   
Temp:=@SoundData; Inc(Integer(Temp), AudioBytes1);
   
Move(Temp^, AudioPtr2^, AudioBytes2);
 
end;
 
if Buffer.UnLock(AudioPtr1, AudioBytes1, AudioPtr2, AudioBytes2) <> DS_OK then
   
raise Exception.Create('Unable to UnLock Sound Buffer');
end;
 
procedure TForm1
.CopyWAVToBuffer;
var
 
Data : PChar;
 
FName : TFileStream;
 
DataSize : DWord;
 
Chunk : string[4];
 
Pos : Integer;
begin
 
FName:=TFileStream.Create(name,fmOpenRead);
 
Pos:=24;
 
SetLength(Chunk,4);
  repeat
   
FName.Seek(Pos, soFromBeginning);
   
FName.read(Chunk[1],4);
   
Inc(Pos);
 
until
   
Chunk = 'data';
 
FName.Seek(Pos+3, soFromBeginning);
 
FName.read(DataSize, SizeOf(DWord));
 
GetMem(Data,DataSize);
 
FName.read(Data^, DataSize);
 
FName.Free;
 
AppWriteDataToBuffer(Buffer,0,Data^,DataSize);
 
FreeMem(Data,DataSize);
end;
 
var
 
Pos: Single = -25;
 
procedure TForm1
.AppSetSecondary3DBuffer;
begin
 
if Buffer.QueryInterface(IID_IDirectSound3DBuffer, _3DBuffer) <> DS_OK then
   
raise Exception.Create('Failed to create IDirectSound3D object');
 
if _3DBuffer.SetPosition(Pos,1,1,0) <> DS_OK then
   
raise Exception.Create('Failed to set IDirectSound3D Position');
end;
 
procedure TForm1
.Button1Click(Sender: TObject);
begin
 
CopyWAVToBuffer('xhe4.wav',SecondarySoundBuffer);
 
 
if SecondarySoundBuffer.Play(0,0,DSBPLAY_LOOPING) <> DS_OK then
   
ShowMessage('Can not play the Sound');
 
  Timer1
.Enabled:=True;
end;
 
procedure TForm1
.Timer1Timer(Sender: TObject);
begin
  SecondarySound3DBuffer
.SetPosition(Pos,1,1,0);
 
Pos:=Pos + 0.1;
end;
 
end.

Взято с https://delphiworld.narod.ru