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

Previous  Top  Next

    
 

 

 

Code:

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('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.

 

 

©Drkb::03602

Взято с сайта http://www.swissdelphicenter.ch/en/tipsindex.php