在Delphi中播放PCM Wav文件

Agh*_*gha 1 delphi wav

我写了一个简单的代码,读取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.
Run Code Online (Sandbox Code Playgroud)

代码需要表单上的TLabel,Tbutton和OpenFileDialog.

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

Rem*_*eau 10

有趣的是,当你这样做时发布这个,因为我昨天刚刚用微软的waveOut...API 写了一个工作的WAV播放器.

您没有有效/正确地阅读RIFF块.我强烈建议你使用微软的多媒体功能(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;
Run Code Online (Sandbox Code Playgroud)

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