Недавно добавленные исходники

•  TDictionary Custom Sort  3 225

•  Fast Watermark Sources  2 990

•  3D Designer  4 750

•  Sik Screen Capture  3 259

•  Patch Maker  3 467

•  Айболит (remote control)  3 528

•  ListBox Drag & Drop  2 904

•  Доска для игры Реверси  80 773

•  Графические эффекты  3 843

•  Рисование по маске  3 171

•  Перетаскивание изображений  2 544

•  Canvas Drawing  2 672

•  Рисование Луны  2 500

•  Поворот изображения  2 092

•  Рисование стержней  2 119

•  Paint on Shape  1 524

•  Генератор кроссвордов  2 182

•  Головоломка Paletto  1 730

•  Теорема Монжа об окружностях  2 158

•  Пазл Numbrix  1 649

•  Заборы и коммивояжеры  2 016

•  Игра HIP  1 262

•  Игра Go (Го)  1 200

•  Симулятор лифта  1 422

•  Программа укладки плитки  1 177

•  Генератор лабиринта  1 512

•  Проверка числового ввода  1 297

•  HEX View  1 466

•  Физический маятник  1 322

•  Задача коммивояжера  1 357

 
скрыть


Delphi FAQ - Часто задаваемые вопросы

| Базы данных | Графика и Игры | Интернет и Сети | Компоненты и Классы | Мультимедиа |
| ОС и Железо | Программа и Интерфейс | Рабочий стол | Синтаксис | Технологии | Файловая система |



Delphi Sources

Как проиграть 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
    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.




Похожие по теме исходники

Wave Recorder

Haar Wavelet

Wave Recorder v2

Wave and MIDI In-Out

 

Example RIFF Wave

Wave

WAVE Tagger

Pixel Profile

 

File Downloader

UDP File Transfer

File coder / Decoder

Clone Files

 

INI XML Files

FileList Creator

File Attribute Changer

Make Self-Extract File

 



Copyright © 2004-2024 "Delphi Sources" by BrokenByte Software. Delphi World FAQ

Группа ВКонтакте