unit WavePlay;

interface

uses Windows, SysUtils, Forms, Classes, MMSystem;

{
  История.
  Написан - - май 1998 г.
  12.07.98 - исправлен баг: не загружались файлы, у которых присутствовали
  данные между блоком 'WAVEfmt ' и блоком 'data'.
  5.08.98 - часть кода (загрузка из ресурсов) переписана с Си на Паскаль.
}

//      Устанавливается, если заголовок успешно загружен
const   CWF_HEADER_LOADED             = 1;
//      Устанавливается, если файл находится в ресурсах приложения
const   CWF_LOCATED_IN_RESOURCE       = 2;
//      Устанавливается, если для данных уже распределен буфер в памяти
const   CWF_PRIVATE_BUFFER_ALLOCATED  = 4;

type
  PWave = ^TWave;
  TWave = class(TObject)
private
  dwFlags               : DWORD;
  dwSize                : DWORD;
  WFE                   : TWaveFormatEx;
  dwDataBlockOffset     : DWORD;
  lpWaveBits            : PBYTE;
  lpszId                : PChar;
  procedure             ResetAll;
//  procedure             ReleaseAll;
  procedure             LoadHeader(lpszWaveId : PChar);
  procedure             LoadBits(lpExternalBuffer : pointer);
public
  LastError             : Boolean;
  function              GetWaveFormatEx : PWaveFormatEx;
  function              GetWaveBits : PBYTE;
  function              GetWaveSize : DWORD;
  function              GetWaveChannels : DWORD;
  function              GetWaveFrequency : DWORD;
  function              GetWaveBitsPerSample : DWORD;
  constructor           Create;
  destructor            Destroy;override;
  procedure             Load(lpszWaveId : PChar);
end;

// Устройство открыто и может выполняться подготовка блока
const WPL_CLOSED            = 0;
// Устройство открыто и может выполняться подготовка блока
const WPL_OPENED            = 1;
// Подготовка блока выполнена и блок может воспроизводится
const WPL_PREPARED          = 2;
// Блок воспроизводится
const WPL_PLAYING           = 3;
// Воспроизведение блока приостановлено
const WPL_PAUSED            = 4;
// =======================================================================

type TWavePlayer = class(TObject)
  iNumDevs       : integer;
  hSoundDevice   : HWAVEOUT;
  wh             : TWAVEHDR;
  hWnd           : THandle;
  lpWave         : PWave;
  dwSamplesTotal : DWORD;
  iPlayerState   : integer;
  procedure      ResetAll;
  procedure      ReleaseAll;
public
  LastError      : Boolean;
  constructor   Create;
  destructor    Destroy;override;
  procedure     Open(lpWavePointer : PWave);
  procedure     Prepare(lpWavePointer : PWave);
  procedure     Play;
  procedure     Stop;
  procedure     Pause;
  procedure     Resume;
  procedure     SetVolume(dwLeft,dwRight : DWORD);
  procedure     Close;
  function      IsPlaying : Boolean;
  function      GetProgress1000 : integer;
end;

implementation

// =======================================================================
procedure TWavePlayer.ResetAll;
begin
  iNumDevs:=0;
  hSoundDevice:=0;
  ZeroMemory(@wh,sizeof(TWAVEHDR));
  lpWave:=nil;
  dwSamplesTotal:=0;
  LastError:=TRUE;
  iPlayerState:=WPL_CLOSED;
end;
// =======================================================================
procedure TWavePlayer.ReleaseAll;
begin
  if iPlayerState>WPL_CLOSED then Close;
end;
// =======================================================================
constructor TWavePlayer.Create;
begin
  ResetAll;
  Self.hWnd:=hWnd;
end;
// =======================================================================
destructor TWavePlayer.Destroy;
begin
  ReleaseAll;
  Inherited;
end;
// =======================================================================
procedure TWavePlayer.Open;
var
  mmr     : MMRESULT;
begin
  ReleaseAll;
  ResetAll;
  iNumDevs:=waveOutGetNumDevs;
  if iNumDevs=0 then exit;
  if lpWavePointer=nil then exit;
  lpWave:=lpWavePointer;
  dwSamplesTotal:=(lpWave^.GetWaveSize div lpWave^.GetWaveChannels) div
    (lpWave^.GetWaveBitsPerSample() div 8);
    {
  if pointer(hWnd) = nil then
    mmr:=waveOutOpen(@hSoundDevice,WAVE_MAPPER,lpWave^.GetWaveFormatEx,
      DWORD(hWnd),0,CALLBACK_NULL)
  else}
    mmr:=waveOutOpen(@hSoundDevice,WAVE_MAPPER,lpWave^.GetWaveFormatEx,
      DWORD(Application.MainForm.Handle),0,CALLBACK_WINDOW);
  if mmr<>MMSYSERR_NOERROR then exit;
  LastError:=FALSE;
  iPlayerState:=WPL_OPENED;
