在Delphi中播放PCM Wav文件

Question

我编写了一个简单的代码，它读取Wav文件的标题，然后开始播放它。这是我的代码：

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Generics.collections,
  Vcl.ExtCtrls, MMSystem;

type
  TForm1 = class(TForm)
    Button1: TButton;
    OpenDialog1: TOpenDialog;
    Label1: TLabel;
    Label2: TLabel;
    Shape1: TShape;
    Image1: TImage;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

type
  TWaveformSample = integer; // signed 32-bit; -2147483648..2147483647
  TWaveformSamples = packed array of TWaveformSample; // one channel

var
  Form1: TForm1;

  myWavFile: file;
  DataBlock: array[0..3] of byte;
  Count: integer;
  NumOfChannels: integer;
  SampleRate: integer;
  BytesPerSecond: integer;
  ByesPerSample: integer;
  BitsPerSample: integer;
  CompressionCode: integer;
  CompressionDesc: string;
  BlockAlign: integer;
  ExtraFormatBytes: integer;

  CompressionCodes: TDictionary<integer, string>;

  BytesRead: integer;

  Samples: TWaveformSamples;
  fmt: TWaveFormatEx;

  PacketIsPlaying: Boolean;

implementation

{$R *.dfm}

procedure InitAudioSys;
begin
  with fmt do
  begin
    wFormatTag := WAVE_FORMAT_PCM;
    nChannels := NumOfChannels;
    nSamplesPerSec := SampleRate;
    wBitsPerSample := BitsPerSample;
    nAvgBytesPerSec := nChannels * nSamplesPerSec * wBitsPerSample div 8;
    nBlockAlign := nChannels * wBitsPerSample div 8;
    cbSize := 0;
  end;
end;


procedure PlaySound;
var
  wo: integer;
  hdr: TWaveHdr;
begin

  if Length(samples) = 0 then
  begin
    Writeln('Error: No audio has been created yet.');
    Exit;
  end;

  if waveOutOpen(@wo, WAVE_MAPPER, @fmt, 0, 0, CALLBACK_NULL) = MMSYSERR_NOERROR then
    try
      PacketIsPlaying := True;
      ZeroMemory(@hdr, sizeof(hdr));
      with hdr do
      begin
        lpData := @samples[0];
        dwBufferLength := fmt.nChannels * Length(Samples) * sizeof(TWaveformSample);
        dwFlags := 0;
      end;

      waveOutPrepareHeader(wo, @hdr, sizeof(hdr));
      waveOutWrite(wo, @hdr, sizeof(hdr));
      //sleep(450);

      //while waveOutUnprepareHeader(wo, @hdr, sizeof(hdr)) = WAVERR_STILLPLAYING do
        //sleep(100);

    finally
      waveOutClose(wo);
      PacketIsPlaying := False;
    end;


end;

function ReadDataBlock(Size: integer): Boolean;
begin
  try
    BlockRead(myWavFile, DataBlock, Size, Count);
    INC(BytesRead, Size);
    Result := True;
  except
    Result := False;
  end;
end;

function OpenWav(FileName: string): Boolean;
begin
  try
    Assignfile(myWavFile, filename);
    Reset(myWavFile, 1);
    Result := True;
  except
    Result := False;
  end;
end;

function CloseWav: Boolean;
begin
  try
    CloseFile(myWavFile);
    Result := True;
  except
    Result := False;
  end;
end;

function ValidateWav: Boolean;
const
  RIFF: array[0..3] of byte = (82, 73, 70, 70);
  WAVE: array[0..3] of byte = (87, 65, 86, 69);
  _FMT: array[0..3] of byte = (102, 109, 116, 32);
  FACT: array[0..3] of byte = (102, 97, 99, 116);
  DATA: array[0..3] of byte = (100, 97, 116, 97);
  _DATA: array[0..3] of byte = (64, 61, 74, 61);
