こんにちは、かぼちゃの馬車です。
    

　APIを使ってWAVファイルの再生するサンプルです。
　過去ログを検索してみたらこの手のサンプルが少ないので発言させていただ
きました。

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, 　
Dialogs, MMSystem, StdCtrls, Buttons;

const
  HEAP_ZERO_MEMORY = $00000008;
  WM_END_WAVEOUT = WM_USER + 1;

type

  TWavOut = class(TForm)
    OpenDialog1: TOpenDialog;
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure Button2Click(Sender: TObject);
  private
      Fhmmio: HMMIO;
      FSubchunkSize: DWORD;
      FDataSize:  DWORD;
      FhWavOut: HWAVEOUT;

      FmmckinfoParent: MMCKINFO;
      FmmckinfoSubchunk: MMCKINFO;

      FpWavEhdr: PWAVEHDR;
      FpSubchunk: pChar;
      FpData: pChar;
     // FWaveFmt: tWAVEFORMATEX;  //データ情報

    function LoadFromFile(Const FileName: String): Boolean;
    procedure FileWaveOut;
    procedure HeapFreeProc;
    procedure CloseWaveOut;
    procedure WMEndWaveout(var Msg: TMessage); Message WM_END_WAVEOUT;
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  WavOut: TWavOut;

implementation

{$R *.DFM}

//  WAVEOUT デバイスが投げるメッセージへのハンドラ
//  このハンドラ内では使用できる関数が限られる。
// WAVEの再生状況を受け取るコールバック関数
procedure waveOutProc( hwo: HWAVEOUT; uMsg: UINT; dwInstance,
dwParam1, dwParam2: DWORD); stdcall;
begin
   //このコールバック関数はあまりにも単純なのでアプリにあわせた改良
   //を する必要がある。

   if uMsg = WOM_DONE then
      PostMessage(WavOut.Handle, WM_END_WAVEOUT , 0, dwParam1);
end;

procedure TWavOut.WMEndWaveout(var Msg: TMessage);
begin
   CloseWaveOut;
   ShowMessage('再生終了');
end;

//再生する
procedure TWavOut.FileWaveOut;
var
   mmres: MMRESULT;
begin
// mmres := waveOutOpen(@FhWavOut, WAVE_MAPPER, PWaveFormatEx
(FpSubchunk),
DWORD(Handle), 0, CALLBACK_WINDOW);
   mmres := waveOutOpen(@FhWavOut, WAVE_MAPPER, PWaveFormatEx
(FpSubchunk),
   DWORD(@waveOutProc), 0, CALLBACK_FUNCTION);
   if mmres <> MMSYSERR_NOERROR then
   begin
      HeapFree(GetProcessHeap, 0, FpSubchunk);
      HeapFree(GetProcessHeap, 0, FpData);
      MessageDlg('ERROR "waveOutOpen" ', mtError, [mbOK], 0);
      Exit;
   end;

   // WAVEHDRバッファの割り当て
   FpWavEhdr := HeapAlloc(GetProcessHeap, HEAP_ZERO_MEMORY, SizeOf
(WAVEHDR));

  FpWavEhdr.lpData := FpData;
  FpWavEhdr.dwBufferLength := FDataSize;
  FpWavEhdr.dwFlags := 0;
  FpWavEhdr.dwLoops := 0;

  waveOutPrepareHeader(FhWavOut, FpWavEhdr, SizeOf(WAVEHDR));
  waveOutWrite(FhWavOut, FpWavEhdr, SizeOf(WAVEHDR));
  waveOutUnPrepareHeader(FhWavOut, FpWavEhdr, SizeOf(WAVEHDR));

//WAVEデバイスを閉じる
//   CloseWaveOut;
end;

//WAVEデバイスを閉じる
procedure TWavOut.CloseWaveOut;
Begin
   waveOutReset(FhWavOut);
   waveOutUnprepareHeader(FhWavOut, FpWavEhdr, SizeOf(WAVEHDR));
   waveOutClose(FhWavOut);
end;

procedure TWavOut.HeapFreeProc;
begin
   //メモリの開放
   if FpSubchunk <> nil then
   Begin
//   ShowMessage('FpSubchunk HeapFree');
      HeapFree(GetProcessHeap, 0, FpSubchunk);
   end;
  if FpData <> nil then
   Begin
//   ShowMessage('FpData HeapFree');
      HeapFree(GetProcessHeap, 0, FpData);
