- RU.DIRECTX (2:5020/1065.18) ------------------------------------ RU.DIRECTX -
Msg  : 26 of 26                             Uns Loc
From : Sergey Melnikov                      2:5020/1065.18   08 Nov 98  22:54:51
To   : All
Subj : DirectSound
-------------------------------------------------------------------------------
    ---------================= Hello, All ! =================---------

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

PS. Если есть какие-нибудь вопросы, постараюсь на них ответить.
========
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
   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);
    { Private declarations }
  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 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.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.
=====

main_back.gif (3425 bytes)

Используются технологии uCoz