var
  RiffChunkSize, FmtChunkSize, FactChunkSize, DataChunkSize, i, j, tmp, Freq: integer;

  omega,
  dt, t: double;
  vol: double;
begin

  BytesRead := 0;

  //Check "RIFF"
  ReadDataBlock(4);
  if not CompareMem(@DataBlock, @RIFF, SizeOf(DataBlock)) then
    begin
      Result := False;
      Exit;
    end;

  //Get "RIFF" Chunk Data Size
  ReadDataBlock(4);
  Move(DataBlock, RiffChunkSize, 4);

  //Check "WAVE"
  ReadDataBlock(4);
  if not CompareMem(@DataBlock, @WAVE, SizeOf(DataBlock)) then
    begin
      Result := False;
      Exit;
    end;

  {FMT ---------------------------------------------------------------------}

  //Check "FMT"
  ReadDataBlock(4);
  if not CompareMem(@DataBlock, @_FMT, SizeOf(DataBlock)) then
    begin
      Result := False;
      Exit;
    end;

  //Get "FMT" Chunk Data Size
  ReadDataBlock(4);
  Move(DataBlock, FmtChunkSize, 4);

  BytesRead := 0;

  //Get Wav Compression Code
  ReadDataBlock(2);
  Move(DataBlock, CompressionCode, 2);
  if not CompressionCodes.TryGetValue(CompressionCode, CompressionDesc) then
    CompressionDesc := 'File Error!';

  //Get Number of Channels
  ReadDataBlock(2);
  Move(DataBlock, NumOfChannels, 2);

  //Get Sample Rate
  ReadDataBlock(4);
  Move(DataBlock, SampleRate, 4);

  //Get Average Bytes Per Second
  ReadDataBlock(4);
  Move(DataBlock, BytesPerSecond, 4);

  //Get Block Align
  ReadDataBlock(2);
  Move(DataBlock, BlockAlign, 2);

  //Get Bits Per Sample
  ReadDataBlock(2);
  Move(DataBlock, BitsPerSample, 2);

  //Extra Format Bytes
  if BytesRead <= FmtChunkSize - 2 then
    begin
      ReadDataBlock(2);
      Move(DataBlock, ExtraFormatBytes, 2);
    end;

  //If it's not Uncompressed/PCM File, then we have Extra Format Bytes
  if CompressionCode <> 1 then
    begin
      //Skip Compression Data
      for i := 0 to FmtChunkSize - BytesRead - 1 do
        ReadDataBlock(1);

      Result := False;
      Exit;
    end;

  {FACT --------------------------------------------------------------------}

  {FactChunkSize := 0;
  //Check "FACT"
  ReadDataBlock(4);
  if CompareMem(@DataBlock, @FACT, SizeOf(DataBlock)) then
    begin
      //Get "FMT" Chunk Data Size
      ReadDataBlock(4);
      Move(DataBlock, FactChunkSize, 4);

      BytesRead := 0;
      for i := 0 to FactChunkSize - BytesRead - 1 do
        ReadDataBlock(1);
    end;   }

    {DATA ------------------------------------------------------------------}

    while BytesRead < FmtChunkSize do
      ReadDataBlock(1);

    BytesRead := 0;

    //Skip bytes until "data" shows up
    while (not CompareMem(@DataBlock, @DATA, SizeOf(DataBlock))) and (not CompareMem(@DataBlock, @_DATA, SizeOf(DataBlock))) do
    begin
      ReadDataBlock(4);
    end;

    ReadDataBlock(4);
    Move(DataBlock, DataChunkSize, 4);




      Form1.Label1.Caption := 'Compression Code: ' + IntToStr(CompressionCode) + #10#13 +
                        'Compression Description: ' + CompressionDesc + #10#13 +
                        'Number of Channels: ' + IntToStr(NumOfChannels) + #10#13 +
                        'Sample Rate: ' + IntToStr(SampleRate) + #10#13 +
                        'Byes per Sample: ' + IntToStr(ByesPerSample) + #10#13 +
                        'Byes per Second: ' + IntToStr(BytesPerSecond) + #10#13 +
                        'Bits per Second: ' + IntToStr(BitsPerSample);




    tmp := FileSize(myWavFile) - DataChunkSize;

   { j := 0;
    Form1.Image1.Canvas.Rectangle(0, 0, Form1.Image1.Width, Form1.Image1.Height);
    for i := 0 to (DataChunkSize div 20) do
      begin
        //BlockRead(myWavFile, DataBlock, 76, Count);
        tmp := tmp + 76;
        Seek(myWavFile, tmp);

        ReadDataBlock(4);

        Move(DataBlock, Freq, 4);

        if i mod ((DataChunkSize div 80) div Form1.Image1.Width) = 0 then
        begin
          INC(J);
          Form1.Image1.Canvas.MoveTo(j, 121 div 2);
          Form1.Image1.Canvas.LineTo(j, (121 div 2) - Trunc((Freq / High(Integer)) * (121 div 2)));
        end;

        Application.ProcessMessages;
      end;

    Seek(myWavFile, FileSize(myWavFile) - DataChunkSize); }

    InitAudioSys;
    PacketIsPlaying := False;

    SetLength(Samples, fmt.nSamplesPerSec);

    while PacketIsPlaying = false do
      begin
        for i := 0 to fmt.nSamplesPerSec do
          begin
            ReadDataBlock(4);
            Move(DataBlock, Freq, 4);

            Samples[i] := Freq;
          end;

        PlaySound;
        Sleep(2000);
        Application.ProcessMessages;
      end;




  Result := True;

