Geriye Doğru Ses Çalma

[ReKoBaa_61]

YOĞUN İSTEK OLURSA PROGRAMI SETUP HALİNDE YAYINLARIM..!





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.