From: Colin Wilson <colin@wilsonc.demon.co.uk>
Subject: Re: Multimedia
Date: 07 Jun 2000 00:00:00 GMT
Message-ID: <VA.00000cb9.0aeac764@dtop2000beta308>
Content-Transfer-Encoding: 8bit
References: <393c491b@dnews>
Content-Type: text/plain; charset=iso-8859-1
Organization: Another Netscape Collabra Server User
Mime-Version: 1.0
Reply-To: colin@wilsonc.demon.co.uk
Newsgroups: borland.public.delphi.graphics

Use the low-level wave APIs in MMSYSTEM.pas

I just wrote this program that plays a wave file backwards.  I'll
upload it here as it's only small.  It should be easy to modify to play
them forwards, and it may give you some clues.  Of course it use the
MMIO stuff to load the data, but it would be just as easy to get it
from a resource...


Colin
e-mail :colin@wilsonc.demon.co.uk
web: http://www.wilsonc.demon.co.uk/delphi.htm

----------------------------------------------------------------------
unit MainForm;

interface

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

const
  WM_FINISHED = WM_USER + $200;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  private
    fData : PChar;
    fWaveHdr : PWAVEHDR;
    fWaveOutHandle : HWAVEOUT;

    procedure ReversePlay(const szFileName: string);
    procedure WaveOutProc (hwo : HWAVEOUT; uMsg : UINT; dwParam1,
dwParam2 : DWORD);
    procedure WmFinished (var msg : TMessage); message WM_FINISHED;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}
procedure Interchange(hpchPos1, hpchPos2 : PChar; wLength : word);
var
  wPlace : word;
  bTemp : char;
begin
  for wPlace := 0 to wLength - 1 do
  begin
    bTemp := hpchPos1[wPlace];
    hpchPos1[wPlace] := hpchPos2[wPlace];
    hpchPos2[wPlace] := bTemp
  end
end;

procedure waveOutPrc (hwo : HWAVEOUT; uMsg : UINT; dwInstance,
dwParam1, dwParam2 : DWORD); stdcall;
begin
  TForm1 (dwInstance).WaveOutProc (hwo, uMsg, dwParam1, dwParam2)
end;

procedure TForm1.ReversePlay (const szFileName : string);
var
  mmioHandle : HMMIO;
  mmckInfoParent : MMCKInfo;
  mmckInfoSubChunk : MMCKInfo;
  dwFmtSize, dwDataSize : DWORD;
  pFormat : PWAVEFORMATEX;
  wBlockSize : word;
  hpch1, hpch2 : PChar;
begin
  mmioHandle := mmioOpen(PChar (szFileName), Nil, MMIO_READ or
MMIO_ALLOCBUF);
  if mmioHandle = 0 then
    raise Exception.Create ('Unable to open file ' + szFileName);

  try
    mmckInfoParent.fccType := mmioStringToFOURCC ('WAVE', 0);
    if mmioDescend (mmioHandle, @mmckinfoParent, Nil, MMIO_FINDRIFF) <>
MMSYSERR_NOERROR then
      raise Exception.Create (szFileName + ' is not a valid wave
file');

    mmckinfoSubchunk.ckid := mmioStringToFourCC ('fmt ', 0);
    if mmioDescend (mmioHandle, @mmckinfoSubchunk, @mmckinfoParent,
MMIO_FINDCHUNK) <> MMSYSERR_NOERROR then
      raise Exception.Create (szFileName + ' is not a valid wave
file');


    dwFmtSize := mmckinfoSubchunk.cksize;
    GetMem (pFormat, dwFmtSize);

    try
      if DWORD (mmioRead (mmioHandle, PChar (pFormat), dwFmtSize)) <>
dwFmtSize then
        raise Exception.Create ('Error reading wave data');

      if pFormat^.wFormatTag <> WAVE_FORMAT_PCM then
        raise Exception.Create ('Invalid wave file format');

      if waveOutOpen (@fWaveOutHandle, WAVE_MAPPER, pFormat, 0, 0,
WAVE_FORMAT_QUERY) <> MMSYSERR_NOERROR then
        raise Exception.Create ('Can''t play format');

      mmioAscend(mmioHandle, @mmckinfoSubchunk, 0);
      mmckinfoSubchunk.ckid := mmioStringToFourCC ('data', 0);
      if mmioDescend (mmioHandle, @mmckinfoSubchunk, @mmckinfoParent,
MMIO_FINDCHUNK) <> MMSYSERR_NOERROR then
        raise Exception.Create ('No data chunk');

      dwDataSize := mmckinfoSubchunk.cksize;
      if dwDataSize = 0 then
        raise Exception.Create ('Chunk has no data');

      if waveOutOpen (@fWaveOutHandle, WAVE_MAPPER, pFormat, DWORD
(@WaveOutPrc), Integer (self), CALLBACK_FUNCTION) <> MMSYSERR_NOERROR
then
      begin
        fWaveOutHandle := 0;
        raise Exception.Create ('Failed to open output device');
      end;

      wBlockSize := pFormat^.nBlockAlign;

      ReallocMem (pFormat, 0);
      ReallocMem (fData, dwDataSize);

      if DWORD (mmioRead (mmioHandle, fData, dwDataSize)) <> dwDataSize
then
        raise Exception.Create ('Unable to read data chunk');

      hpch1 := fData;
      hpch2 := fData + dwDataSize - 1;

      while hpch1 < hpch2 do
      begin
        Interchange (hpch1, hpch2, wBlockSize);
        Inc (hpch1, wBlockSize);
        Dec (hpch2, wBlockSize)
      end;

      GetMem (fWaveHdr, sizeof (WAVEHDR));
      fWaveHdr^.lpData := fData;
      fWaveHdr^.dwBufferLength := dwDataSize;
      fWaveHdr^.dwFlags := 0;
      fWaveHdr^.dwLoops := 0;
      fWaveHdr^.dwUser := 0;

      if waveOutPrepareHeader(fWaveOutHandle, fWaveHdr,
sizeof(WAVEHDR)) <> MMSYSERR_NOERROR then
        raise Exception.Create ('Unable to prepare header');

      if waveOutWrite (fWaveOutHandle, fWaveHdr, sizeof (WAVEHDR)) <>
MMSYSERR_NOERROR then
        raise Exception.Create ('Failed to write to device');

    finally
      ReallocMem (pFormat, 0)
    end
  finally
    mmioClose (mmioHandle, 0)
  end
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Button1.Enabled := False;
  try
    ReversePlay ('d:\camera.wav')
  except
    Button1.Enabled := True;
    raise
  end
end;
procedure TForm1.WaveOutProc(hwo: HWAVEOUT; uMsg: UINT; dwParam1,
  dwParam2: DWORD);
begin
  case uMsg of
    WOM_OPEN:;
    WOM_CLOSE:
      fWaveOutHandle := 0;
    WOM_DONE:
      PostMessage (Handle, WM_FINISHED, 0, 0);
  end
end;

procedure TForm1.WmFinished(var msg: TMessage);
begin
  WaveOutUnprepareHeader (fWaveOutHandle, fWaveHdr, sizeof (WAVEHDR));
  WaveOutClose (fWaveOutHandle);
  ReallocMem (fData, 0);
  ReallocMem (fWaveHdr, 0);
  Button1.Enabled := True;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  WaveOutReset (fWaveOutHandle);
end;

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose:
Boolean);
begin
  WaveOutReset (fWaveOutHandle);
  while fWaveOutHandle <> 0 do
    Application.ProcessMessages
end;

end.