end;

procedure TForm1.Button1Click(Sender: TObject);
var
  f: file;
  b: array[0..3] of byte;
  count: integer;
begin

  with opendialog1 do
  if execute then
    begin
      Form1.Image1.Canvas.Rectangle(0, 0, Form1.Image1.Width, Form1.Image1.Height);
      Label1.Font.Color := clBlack;

      OpenWav(FileName);

      if ValidateWav = False then
        begin
          Label1.Caption := 'Invalid File Data!';
          Label1.Font.Color := clRed;
          Exit;
        end;



      CloseWav;
    end;

end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  CompressionCodes.Destroy;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Image1.Canvas.Rectangle(0, 0, Image1.Width, Image1.Height);

  CompressionCodes := TDictionary<integer, string>.Create;

  CompressionCodes.Add(0, 'Unknown');
  CompressionCodes.Add(1, 'PCM/Uncompressed');
  CompressionCodes.Add(2, 'Microsoft ADPCM');
  CompressionCodes.Add(6, 'ITU G.711 a-law');
  CompressionCodes.Add(7, 'ITU G.711 µ-law');
  CompressionCodes.Add(17, 'IMA ADPCM');
  CompressionCodes.Add(20, 'ITU G.723 ADPCM (Yamaha)');
  CompressionCodes.Add(49, 'GSM 6.10');
  CompressionCodes.Add(64, 'ITU G.721 ADPCM');
  CompressionCodes.Add(80, 'MPEG');
  CompressionCodes.Add(85, 'ISO/MPEG');
  CompressionCodes.Add(65536, 'Experimental');


end;

end.

代码在表单上需要TLabel，Tbutton和OpenFileDialog。

我的文件播放有问题。目前我创建了长度为SamplesPerSecond的样本数组，并以2000的延迟一个接一个地播放它们（延迟小于2000毫秒会引起错误）。 我现在想要的是如何能够顺利且无延迟地一次又一次地阅读样本并播放它们。此外，我希望能够在播放文件时可视化图表上的每个样本。

Answer 1

有趣的是，当你这样做的时候发布这个，因为我昨天刚刚使用微软的waveOut... API编写了一个有效的WAV播放器。