end;
// =======================================================================
procedure TWavePlayer.Prepare;
var
  mmr     : MMRESULT;
begin
  LastError:=TRUE;
  if iPlayerState>WPL_OPENED then
  begin
    if iPlayerState>WPL_PREPARED then
      waveOutReset(hSoundDevice);
    waveOutUnprepareHeader(hSoundDevice,@wh,sizeof(TWAVEHDR));
  end
  else
    if iPlayerState<WPL_OPENED then exit;
  if lpWavePointer = nil then exit;
  wh.lpData:=pointer(lpWave^.GetWaveBits);
  wh.dwBufferLength:=lpWave^.GetWaveSize;
  wh.dwFlags:=0;
  wh.dwLoops:=1;
  mmr:=waveOutPrepareHeader(hSoundDevice,@wh,sizeof(TWAVEHDR));
  if mmr<>MMSYSERR_NOERROR then exit;
  LastError:=FALSE;
  iPlayerState:=WPL_PREPARED;
end;
// =======================================================================
procedure TWavePlayer.Play;
begin
  if iPlayerState>=WPL_PREPARED then
  begin
    waveOutWrite(hSoundDevice,@wh,sizeof(TWAVEHDR));
    iPlayerState:=WPL_PLAYING;
  end;
end;
// =======================================================================
procedure TWavePlayer.Stop;
begin
  if iPlayerState>=WPL_PLAYING then
  begin
    waveOutReset(hSoundDevice);
    iPlayerState:=WPL_PREPARED;
  end;
end;
// =======================================================================
procedure TWavePlayer.Pause;
begin
  if iPlayerState=WPL_PLAYING then
  begin
    waveOutPause(hSoundDevice);
    iPlayerState:=WPL_PAUSED;
  end;
end;
// =======================================================================
procedure TWavePlayer.Resume;
begin
  if iPlayerState=WPL_PAUSED then
  begin
    waveOutRestart(hSoundDevice);
  end;
  iPlayerState:=WPL_PLAYING;
end;
// =======================================================================
procedure TWavePlayer.Close;
begin
  if iPlayerState>=WPL_PLAYING then
  begin
    waveOutReset(hSoundDevice);
    iPlayerState:=WPL_PREPARED;
  end;
  if iPlayerState>=WPL_PREPARED then
  begin
    waveOutUnprepareHeader(hSoundDevice,@wh,sizeof(TWAVEHDR));
    iPlayerState:=WPL_OPENED;
  end;
  if iPlayerState>=WPL_OPENED then
  begin
    waveOutClose(hSoundDevice);
    iPlayerState:=WPL_CLOSED;
    hSoundDevice:=0;
  end;
end;
// =======================================================================
function TWavePlayer.IsPlaying;
begin
  if iPlayerState = WPL_PLAYING then
    IsPlaying:=TRUE
  else
    IsPlaying:=FALSE;
end;
// =======================================================================
function TWavePlayer.GetProgress1000;
var
  mmt    : TMMTIME;
begin
  // Если была ошибка, то возвращаем 1000 - "воспроизведение завершено"
  if((iPlayerState<WPL_PLAYING)or(LastError<>False)) then
    Result:=1000
  else
  begin
    mmt.wType:=TIME_SAMPLES;
    waveOutGetPosition(hSoundDevice,@mmt,sizeof(TMMTIME));
    GetProgress1000:=(mmt.sample*1000) div dwSamplesTotal;
  end;
end;
// =======================================================================
procedure TWavePlayer.SetVolume;
begin
  if iPlayerState>WPL_PREPARED then
  begin
    dwLeft := dwLeft and $FFFF;
    dwRight := dwRight and $FFFF;
    waveOutSetVolume(hSoundDevice,dwLeft + (dwRight shl 16));
  end;
end;

// =======================================================================
type TWavHeader = packed record
  WaveFOURCC: DWORD ;
  FileSize : DWORD;
  WAVEfmt_ : array [0..7] of BYTE;  // == "WAVEfmt "
  HeaderSize : DWORD;               // == 16
  wFormatTag : WORD;                // == WAVE_FORMAT_PCM
  nChannels : WORD;                 // 1 | 2
  nSamplesPerSec : DWORD;          // Freq
  nAvgBytesPerSec : DWORD;         // == nSamplesPerSec * nBlockAlign
  nBlockAlign : WORD;               // == nChannels * wBitsPerSample / 8
  wBitsPerSample : WORD;            // Bits per sample
end;
var whWavHeader : TWavHeader;

// =======================================================================
procedure TWave.ResetAll;
begin
  LastError:=TRUE;
  dwFlags:=0;
  lpWaveBits:=nil;
  lpszId:=nil;
  ZeroMemory(@WFE,sizeof(TWaveFormatEx));
  dwSize:=0;
