Оригинальный DVD-ROM: eXeL@B DVD !
eXeL@B ВИДЕОКУРС !

ВИДЕОКУРС
выпущен 4 ноября!


УЗНАТЬ БОЛЬШЕ >>
Домой | Статьи | RAR-cтатьи | FAQ | Форум | Скачать | Видеокурс
Новичку | Ссылки | Программирование | Интервью | Архив | Связь

БОЛЬШОЙ FAQ ПО DELPHI



Использование DirectSound на Delphi

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


 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.
 




<< ВЕРНУТЬСЯ В ОГЛАВЛЕНИЕ



Материалы находятся на сайте https://exelab.ru/pro/



Оригинальный DVD-ROM: eXeL@B DVD !


Вы находитесь на EXELAB.rU
Проект ReactOS