您没有有效/正确地阅读RIFF块。我强烈建议您使用Microsoft的多媒体功能（mmioOpen()，mmioDescend()，mmioAscend()和mmioRead()），而不是使用AssignFile()和BlockRead()。 WAV文件比你想象的要复杂得多，你所展示的代码不够灵活，无法处理它可能遇到的一切。例如，FMT并不总是WAV文件中的第一个块，并且在DATA块之前可能存在其他块，您没有跳过这些块。

使用waveOutOpen()时，您应该从文件中读取原始WAVEFORMATEX，而不是创建使用解释值填充的新WAVEFORMATEX。使用MMIO函数，您可以将WAVEFORMATEX变量mmioDescend()声明到FMT块中，mmioRead()将整个块直接声明到变量中，然后按原样传递变量到waveOutOpen()。

使用waveOutWrite()时，您应该使用循环的多个音频缓冲区（您可以在开始阅读音频样本数据之前使用waveOutPrepareHeader()预先准备它们，因此您只需准备一次）。如果您一次只为波设备提供一个缓冲区，则可能会出现频繁的音频播放（听起来就是这样）。最好使用至少3个缓冲区（我的播放器使用20个，但我可能会在之后敲回来）：

1. 使用示例数据填充2个缓冲区并立即将它们传递给waveOutWrite()，并在播放时填充第3个缓冲区。
2. 当您的waveOutOpen()回调表示第一个缓冲区已完成播放时，将第三个缓冲区传递给waveOutWrite()并使用新数据填充第一个缓冲区。
3. 当回调说第二个缓冲区完成播放时，将第一个缓冲区传递给waveOutWrite()并用新数据填充第二个缓冲区。
4. 当回调说第3缓冲区完成播放时，将第2个缓冲区传递给waveOutWrite()并用新数据填充第3个缓冲区。
5. 依此类推，继续使用循环逻辑，直到达到DATA块的末尾。

波形设备应始终在任何给定时间至少播放2个活动音频缓冲区，以避免播放中出现间隙。让回调告诉你每个缓冲区何时完成，这样你就可以提供下一个缓冲区。

我的播放器代码基于David Overton的教程，其中包含大量信息和代码示例：

使用waveOut界面在Windows中播放音频
http://www.et.hs-wismar.de/~litschke/TMS/Audioprogrammierung.pdf
http://www.planet-source-code.com/vb/scripts/ShowCode.asp?txtCodeId=4422&lngWId=3

我对教程代码的唯一调整是：

1. 将MMIO函数用于文件I / O.
2. 使用RTL的内存管理功能而不是OS内存功能。
3. 更改了音频缓冲区的大小。大卫使用8KB缓冲区，我发现在几秒钟​​之后导致垃圾回放，因为波形设备没有足够快地为我的WAV文件（GSM编码，而不是PCM，因此它们具有较小的样本大小）提供足够快的音频样本。我将缓冲区大小更改为nAvgBytesPerSec块报告的FMT值，然后音频一直干净地播放。
4. 错误处理。

试试这个（从我用C ++编写的真实代码翻译成Delphi）：

{
The following is based on code written by David Overton:

Playing Audio in Windows using waveOut Interface
http://www.planet-source-code.com/vb/scripts/ShowCode.asp?txtCodeId=4422&lngWId=3
https://www.et.hs-wismar.de/~litschke/TMS/Audioprogrammierung.pdf

But with some custom tweaks.
}

uses
  ..., Winapi.Windows, Winapi.MMSystem;

const
  BLOCK_COUNT = 20;

procedure waveOutProc(hWaveOut: HWAVEOUT; uMsg: UINT; dwInstance, dwParam1, dwParam2: DWORD_PTR): stdcall; forward;
function writeAudio(hWaveOut: HWAVEOUT; data: PByte; size: Integer): Boolean; forward;

