delphi - 在 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的延迟依次播放(延迟小于2000ms会引发错误)。
我现在想要的是如何才能流畅地读取样本并一个接一个地播放它们。而且我希望能够在播放文件时可视化图表上的每几个样本。

Answer 1

有趣的是，当您发布此内容时，因为我昨天刚刚使用 Microsoft 的 waveOut... 编写了一个可用的 WAV 播放器。 API。

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

使用 waveOutOpen() 时，你应该通过原来的WAVEFORMATEX从文件中读取，而不是创建一个新的 WAVEFORMATEX你用解释值填充。使用 MMIO 函数，您可以声明一个 WAVEFORMATEX变量，mmioDescend()进入FMT block ，mmioRead()将整个 block 直接放入变量中，然后将变量原样传递给waveOutOpen() .

使用 waveOutWrite() 时，您应该使用循环通过的多个音频缓冲区(您可以在开始读取音频样本数据之前使用 waveOutPrepareHeader() 预先准备它们，因此您只需准备一次)。如果您一次只为 wave 设备提供一个缓冲区，您可能会获得断断续续的音频播放(听起来就像是这样)。最好使用至少 3 个缓冲区(我的播放器使用 20 个，但我可能会在稍后将其取消):

用样本数据填充 2 个缓冲区并将它们传递给 waveOutWrite()马上，并在他们播放时填充第三个缓冲区。

当您的 waveOutOpen()回调表示第一个缓冲区播放完毕，将第三个缓冲区传递给waveOutWrite()并用新数据填充第一个缓冲区。

当回调说第二个缓冲区播放完毕时，将第一个缓冲区传递给 waveOutWrite()并用新数据填充第二个缓冲区。

当回调说第三个缓冲区播放完毕时，将第二个缓冲区传递给waveOutWrite()并用新数据填充第三个缓冲区。

依此类推，继续循环逻辑直到 DATA 结束。到达 block 。

Wave 设备应始终在任何给定时间播放至少 2 个事件音频缓冲区，以避免播放中的间隙。让回调告诉您每个缓冲区何时完成，以便您可以提供下一个缓冲区。

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

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

我对教程代码所做的唯一调整是:

使用 MMIO 函数进行文件 I/O。

使用 RTL 的内存管理功能而不是 OS 内存功能。

更改了音频缓冲区的大小。 David 使用 8KB 缓冲区，我发现这会在几秒钟后导致垃圾播放，因为 Wave 设备没有足够快地为我的 WAV 文件提供音频样本(它们是 GSM 编码的，而不是 PCM，因此它们的样本大小较小)。我将缓冲区大小更改为 nAvgBytesPerSec FMT 报告的值 block ，然后音频一直干净地播放。

错误处理。

试试这个(从我用 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;

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