whats new ¦  programming tips ¦  indy articles ¦  intraweb articles ¦  informations ¦  links ¦  interviews
 misc ¦  tutorials ¦  Add&Win Game

Tips (1548)

Database (90)
Files (137)
Forms (107)
Graphic (116)
IDE (21)
Indy (5)
Internet / LAN (131)
IntraWeb (0)
Math (76)
Misc (127)
Multimedia (45)
Objects/
ActiveX (51)

OpenTools API (3)
Printing (35)
Strings (83)
System (268)
VCL (243)

Top15

Tips sort by
component


Search Tip

Add new Tip

Add&Win Game

Advertising

39 Visitors Online


 
...play a wave file backwards?
Autor: Colin Wilson
Homepage: http://www.wilsonc.demon.co.uk/delphi.htm
[ Print tip ]  

Tip Rating (19):  
     


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.

 

Rate this tip:

poor
very good


Copyright © by SwissDelphiCenter.ch
All trademarks are the sole property of their respective owners