var
  waveCriticalSection: CRITICAL_SECTION;
  waveBlocks: PWaveHdr;
  waveFreeBlockCount: Integer;
  waveCurrentBlock: Integer;
  buffer: array[0..1023] of Byte;
  mmckinfoParent: MMCKINFO;
  mmckinfoSubchunk: MMCKINFO;
  dwFmtSize: DWORD;
  dwDataSize: DWORD;
  dwSizeToRead: DWORD;
  hmmio: HMMIO;
  wfxBuffer: array of Byte;
  wfx: PWaveFormatEx;
  hWaveOut: HWAVEOUT;
  blockBuffer: array of Byte;
  pBlockData: PByte;
  i: Integer;
  readBytes: LONG;
begin
  ...
  hmmio := mmioOpen(PChar(FileName), nil, MMIO_READ or MMIO_DENYWRITE);
  if hmmio = 0 then
    raise Exception.Create('Unable to open WAV file');

  try
    mmckinfoParent.fccType := mmioStringToFOURCC('WAVE', 0);
    if mmioDescend(hmmio, @mmckinfoParent, nil, MMIO_FINDRIFF) <> MMSYSERR_NOERROR then
      raise Exception.CreateFmt('%s is not a WAVE file', [FileName]);

    mmckinfoSubchunk.ckid := mmioStringToFOURCC('fmt', 0);
    if mmioDescend(hmmio, @mmckinfoSubchunk, @mmckinfoParent, MMIO_FINDCHUNK) <> MMSYSERR_NOERROR then
      raise Exception.Create('File has no FMT chunk');

    dwFmtSize := mmckinfoSubchunk.cksize;
    if dwFmtSize = 0 then
      raise Exception.Create('File FMT chunk is empty');

    SetLength(wfxBuffer, dwFmtSize);
    wfx := PWaveFormatEx(Pointer(wfxBuffer));

    if mmioRead(hmmio, PAnsiChar(wfx), dwFmtSize) <> dwFmtSize then
      raise Exception.Create('Failed to read FMT chunk');

    if mmioAscend(hmmio, @mmckinfoSubchunk, 0) <> MMSYSERR_NOERROR then
      raise Exception.Create('Failed to ascend into RIFF chunk');

    mmckinfoSubchunk.ckid := mmioStringToFOURCC('data', 0);
    if mmioDescend(hmmio, @mmckinfoSubchunk, @mmckinfoParent, MMIO_FINDCHUNK) <> MMSYSERR_NOERROR then
      raise Exception.Create('File has no DATA chunk');

    dwDataSize := mmckinfoSubchunk.cksize;
    if dwDataSize <> 0 then
    begin
      hWaveOut := 0;
      if waveOutOpen(@hWaveOut, WAVE_MAPPER, wfx, DWORD_PTR(@waveOutProc), 0, CALLBACK_FUNCTION) <> MMSYSERR_NOERROR then
        raise Exception.Create('Unable to open wave mapper device');

      try
        SetLength(blockBuffer, (sizeof(WAVEHDR) + wfx.nAvgBytesPerSec) * BLOCK_COUNT);
        pBlockData := PByte(blockBuffer);

        waveBlocks := PWaveHdr(pBlockData);
        Inc(pBlockData, sizeof(WAVEHDR) * BLOCK_COUNT);
        for i := 0 to BLOCK_COUNT-1 do
        begin
          ZeroMemory(@waveBlocks[i], sizeof(WAVEHDR));
          waveBlocks[i].dwBufferLength := wfx.nAvgBytesPerSec;
          waveBlocks[i].lpData := pBlockData;

          if waveOutPrepareHeader(hWaveOut, @waveBlocks[i], sizeof(WAVEHDR)) <> MMSYSERR_NOERROR then
            raise Exception.Create('Failed to prepare a WAV audio header');

          Inc(pBlockData, wfx.nAvgBytesPerSec);
        end;

        waveFreeBlockCount := BLOCK_COUNT;
        waveCurrentBlock := 0;

        InitializeCriticalSection(@waveCriticalSection);
        try
          repeat
            dwSizeToRead := Min(dwDataSize, sizeof(buffer));

            readBytes := mmioRead(hmmio, PAnsiChar(buffer), dwSizeToRead);
            if readBytes <= 0 then Break;

            if readBytes < sizeof(buffer) then
              ZeroMemory(@buffer[readBytes], sizeof(buffer) - readBytes);

            writeAudio(hWaveOut, buffer, sizeof(buffer));

            Dec(dwDataSize, readBytes);
          until dwDataSize = 0;

          writeAudio(hWaveOut, nil, 0);

          while waveFreeBlockCount < BLOCK_COUNT do
            Sleep(10);

          for i := 0 to BLOCK_COUNT-1 do
          begin
            if (waveBlocks[i].dwFlags and WHDR_PREPARED) <> 0 then
              waveOutUnprepareHeader(hWaveOut, @waveBlocks[i], sizeof(WAVEHDR));
          end;
        finally
          DeleteCriticalSection(@waveCriticalSection);
        end;
      finally
        waveOutClose(hWaveOut);
      end;
    end;
  finally
    mmioClose(hmmio, 0);
  end;
