Как проиграть wave file в обратную сторону?
Материал из DRKB
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