waveutils.pas

一整套声音录制控件

{------------------------------------------------------------------------------}
{                                                                              }
{  WaveUtils - Utility functions and data types                                }
{  by Kambiz R. Khojasteh                                                      }
{                                                                              }
{  [e-mail]                                                       }
{  http://www.delphiarea.com                                                   }
{                                                                              }
{------------------------------------------------------------------------------}

{$I DELPHIAREA.INC}

unit WaveUtils;

interface

uses
  Windows, Messages, Classes, SysUtils, mmSystem;

type

  // Milliseconds to string format specifiers
  TMS2StrFormat = (
    msHMSh, // Hour:Minute:Second.Hunderdth
    msHMS,  // Hour:Minute:Second
    msMSh,  // Minute:Second.Hunderdth
    msMS,   // Minute:Second
    msSh,   // Second.Hunderdth
    msS,    // Second
    msAh,   // Best format with hunderdth of second
    msA);   // Best format without hunderdth of second

  // Standard PCM Audio Format
  TPCMChannel = (cMono, cStereo);
  TPCMSamplesPerSec = (ss8000Hz, ss11025Hz, ss22050Hz, ss44100Hz, ss48000Hz);
  TPCMBitsPerSample = (bs8Bit, bs16Bit);
  TPCMFormat = (nonePCM, Mono8Bit8000Hz, Stereo8bit8000Hz, Mono16bit8000Hz,
    Stereo16bit8000Hz, Mono8bit11025Hz, Stereo8bit11025Hz, Mono16bit11025Hz,
    Stereo16bit11025Hz, Mono8bit22050Hz, Stereo8bit22050Hz, Mono16bit22050Hz,
    Stereo16bit22050Hz, Mono8bit44100Hz, Stereo8bit44100Hz, Mono16bit44100Hz,
    Stereo16bit44100Hz, Mono8bit48000Hz, Stereo8bit48000Hz, Mono16bit48000Hz,
    Stereo16bit48000Hz);

  // Wave Device Supported PCM Formats
  TWaveDeviceFormats = set of TPCMFormat;

  // Wave Out Device Supported Features
  TWaveOutDeviceSupport = (dsVolume, dsStereoVolume, dsPitch, dsPlaybackRate,
    dsPosition, dsAsynchronize, dsDirectSound);
  TWaveOutDeviceSupports = set of TWaveOutDeviceSupport;

  // Wave Out Options
  TWaveOutOption = (woSetVolume, woSetPitch, woSetPlaybackRate);
  TWaveOutOptions = set of TWaveOutOption;

  {$IFNDEF COMPILER4_UP}
    // Ownership flag of a stream
    TStreamOwnership = (soReference, soOwned);
  {$ENDIF}

  // State of wave stream adapter
  TWaveStreamState = (wssReady, wssReading, wssWriting, wssWritingEx);

  // Wave Audio Exceptions
  EWaveAudioError = class(Exception);
  EWaveAudioSysError = class(EWaveAudioError);
  EWaveAudioInvalidOperation = class(EWaveAudioError);

  // Wave Audio Events
  TWaveAudioEvent = procedure(Sender: TObject) of object;
  TWaveAudioGetFormatEvent = procedure(Sender: TObject;
    out pWaveFormat: PWaveFormatEx; var FreeIt: Boolean) of object;
  TWaveAudioGetDataEvent = function(Sender: TObject; const Buffer: Pointer;
    BufferSize: DWORD; var NumLoops: DWORD): DWORD of object;
  TWaveAudioGetDataPtrEvent = function(Sender: TObject; out Buffer: Pointer;
    var NumLoops: DWORD; var FreeIt: Boolean): DWORD of object;
  TWaveAudioDataReadyEvent = procedure(Sender: TObject; const Buffer: Pointer;
    BufferSize: DWORD; var FreeIt: Boolean) of object;
  TWaveAudioLevelEvent = procedure(Sender: TObject; Level: Integer) of object;
  TWaveAudioFilterEvent = procedure(Sender: TObject; const Buffer: Pointer;
    BufferSize: DWORD) of object;

// Retrieves format, size, and offset of the wave audio for an open mmIO
// handle. On success when the the function returns true, it is the caller
// responsibility to free the memory allocated for the Wave Format structure.
function GetWaveAudioInfo(mmIO: HMMIO; out pWaveFormat: PWaveFormatEx;
  out DataSize, DataOffset: DWORD): Boolean;

// Initializes a new wave RIFF format in an open mmIO handle. The previous
// content of mmIO will be lost.
function CreateWaveAudio(mmIO: HMMIO; const pWaveFormat: PWaveFormatEx;
  out ckRIFF, ckData: TMMCKInfo): Boolean;

// Updates the chunks and closes an mmIO handle.
procedure CloseWaveAudio(mmIO: HMMIO; var ckRIFF, ckData: TMMCKInfo);

// Retrieves format, size, and offset of the wave audio for a stream. On
// success when the the function returns true, it is the caller responsibility
// to free the memory allocated for the Wave Format structure.
function GetStreamWaveAudioInfo(Stream: TStream; out pWaveFormat: PWaveFormatEx;
  out DataSize, DataOffset: DWORD): Boolean;

// Initializes wave RIFF format in a stream and returns the mmIO handle.
// After calling this function, the previous content of the stream will be lost.
function CreateStreamWaveAudio(Stream: TStream; const pWaveFormat: PWaveFormatEx;
  out ckRIFF, ckData: TMMCKInfo): HMMIO;

// Opens wave RIFF format in a stream for read and write operations and returns
// the mmIO handle.
function OpenStreamWaveAudio(Stream: TStream): HMMIO;

// Claculates the wave buffer size for the specified duration.
function CalcWaveBufferSize(const pWaveFormat: PWaveFormatEx; Duration: DWORD): DWORD;

// Returns the string representation of an audio format tag.
function GetAudioFormat(FormatTag: Word): String;

// Returns the wave's length in milliseconds.
// Returns the string representation of a wave audio format.
function GetWaveAudioFormat(const pWaveFormat: PWaveFormatEx): String;

// Returns the wave's length in milliseconds.
function GetWaveAudioLength(const pWaveFormat: PWaveFormatEx; DataSize: DWORD): DWORD;

// Returns the wave's bit rate in kbps (kilo bits per second).
function GetWaveAudioBitRate(const pWaveFormat: PWaveFormatEx): DWORD;

// Returns the wave data volume peak level in percent (PCM format only).
function GetWaveAudioPeakLevel(const Data: Pointer; DataSize: DWORD;
  const pWaveFormat: PWaveFormatEx): Integer;

// Inverts the wave data (PCM format only).
function InvertWaveAudio(const Data: Pointer; DataSize: DWORD;
  const pWaveFormat: PWaveFormatEx): Boolean;

// Fills the wave data with silence
function SilenceWaveAudio(const Data: Pointer; DataSize: DWORD;
  const pWaveFormat: PWaveFormatEx): Boolean;

// Increases/Decreases the wave data volume by the specified percentage (PCM format only).
function ChangeWaveAudioVolume(const Data: Pointer; DataSize: DWORD;
  const pWaveFormat: PWaveFormatEx; Percent: Integer): Boolean;

// Converts the wave data to the specified format (PCM format only). The caller is
// responsible to release the memory allocated for the converted wave data.
function ConvertWaveFormat(const srcFormat: PWaveFormatEx; srcData: Pointer; srcDataSize: DWORD;
  const dstFormat: PWaveFormatEx; out dstData: Pointer; out dstDataSize: DWORD): Boolean;

// Initializes a standard PCM wave format header. The size of memory referenced
// by the pWaveFormat parameter must not be less than the size of TWaveFormatEx
// record.
procedure SetPCMAudioFormat(const pWaveFormat: PWaveFormatEx; Channels: TPCMChannel;
  SamplesPerSec: TPCMSamplesPerSec; BitsPerSample: TPCMBitsPerSample);

// Initializes a standard PCM wave format header (shorcut form). The size of
// memory referenced by the pWaveFormat parameter must not be less than the
// size of TWaveFormatEx record.
procedure SetPCMAudioFormatS(const pWaveFormat: PWaveFormatEx; PCMFormat: TPCMFormat);

// Returns the standard PCM format specifier of a wave format.
function GetPCMAudioFormat(const pWaveFormat: PWaveFormatEx): TPCMFormat;

// Returns the byte offset (zero base) of the wave audio specified by the pWaveFormat
// parameter at the position specified by the Position parameter in milliseconds.
function GetWaveDataPositionOffset(const pWaveFormat: PWaveFormatEx; Position: DWORD): DWORD;

// Converts milliseconds to string
function MS2Str(Milliseconds: DWORD; Fmt: TMS2StrFormat): String;

// Waits for the scnchronize object while lets the caller thread processes
// its messages.
function WaitForSyncObject(SyncObject: THandle; Timeout: DWORD): DWORD;

// User defined mmIOProc to handle Delphi streams by Windows' mmIO functions
function mmioStreamProc(lpmmIOInfo: PMMIOInfo; uMsg, lParam1, lParam2: DWORD): LRESULT; stdcall;

implementation

uses
  WaveACM;

{ Global Procedures }

// To open a stream using mmIO API functions, use the following code sample:
//
//    FillChar(mmioInfo, SizeOf(mmioInfo), 0);
//    mmioInfo.pIOProc := @mmioStreamProc;
//    mmioInfo.adwInfo[0] := DWORD(your_stream_instance);
//    mmIO := mmioOpen(nil, @mmioInfo, dwOpenFlags);
//
// The flags specified by the dwOpenFlags parameter of mmioOpen function can
// be only one of MMIO_READ, MMIO_WRITE, and MMIO_READWRITE flags. If you use
// another flags, simply they will be ignored by this user defined function.

function mmIOStreamProc(lpmmIOInfo: PMMIOInfo; uMsg, lParam1, lParam2: DWORD): LRESULT; stdcall;
var
  Stream: TStream;
begin
  if Assigned(lpmmIOInfo) and (lpmmIOInfo^.adwInfo[0] <> 0) then
  begin
    Stream := TStream(lpmmIOInfo^.adwInfo[0]);
    case uMsg of
      MMIOM_OPEN:
      begin
        if TObject(lpmmIOInfo^.adwInfo[0]) is TStream then
        begin
          Stream.Seek(0, SEEK_SET);
          lpmmIOInfo^.lDiskOffset := 0;
          Result := MMSYSERR_NOERROR;
        end
        else
          Result := -1;
      end;
      MMIOM_CLOSE:
        Result := MMSYSERR_NOERROR;
      MMIOM_SEEK:
        try
          if lParam2 = SEEK_CUR then
            Stream.Seek(lpmmIOInfo^.lDiskOffset, SEEK_SET);
          Result := Stream.Seek(lParam1, lParam2);
          lpmmIOInfo^.lDiskOffset := Result;
        except
          Result := -1;
        end;
      MMIOM_READ:
        try
          Stream.Seek(lpmmIOInfo^.lDiskOffset, SEEK_SET);
          Result := Stream.Read(Pointer(lParam1)^, lParam2);
          lpmmIOInfo^.lDiskOffset := Stream.Seek(0, SEEK_CUR);
        except
          Result := -1;
        end;
      MMIOM_WRITE,
      MMIOM_WRITEFLUSH:
        try
          Stream.Seek(lpmmIOInfo^.lDiskOffset, SEEK_SET);
          Result := Stream.Write(Pointer(lParam1)^, lParam2);
          lpmmIOInfo^.lDiskOffset := Stream.Seek(0, SEEK_CUR);
        except
          Result := -1;
        end
    else
      Result := MMSYSERR_NOERROR;
    end;
  end
  else
    Result := -1;
end;

// Retrieves format, size, and offset of the wave audio for an open mmIO
// handle. On success when the the function returns true, it is the caller
// responsibility to free the memory allocated for the Wave Format structure.
function GetWaveAudioInfo(mmIO: HMMIO; out pWaveFormat: PWaveFormatEx;
  out DataSize, DataOffset: DWORD): Boolean;

  function GetWaveFormat(const ckRIFF: TMMCKInfo): Boolean;
  var
    ckFormat: TMMCKInfo;
  begin
    Result := False;
    ckFormat.ckid := mmioStringToFOURCC('fmt', 0);
    if (mmioDescend(mmIO, @ckFormat, @ckRIFF, MMIO_FINDCHUNK) = MMSYSERR_NOERROR) and
       (ckFormat.cksize >= SizeOf(TWaveFormat)) then
    begin
      if ckFormat.cksize < SizeOf(TWaveFormatEx) then
      begin
        GetMem(pWaveFormat, SizeOf(TWaveFormatEx));
        FillChar(pWaveFormat^, SizeOf(TWaveFormatEx), 0);
      end
      else
        GetMem(pWaveFormat, ckFormat.cksize);
      Result := (mmioRead(mmIO, PChar(pWaveFormat), ckFormat.cksize) = Integer(ckFormat.cksize));
    end;
  end;

  function GetWaveData(const ckRIFF: TMMCKInfo): Boolean;
  var
    ckData: TMMCKInfo;
  begin
    Result := False;
    ckData.ckid := mmioStringToFOURCC('data', 0);
    if (mmioDescend(mmIO, @ckData, @ckRIFF, MMIO_FINDCHUNK) = MMSYSERR_NOERROR) then
    begin
      DataSize := ckData.cksize;
      DataOffset := ckData.dwDataOffset;
      Result := True;
    end;
  end;

var
  ckRIFF: TMMCKInfo;
  OrgPos: Integer;
begin
  Result := False;
  OrgPos := mmioSeek(mmIO, 0, SEEK_CUR);
  try
    mmioSeek(mmIO, 0, SEEK_SET);
    ckRIFF.fccType := mmioStringToFOURCC('WAVE', 0);
    if (mmioDescend(mmIO, @ckRIFF, nil, MMIO_FINDRIFF) = MMSYSERR_NOERROR) then
    begin
      pWaveFormat := nil;
      if GetWaveFormat(ckRIFF) and GetWaveData(ckRIFF) then
        Result := True
      else if Assigned(pWaveFormat) then
        ReallocMem(pWaveFormat, 0);
    end