end;
// =======================================================================
{void CWave::ReleaseAll()
begin
  if(dwFlags&CWF_PRIVATE_BUFFER_ALLOCATED) free(lpWaveBits);
end;}
// =======================================================================
constructor TWave.Create;
begin
  ResetAll;
  Inherited;
end;
// =======================================================================
destructor TWave.Destroy;
begin
//  ReleaseAll;
  Inherited;
end;
// =======================================================================
function TWave.GetWaveChannels;
begin
  GetWaveChannels:=DWORD(WFE.nChannels);
end;
// =======================================================================
function TWave.GetWaveFrequency;
begin
  GetWaveFrequency:=WFE.nSamplesPerSec;
end;
// =======================================================================
function TWave.GetWaveBitsPerSample;
begin
  GetWaveBitsPerSample:=DWORD(WFE.wBitsPerSample);
end;
// =======================================================================
function TWave.GetWaveBits;
begin
  GetWaveBits:=lpWaveBits;
end;
// =======================================================================
function TWave.GetWaveSize;
begin
  GetWaveSize:=dwSize;
end;
// =======================================================================
function TWave.GetWaveFormatEx;
begin
  GetWaveFormatEx:=@WFE;
end;

// =======================================================================
procedure TWave.LoadHeader;
var
  lpResData                    : ^BYTE;
  rc                           : HRSRC;
  dataFOURCC                   : DWORD;
  dwNext                       : DWORD;
begin
//  ReleaseAll;
  ResetAll;
  lpszId:=lpszWaveId;
//  dataFOURCC:=MAKEFOURCC('d','a','t','a');
  dataFOURCC:=$61746164;
  dwDataBlockOffset:=sizeof(TWavHeader);
  // Поиск данных в ресурсах приложения
  rc:=FindResource(hInstance,lpszId,RT_RCDATA);
  if pointer(rc) = nil then
  begin
    LastError:=TRUE;
    exit;
  end;
  lpResData:=LockResource(LoadResource(GetModuleHandle(nil),rc));
  if lpResData = nil then
  begin
    LastError:=TRUE;
    exit;
  end;
  dwFlags := dwFlags and CWF_LOCATED_IN_RESOURCE;
  CopyMemory(@whWavHeader,lpResData,sizeof(TWavHeader));
  if whWavHeader.WaveFOURCC <> FOURCC_RIFF then
  begin
    LastError:=TRUE;
    exit;
  end;
  // Поиск блока 'data'. Предполагаем, что он должен встретится в
  // ближайших 4 Кб.
  while TRUE do
  begin
    dwNext:=(PDWORD((DWORD(lpResData) + dwDataBlockOffset)))^;
    if (dwNext=dataFOURCC) or (dwDataBlockOffset>=4096) then
      break
    else
      dwDataBlockOffset:=dwDataBlockOffset+1;
  end; // while TRUE
  // Если не встретили блок в первых 4 Кб - больше не ищем
  if dwDataBlockOffset>=4096 then
  begin
    LastError:=TRUE;
    exit;
  end;
  dwFlags := dwFlags or CWF_LOCATED_IN_RESOURCE;
  // Ситуация: lpResData[dwDataBlockOffset] == 'd'
  dwSize:=PDWORD(DWORD(lpResData) + dwDataBlockOffset + 4)^;
  // {Если} данные в ресурсах приложения, то дополнительный буфер не нужен
  dwDataBlockOffset:=dwDataBlockOffset + 2*sizeof(DWORD);
  lpWaveBits:=pointer((DWORD(lpResData) + dwDataBlockOffset));
  CopyMemory(@WFE,pointer(@whWavHeader.wFormatTag),sizeof(TWaveFormatEx)-sizeof(WORD));
  WFE.nBlockAlign:=(DWORD(WFE.nChannels)*DWORD(WFE.wBitsPerSample)) div 8;
  WFE.nAvgBytesPerSec:=DWORD(WFE.nSamplesPerSec)*DWORD(WFE.nBlockAlign);
  dwFlags:=dwFlags or CWF_HEADER_LOADED;
  LastError:=FALSE;
end;
// =======================================================================
procedure TWave.LoadBits;
begin
  LastError:=TRUE;
  if (dwFlags and CWF_HEADER_LOADED) = 0 then exit;
  if (dwFlags and CWF_LOCATED_IN_RESOURCE) <> 0 then
  begin
    // Если требуется скопировать во внешний буфер (н-р от IDirectSound)
    if lpExternalBuffer <> nil then
    begin
      CopyMemory(lpExternalBuffer,lpWaveBits,dwSize);
      lpWaveBits:=lpExternalBuffer;
    end;
    // Иначе можно ничего не делать - lpWaveBits уже настроен
    LastError:=FALSE;
  end
  else // Данные во внешнем файле
  begin
    exit;
  end;
end;
// =======================================================================
procedure TWave.Load;
begin
  LoadHeader(lpszWaveId);
  LoadBits(nil);
end;

end.



