Delphi World - это проект, являющийся сборником статей и малодокументированных возможностей по программированию в среде Delphi. Здесь вы найдёте работы по следующим категориям: delphi, delfi, borland, bds, дельфи, делфи, дэльфи, дэлфи, programming, example, программирование, исходные коды, code, исходники, source, sources, сорцы, сорсы, soft, programs, программы, and, how, delphiworld, базы данных, графика, игры, интернет, сети, компоненты, классы, мультимедиа, ос, железо, программа, интерфейс, рабочий стол, синтаксис, технологии, файловая система...
Как использовать в своей программе API DirectSound и DirectSound3D

Юзеры с компьютером на "Вы", программисты - на "Ты", а хакеры - на "Ты, козел..."

Представляю вашему вниманию рабочий пример использования 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''t play the Sound');

  if SecondarySoundBuffer[1].Play(0,0,0) <> DS_OK then
    ShowMessage('Can''t 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''t 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.

Проект Delphi World © Выпуск 2002 - 2004
Автор проекта: ___Nikolay