unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, MMSystem;
const
WM_FINISHED = WM_USER + $200;
type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
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;
{
Callback function to be called during waveform-audio playback
to process messages related to the progress of t he playback.
}
procedure waveOutPrc(hwo: HWAVEOUT; uMsg: UINT; dwInstance,
dwParam1, dwParam2: DWORD); stdcall;
begin
TForm1(dwInstance).WaveOutProc(hwo, uMsg, dwParam1, dwParam2)
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.ReversePlay(const szFileName: string);
var
mmioHandle: HMMIO;
mmckInfoParent: MMCKInfo;
mmckInfoSubChunk: MMCKInfo;
dwFmtSize, dwDataSize: DWORD;
pFormat: PWAVEFORMATEX;
wBlockSize: word;
hpch1, hpch2: PChar;
begin
{ The mmioOpen function opens a file for unbuffered or buffered I/O }
mmioHandle := mmioOpen(PChar(szFileName), nil, MMIO_READ or MMIO_ALLOCBUF);
if mmioHandle = 0 then
raise Exception.Create('Unable to open file ' + szFileName);
try
{ mmioStringToFOURCC converts a null-terminated string to a four-character code }
mmckInfoParent.fccType := mmioStringToFOURCC('WAVE', 0);
{ The mmioDescend function descends into a chunk of a RIFF file }
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
{ The mmioRead function reads a specified number of bytes from a file }
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');
{ he waveOutOpen function opens the given waveform-audio output device for playback }
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;
{ The waveOutPrepareHeader function prepares a waveform-audio data block for playback. }
if waveOutPrepareHeader(fWaveOutHandle, fWaveHdr,
SizeOf(WAVEHDR)) <> MMSYSERR_NOERROR then
raise Exception.Create('Unable to prepare header');
{ The waveOutWrite function sends a data block to the given waveform-audio output device.}
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;
// Play a wave file
procedure TForm1.Button1Click(Sender: TObject);
begin
Button1.Enabled := False;
try
ReversePlay('C:\myWaveFile.wav')
except
Button1.Enabled := True;
raise
end
end;
// Stop Playback
procedure TForm1.Button2Click(Sender: TObject);
begin
{ The waveOutReset function stops playback on the given waveform-audio output device }
WaveOutReset(fWaveOutHandle);
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.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
WaveOutReset(fWaveOutHandle);
while fWaveOutHandle <> 0 do
Application.ProcessMessages
end;
end.