пример использования 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

  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.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.

Взято с сайта http://blackman.wp-club.net/

Отправить комментарий

Проверка
Антиспам проверка
Image CAPTCHA
...