waveio.pas

一整套声音录制控件

{------------------------------------------------------------------------------}
{                                                                              }
{  WaveIO - Abstract definition of wave audio input/output                     }
{  by Kambiz R. Khojasteh                                                      }
{                                                                              }
{  [e-mail]                                                       }
{  http://www.delphiarea.com                                                   }
{                                                                              }
{------------------------------------------------------------------------------}

{$I DELPHIAREA.INC}

unit WaveIO;

interface

uses
  Windows, Messages, Classes, SysUtils, mmSystem, WaveUtils;

type

  // The base abstract class for wave audio player and recorder components
  TWaveAudioIO = class(TComponent)
  private
    fAsync: Boolean;
    fDeviceID: DWORD;
    fLastError: MMRESULT;
    fBufferLength: WORD;
    fBufferCount: WORD;
    fOpening: Boolean;
    fClosing: Boolean;
    fCallback: DWORD;
    fCallbackType: DWORD;
    fOnActivate: TWaveAudioEvent;
    fOnDeactivate: TWaveAudioEvent;
    fOnPause: TWaveAudioEvent;
    fOnResume: TWaveAudioEvent;
    fOnError: TWaveAudioEvent;
    fOnLevel: TWaveAudioLevelEvent;
    fOnFilter: TWaveAudioFilterEvent;
    Buffers: TList;
    ThreadEvent: THandle;
    ThreadHandle: THandle;
    CS: TRTLCriticalSection;
    procedure SetAsync(Value: Boolean);
    procedure SetDeviceID(Value: DWORD);
    procedure SetBufferLength(Value: WORD);
    procedure SetBufferCount(Value: WORD);
    function GetActiveBufferCount: WORD;
    function GetLastErrorText: String;
    function GetPreferredBufferSize: DWORD;
  protected
    // Helper Procedures
    procedure Lock;
    procedure Unlock;
    procedure CreateCallback;
    procedure DestroyCallback;
    procedure PostWaveMessage(WaveMsg: DWORD; pWaveHeader: PWaveHdr);
    function ProcessWaveMessage(Msg: DWORD; pWaveHeader: PWaveHdr): Boolean;
    procedure CallbackWindowProc(var Message: TMessage);
    function Success(mmResult: MMRESULT): Boolean;
    function mmTimeToMS(const mmTime: TMMTime): DWORD;
    function ReallocateBuffer(var pWaveHeader: PWaveHdr;
      BufferSize: DWORD; Buffer: Pointer): Boolean;
  protected
    // Callback Notifications
    procedure DoWaveInDeviceOpen; virtual;
    procedure DoWaveInDeviceClose; virtual;
    procedure DoWaveInDeviceData(pWaveHeader: PWaveHdr); virtual;
    procedure DoWaveOutDeviceOpen; virtual;
    procedure DoWaveOutDeviceClose; virtual;
    procedure DoWaveOutDeviceDone(pWaveHeader: PWaveHdr); virtual;
  protected
    WaveFormat: TWaveFormatEx; // only for some internal calculations
    function GetNumDevs: DWORD; virtual; abstract;
    function GetActive: Boolean; virtual;
    procedure SetActive(Value: Boolean); virtual;
    function GetPaused: Boolean; virtual; abstract;
    procedure SetPaused(Value: Boolean); virtual;
    function GetDeviceName: String; virtual; abstract;
    function GetDeviceFormats: TWaveDeviceFormats; virtual; abstract;
    function GetPosition: DWORD; virtual; abstract;
    function GetErrorText(ErrorCode: MMRESULT): String; virtual; abstract;
    procedure GetWaveFormat(out pWaveFormat: PWaveFormatEx;
      var FreeIt: Boolean); virtual; abstract;
    function ValidateDeviceID(ADeviceID: DWORD): MMRESULT; virtual; abstract;
    function InternalOpen: Boolean; virtual; abstract;
    function InternalClose: Boolean; virtual; abstract;
    function InternalPause: Boolean; virtual; abstract;
    function InternalResume: Boolean; virtual; abstract;
    function HandleAllocated: Boolean; virtual; abstract;
    procedure DefineBuffers; virtual; abstract;
    procedure ResetBuffers; virtual;
    procedure DoDeviceOpen; virtual;
    procedure DoDeviceClose; virtual;
    procedure DoActivate; virtual;
    procedure DoDeactivate; virtual;
    procedure DoPause; virtual;
    procedure DoResume; virtual;
    procedure DoError; virtual;
    procedure DoLevel(const Buffer: Pointer; BufferSize: DWORD); virtual;
    procedure DoFilter(const Buffer: Pointer; BufferSize: DWORD); virtual;
  protected
    property Callback: DWORD read fCallback;
    property CallbackType: DWORD read fCallbackType;
    property Opening: Boolean read fOpening write fOpening;
    property Closing: Boolean read fClosing write fClosing;
    property PreferredBufferSize: DWORD read GetPreferredBufferSize;
    property NumDevs: DWORD read GetNumDevs;
    property DeviceName: String read GetDeviceName;
    property DeviceFormats: TWaveDeviceFormats read GetDeviceFormats;
    property Position: DWORD read GetPosition; // Milliseconds
    property LastError: MMRESULT read fLastError;
    property LastErrorText: String read GetLastErrorText;
    property ActiveBufferCount: WORD read GetActiveBufferCount;
    property DeviceID: DWORD read fDeviceID write SetDeviceID default WAVE_MAPPER;
    property BufferLength: WORD read fBufferLength write SetBufferLength default 1000; // Milliseconds
    property BufferCount: WORD read fBufferCount write SetBufferCount default 2;
    property Async: Boolean read fAsync write SetAsync default False;
    property Paused: Boolean read GetPaused write SetPaused default False;
    property Active: Boolean read GetActive write SetActive default False; // As published, should be the last one
    property OnActivate: TWaveAudioEvent read fOnActivate write fOnActivate;
    property OnDeactivate: TWaveAudioEvent read fOnDeactivate write fOnDeactivate;
    property OnPause: TWaveAudioEvent read fOnPause write fOnPause;
    property OnResume: TWaveAudioEvent read fOnResume write fOnResume;
    property OnError: TWaveAudioEvent read fOnError write fOnError;
    property OnLevel: TWaveAudioLevelEvent read fOnLevel write fOnLevel;
    property OnFilter: TWaveAudioFilterEvent read fOnFilter write fOnFilter;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure WaitForStart;
    procedure WaitForStop;
    function Query(const pWaveFormat: PWaveFormatEx): Boolean; virtual; abstract;
    function QueryPCM(PCMFormat: TPCMFormat): Boolean; virtual;
  end;

implementation

{$IFNDEF COMPILER6_UP}
uses Forms;
{$ENDIF}

{ TWaveThread }

type
  TWaveThread = class(TThread)
  private
    WaveAudioIO: TWaveAudioIO;
  protected
    procedure Execute; override;
  public
    constructor Create(Owner: TWaveAudioIO);
    destructor Destroy; override;
  end;

constructor TWaveThread.Create(Owner: TWaveAudioIO);
begin
  inherited Create(True);
  WaveAudioIO := Owner;
  WaveAudioIO.ThreadHandle := Handle;
  WaveAudioIO.ThreadEvent := CreateEvent(nil, True, False, nil);
  FreeOnTerminate := True;
  Priority := tpHigher;
  Resume;
end;

destructor TWaveThread.Destroy;
begin
  CloseHandle(WaveAudioIO.ThreadEvent);
  WaveAudioIO.ThreadEvent := 0;
  inherited Destroy;
end;

procedure TWaveThread.Execute;
var
  MSG: TMSG;
begin
  PeekMessage(MSG, 0, 0, 0, PM_NOREMOVE);
  SetEvent(WaveAudioIO.ThreadEvent);
  while GetMessage(MSG, 0, 0, 0) do
    WaveAudioIO.ProcessWaveMessage(MSG.Message, PWaveHdr(MSG.lParam));
  ResetEvent(WaveAudioIO.ThreadEvent);
  WaveAudioIO.ThreadHandle := 0;
end;

{ TWaveAudioIO }

constructor TWaveAudioIO.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  InitializeCriticalSection(CS);
  fDeviceID := WAVE_MAPPER;
  fBufferLength := 1000;
  fBufferCount := 2;
  Buffers := TList.Create;
end;

destructor TWaveAudioIO.Destroy;
begin
  Active := False;
  WaitForStop;
  Buffers.Free;
  DeleteCriticalSection(CS);
  inherited Destroy;
end;

procedure TWaveAudioIO.SetAsync(Value: Boolean);
begin
  if not Active and (Async <> Value) then
    fAsync := Value;
end;

procedure TWaveAudioIO.SetDeviceID(Value: DWORD);
begin
  if (DeviceID <> Value) then
  begin
    if Active then
      raise EWaveAudioInvalidOperation.Create('DeviceID cannot be changed while device is open')
    else if Success(ValidateDeviceID(Value)) then
      fDeviceID := Value;
  end;
end;

function TWaveAudioIO.GetActive: Boolean;
begin
  Result := (Callback <> 0);
end;

procedure TWaveAudioIO.SetActive(Value: Boolean);
begin
  if Active <> Value then
  begin
    if Value then
      InternalOpen
    else
      InternalClose;
  end;
end;

procedure TWaveAudioIO.SetPaused(Value: Boolean);
begin
  if Paused <> Value then
  begin
    if Value then
      InternalPause
    else
      InternalResume;
  end;
end;

procedure TWaveAudioIO.SetBufferLength(Value: WORD);
begin
  if Value < 10 then
    fBufferLength := 10
  else
    fBufferLength := Value;
end;

procedure TWaveAudioIO.SetBufferCount(Value: WORD);
begin
  fBufferCount := Value;
end;

function TWaveAudioIO.GetActiveBufferCount: WORD;
begin
  Result := Buffers.Count;
end;

function TWaveAudioIO.GetPreferredBufferSize: DWORD;
begin
  Result := CalcWaveBufferSize(@WaveFormat, BufferLength);
end;

function TWaveAudioIO.GetLastErrorText: String;
begin
  Result := GetErrorText(fLastError);
end;

procedure TWaveAudioIO.DoDeviceOpen;
begin
  Opening := False;
  DefineBuffers;
  DoActivate;
end;

procedure TWaveAudioIO.DoDeviceClose;
begin
  DoLevel(nil, 0);
  Closing := False;
  DestroyCallback;
  ResetBuffers;
  DoDeactivate;
end;

procedure TWaveAudioIO.DoActivate;
begin
  if Assigned(fOnActivate) then
    fOnActivate(Self);
end;

procedure TWaveAudioIO.DoDeactivate;
begin
  if Assigned(fOnDeactivate) and not (csDestroying in ComponentState) then
    fOnDeactivate(Self);
end;

procedure TWaveAudioIO.DoPause;
begin
  if Assigned(fOnPause) then
    fOnPause(Self);
end;

procedure TWaveAudioIO.DoResume;
begin
  if Assigned(fOnResume) then
    fOnResume(Self);
end;

procedure TWaveAudioIO.DoError;
begin
  if Assigned(fOnError) then
    fOnError(Self)
  else
    raise EWaveAudioSysError.Create(LastErrorText);
end;

procedure TWaveAudioIO.DoLevel(const Buffer: Pointer; BufferSize: DWORD);
begin
  if Assigned(fOnLevel) and not (csDestroying in ComponentState) and
    (WaveFormat.wFormatTag = WAVE_FORMAT_PCM) then
  begin
    fOnLevel(Self, GetWaveAudioPeakLevel(Buffer, BufferSize, @WaveFormat));
  end;
end;