unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

uses DirectSound, MMSystem, ReadWaveFile; //ReadWaveFile 是在前面(4)自定义的单元

var
  myDSound: IDirectSound8;        //设备对象
  bufPrimary: IDirectSoundBuffer; //主缓冲
  buf: IDirectSoundBuffer;        //次缓冲

{初始化设备并建立主缓冲区}
procedure TForm1.FormCreate(Sender: TObject);
var
  wavFormat: TWaveFormatEx;
  bufDesc: TDSBufferDesc;
begin
  DirectSoundCreate8(nil, myDSound, nil);
  myDSound.SetCooperativeLevel(Handle, DSSCL_PRIORITY);

  ZeroMemory(@bufDesc, SizeOf(TDSBufferDesc));
  bufDesc.dwSize := SizeOf(TDSBufferDesc);
  bufDesc.dwFlags := DSBCAPS_PRIMARYBUFFER;
  bufDesc.dwBufferBytes := 0;
  bufDesc.lpwfxFormat := nil;

  myDSound.CreateSoundBuffer(bufDesc, bufPrimary, nil);
end;

{建立次缓冲区, 并从 Wave 文件填充数据}
procedure TForm1.Button1Click(Sender: TObject);
var
  wavFormat: TWaveFormatEx;
  bufDesc: TDSBufferDesc;
  wavPath: string;
  wav: TReadWaveFile;
  p1: Pointer;
  n1: DWORD;
begin
  buf := nil;
  with TOpenDialog.Create(nil) do begin
    Filter := 'Wave File(*.wav)|*.wav';
    if Execute then wavPath := FileName;
    Free;
  end;

  wav := TReadWaveFile.Create;
  if not wav.Open(wavPath) then
  begin
    ShowMessage('只能是 PCM 格式的 WAVE 文件');
    wav.Free;
    Exit;
  end;

  ZeroMemory(@bufDesc, SizeOf(TDSBufferDesc));
  bufDesc.dwSize := SizeOf(TDSBufferDesc);
  bufDesc.dwFlags := DSBCAPS_STATIC;
  bufDesc.dwBufferBytes := wav.Size;
  bufDesc.lpwfxFormat := @wav.Format;

  {建立次缓冲, 并把主缓冲的格式修改为当前文件的格式}
  myDSound.CreateSoundBuffer(bufDesc, buf, nil);
  bufPrimary.SetFormat(@wavFormat); //!

  buf.Lock(0, 0, @p1, @n1, nil, nil, DSBLOCK_ENTIREBUFFER);
  wav.Read(p1, n1);
  wav.Free;
  buf.Unlock(p1, n1, nil, 0);
  buf.Play(0, 0, 0);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  bufPrimary := nil;
  buf := nil;
  myDSound := nil;
end;

end.