Как проиграть wave file в обратную сторону?

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
 { Private declarations }
 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;
 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('Cannot 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.
Source: http://www.swissdelphicenter.ch/en/tipsindex.php
ID: 03602
Category:Звук