end;

procedure waveOutProc(hWaveOut: HWAVEOUT; uMsg: UINT; dwInstance, dwParam1, dwParam2: DWORD_PTR); stdcall;
begin
  if uMsg = WOM_DONE then
  begin
    EnterCriticalSection(&waveCriticalSection);
    Inc(waveFreeBlockCount);
    LeaveCriticalSection(&waveCriticalSection);
  end;
end;

procedure writeAudio(hWaveOut: HWAVEOUT; data: PByte; size: Integer);
var
  current: PWaveHdr;
  remaining: Integer;
begin
  current := @waveBlocks[waveCurrentBlock];

  if data = nil then
  begin
    if current.dwUser <> 0 then
    begin
      if current.dwUser < current.dwBufferLength then
      begin
        remaining := Integer(current.dwBufferLength - current.dwUser);
        ZeroMemory(current.lpData + current.dwUser, remaining);
        Inc(current.dwUser, remainint);
      end;

      EnterCriticalSection(&waveCriticalSection);
      Dec(waveFreeBlockCount);
      LeaveCriticalSection(&waveCriticalSection);

      if waveOutWrite(hWaveOut, current, sizeof(WAVEHDR)) <> MMSYSERR_NOERROR then
        raise Exception.Create('Failed to write a WAV audio header');
    end;
  end else
  begin
    while size > 0 do
    begin
      remaining := Integer(current.dwBufferLength - current.dwUser);
      if size < remaining then
      begin
        Move(data^, (current.lpData + current.dwUser)^, size);
        Inc(current.dwUser, size);
        Break;
      end;

      Move(data^, (current.lpData + current.dwUser)^, remaining);
      Inc(current.dwUser, remaining);

      Inc(data, remaining);
      Dec(size, remaining);

      EnterCriticalSection(&waveCriticalSection);
      Dec(waveFreeBlockCount);
      LeaveCriticalSection(&waveCriticalSection);

      if waveOutWrite(hWaveOut, current, sizeof(WAVEHDR)) <> MMSYSERR_NOERROR then
         raise Exception.Create('Failed to write a WAV audio header');

      while waveFreeBlockCount = 0 do
        Sleep(10);

      Inc(waveCurrentBlock);
      waveCurrentBlock := waveCurrentBlock mod BLOCK_COUNT;
      current := @waveBlocks[waveCurrentBlock];
      current.dwUser := 0;
    end;
  end;
end;

关于样本的可视化，最好使用第三方组件（并且您可能应该使用第三方WAV播放器，而不是手动编写API代码），例如Mitov Software's AudioLab组件

Answer 2

UINT是一个无符号的32位整数，在Delphi中不使用。将UINT更改为“基数”，这是Delphi的32位无符号整数。

伊恩