在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和打開文件對話框的形式。

我有文件播放問題。目前，我創建了長度爲SamplesPerSecond的樣本陣列，並在2000年的延遲中一個接一個地播放它們（延遲少於2000毫秒會引發錯誤）。 我現在想要的是我怎樣才能順利閱讀樣品並連續播放，毫不拖延。另外，我希望能夠在文件正在播放時將圖形中的每個樣本都可視化。

Answer 1

有趣的是，當你這樣做時發佈，因爲我剛剛昨天寫了一個使用微軟的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()向右走，並填寫第三緩衝而他們正在玩。
2. 當您的waveOutOpen()回調錶示第一個緩衝區已完成播放時，將第三個緩衝區傳遞到waveOutWrite()並用新數據填充第一個緩衝區。
3. 當回調錶示第二個緩衝區已完成播放時，將第一個緩衝區傳遞到waveOutWrite()並用新數據填充第二個緩衝區。
4. 當回調錶示第三個緩衝區已完成播放時，將第二個緩衝區傳遞到waveOutWrite()並用新數據填充第三個緩衝區。
5. 依此類推，繼續此循環法邏輯，直至達到DATA塊的末尾。

波形設備在任何給定的時間應始終至少有2個活動音頻緩衝區，以避免播放時出現空隙。讓回調告訴你每個緩衝區何時完成，以便您可以提供下一個緩衝區。

我根據大衛·奧弗頓的教程，它具有的信息有很多我的播放器代碼和代碼示例：使用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. 使用文件I/O的MMIO函數。
2. 使用RTL的內存管理功能而不是OS內存功能。
3. 更改了音頻緩衝區的大小。大衛使用8KB緩衝區，我發現在幾秒鐘​​後垃圾回放，因爲我的WAV文件（這是GSM編碼，而不是PCM，因此他們有較小的樣本大小）的波形設備沒有足夠快的音頻採樣。我將緩衝區大小更改爲由FMT組塊報告的nAvgBytesPerSec值，然後音頻一路播放乾淨。
4. 錯誤處理。

試一下這個（從我的C語言編寫的實際代碼++編譯德爾福）：

{ 
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組件。