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

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.