end;

  if FpWavEhdr <> nil then
  Begin
 //  ShowMessage('FpWavEhdr HeapFree');
      HeapFree(GetProcessHeap, 0, FpWavEhdr);
   end;
end;

procedure TWavOut.Button1Click(Sender: TObject);
begin
   if OpenDialog1.Execute then
      if LoadFromFile(OpenDialog1.FileName) then
         FileWaveOut;
end;

procedure TWavOut.FormCloseQuery(Sender: TObject; var CanClose:
Boolean);
begin
   HeapFreeProc; //メモリの開放
end;

function TWavOut.LoadFromFile(Const FileName: String): Boolean;
var
   mmres: MMRESULT;
begin
   Result := true;

  Fhmmio := mmioOpen(PChar(FileName), nil, MMIO_READ);
  if Fhmmio = 0 then
   begin
      MessageDlg('ERROR "not WAVEFile Open"',mtError, [mbOK], 0);
      Result := False;
      Exit;
  end;

  // ファイル先頭へシーク
  mmioSeek(Fhmmio, 0, SEEK_SET);
  FmmckinfoParent.fccType := mmioStringToFOURCC(PChar('WAVE'), 0);
  mmres := mmioDescend(Fhmmio, @FmmckinfoParent, nil, MMIO_FINDRIFF);
  if mmres <> MMSYSERR_NOERROR then
  begin
      MessageDlg('ERROR! "not WAVE format" ', mtError, [mbOK], 0);
      Result := False;
      Exit;
  end;

  // fmtチャンク
  FmmckinfoSubchunk.ckid := mmioStringToFOURCC(PChar('fmt '), 0);
  mmres := mmioDescend(Fhmmio, @FmmckinfoSubchunk, @FmmckinfoParent,
MMIO_FINDCHUNK);
  if mmres <> MMSYSERR_NOERROR then
  begin
      MessageDlg('ERROR! "not fmt format" ', mtError, [mbOK], 0);
      Result := False;
      Exit;
  end;

  FSubchunkSize := FmmckinfoSubchunk.cksize;
  FpSubchunk := HeapAlloc(GetProcessHeap, HEAP_ZERO_MEMORY,
FSubchunkSize);
  if (mmioRead(Fhmmio, FpSubchunk, FSubchunkSize) <> LongInt
(FSubchunkSize)) then
  begin
      MessageDlg('ERROR! "Reading fmt chunk" ', mtError, [mbOK], 0);
      Result := False;
      HeapFree(GetProcessHeap, 0, FpSubchunk);
      Exit;
  end;

  mmioAscend(Fhmmio, @FmmckinfoSubchunk, 0);
  // dataチャンク
  FmmckinfoSubchunk.ckid := mmioStringToFOURCC(PChar('data'), 0);
  mmres := mmioDescend(Fhmmio, @FmmckinfoSubchunk, @FmmckinfoParent,
MMIO_FINDCHUNK);
  if mmres <> MMSYSERR_NOERROR then
  begin
      MessageDlg('ERROR "not data format" ', mtError, [mbOK], 0);
      Result := False;
      HeapFree(GetProcessHeap, 0, FpSubchunk);
      Exit;
  end;

  // dataチャンク用のバッファの割り当て
  FDataSize := FmmckinfoSubchunk.cksize;
  FpData := HeapAlloc(GetProcessHeap, HEAP_ZERO_MEMORY, FDataSize);
  if (mmioRead(Fhmmio, FpData, FDataSize) <> LongInt(FDataSize)) then
  begin
      MessageDlg('ERROR! "Reading data chunk" ', mtError, [mbOK], 0);
      Result := False;
      HeapFree(GetProcessHeap, 0, FpSubchunk);
      HeapFree(GetProcessHeap, 0, FpData);
      Exit;
  end;

  // WAVファイルのクローズ
  mmioClose(Fhmmio, 0);
end;

procedure TWavOut.Button2Click(Sender: TObject);
begin
   FileWaveOut;
end;

end.
                         By　かぼちゃの馬車

Original document by かぼちゃの馬車  氏 ID:(MXF01374)

ここにあるドキュメントは NIFTY SERVEの Delphi Users' Forum の16番会議室「玉石混淆みんなで作るSample蔵」に投稿されたサンプルです。これらのサンプルはボーランド株式会社がサポートする公式のものではありません。また、必ずしも動作が検証されているものではありません。これらのサンプルを使用したことに起因するいかなる損害も投稿者、およびフォーラムスタッフはその責めを負いません。使用者のリスクの範疇でご使用下さい。