audioio.pas

语音压缩和播放控件

{
  File Name: AudioIO.PAS  V 4.00
  Created: 5-Oct-96 by John Mertus on the IBM PC
  Revision #1: 5-Oct-22 by John Mertus
                                        -John Mertus

  Version 1.00 Initial Release

}

{
  There are three Sound Components, the first is the base Component,
  TAudioIO.  This defines the sampling rates, buffers and some of the
  common events.

  The second component is AudioOut, which started just loops playing out
  buffers.

  The third component is AudioIN, which, when started, just loops filling
  buffer with digital data.

  See AudioIO.Hlp for detailed explaination.



}


{-----------------Unit-AudioOut-------------------John Mertus---Oct 96---}

                       Unit AudioIO;

{*************************************************************************}
                            Interface



uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Buttons, MMSystem, UAFDefs;

{ Could make this dynamic, but the effort doesn't seem worth it. }
Const
  MAXBUFFERS = 4;

Type

  {TBuffer Event is what is called when a buffer is need or is full }

  TBufferEvent = Function(Buffer : pChar; Var Size : Integer) : Boolean of Object;
  PAudioIO = ^TAudioIO;
  PAudioOut = ^TAudioOut;
  PAudioIn  = ^TAudioIn;

  TCallBackWinOut = Class(TWinControl)
  private
    { Private declarations }
    AudioComponent : PAudioOut;

    procedure BufferDone(var Msg: TMessage); message  MM_WOM_DONE;
    procedure WaveOpen(var Msg: TMessage); message  MM_WOM_OPEN;
    procedure WaveClose(var Msg: TMessage); message  MM_WOM_CLOSE;

  protected
    { Protected declarations }

  public
    { Public declarations }

  published
    { Published declarations }

  End;


  TCallBackWinIn = Class(TWinControl)
  private
    { Private declarations }
    AudioComponent : PAudioIn;

    procedure BufferFinished(var Msg: TMessage); message  MM_WIM_DATA;
    procedure WaveOpenIn(var Msg: TMessage); message  MM_WIM_OPEN;
    procedure WaveCloseIn(var Msg: TMessage); message  MM_WIM_CLOSE;

  End;


{---------------------------TAudioIO Component-----------------------------}

  TAudioIO = class(TComponent)
  private
    { Private declarations }
    FBufferSize : Integer;            { Actual buffer used }
    FRequestedBufferSize : Integer;   { Buffer size requested }
    FNumBuffers          : Integer;
    FPaused              : Boolean;

    FWaveFmtEx         : TWaveFormatEx;
    FonOpen            : TNotifyEvent;
    FonClose           : TNotifyEvent;
    FWaveDevice        : DWord;
    hWaveHeader	       : Array [0..MAXBUFFERS-1] of THANDLE;
    WaveHdr            : Array [0..MAXBUFFERS-1] of PWAVEHDR;
    WaveBuffer         : Array [0..MAXBUFFERS-1] of lpstr;
    hWaveBuffer        : Array [0..MAXBUFFERS-1] of THANDLE;
    BufIndex           : Integer;
    ContinueProcessing : Boolean;     { Set to TRUE to start FALSE to abort
                                         after filled buffers are done }

    { Property Functions }
    Procedure SetNumBuffers(Value : Integer);
    Procedure SetBufferSize(Value : Integer);
    Procedure SetFrameRate(Value : Integer);
    Procedure SetStereo(Value : Boolean);
    Procedure SetBits(Value : Word);
    Function  GetFrameRate : Integer;
    Function  GetStereo : Boolean;
    Procedure MakeWaveFmtConsistent;

  protected
    { Protected declarations }
    Function InitWaveHeaders : Boolean;
    Function AllocPCMBuffers : Boolean;
    Function FreePCMBuffers : Boolean;
    Function AllocWaveHeaders : Boolean;
    Procedure FreeWaveHeaders;

  public
    { Public declarations }
    ErrorMessage   : String;
    Active         : Boolean;
    FilledBuffers,
    QueuedBuffers,
    ProcessedBuffers   : Integer;

    Constructor Create(AOwner: TComponent); Override;
    Destructor  Destroy; Override;
    Procedure StopAtOnce;                 Virtual;
    Procedure StopGracefully;             Virtual;

  published
    { Published declarations }
      Property BufferSize : Integer read FBufferSize write SetBufferSize Default 8192;
      Property NumBuffers : Integer read FNumBuffers write SetNumBuffers Default 4;
      Property FrameRate : Integer read GetFrameRate Write SetFrameRate Default 22055;
      Property Stereo : Boolean read GetStereo Write SetStereo Default False;
      Property Quantization : Word Read FWaveFmtEx.wBitsPerSample Write SetBits Default 16;
      Property WaveDevice : Integer Read FWaveDevice Write FWaveDevice Default WAVE_MAPPER;
      Property OnStart : TNotifyEvent Read FOnOpen Write FOnOpen;
      Property OnStop  : TNotifyEvent Read FOnClose Write FOnClose;
  end;


{---------------------------TAudioOut Component-----------------------------}


  TAudioOut = Class(TAudioIO)
  private
    { Private declarations }
    WaveDeviceOpen : Boolean;
    CallBackWin    : TCallBackWinOut;
    FOnFillBuffer  : TBufferEvent;

    Function  QueueBuffer : Boolean;
    Function  ReadBuffer(Idx, N : Integer) : Boolean;  Virtual;
    Procedure SetPaused(Value : Boolean);
    Procedure CloseWaveDevice;   Virtual;
    Function  Setup(Var TS: TAudioOut) : Boolean;  Virtual;
    Function  StartIt : Boolean;

  protected
    { Protected declarations }

  public
    { Public declarations }
    WaveHandle     : HWaveOut;     { Waveform output handle }

    Function  Start(Var TS : TAudioOut) : Boolean;
    Procedure StopAtOnce;                         Override;
    Procedure StopGracefully;                     Override;
    Function  ElapsedTime : Real;

  published
    { Published declarations }
    Property Paused : Boolean Read FPaused Write SetPaused Default FALSE;
    Property OnFillBuffer : TBufferEvent Read FOnFillBuffer Write FOnFillBuffer;
  End;


{---------------------------TAudioIn Component-----------------------------}


  TAudioIn = Class(TAudioIO)
  private
    { Private declarations }
    WaveDeviceOpen : Boolean;
    CallBackWin      : TCallBackWinIn;
    FOnBufferFilled  : TBufferEvent;

    Function  QueueBuffer : Boolean;
    Function  ProcessBuffer(B : lpstr; N : Integer) : Boolean;  Virtual;
    Procedure CloseWaveDevice;   Virtual;
    Function  Setup(Var TS: TAudioIn) : Boolean;  Virtual;
    Function  StartIt : Boolean;

  protected
    { Protected declarations }

  public
    { Public declarations }
    WaveHandle        : HWaveOut;     { Waveform output handle }
    Function  Start(Var TS : TAudioIn) : Boolean;
    Procedure StopAtOnce;                       Override;
    Procedure StopGracefully;                   Override;
    Function  ElapsedTime : Real;

  published
    { Published declarations }
    Property OnBufferFilled : TBufferEvent Read FOnBufferFilled Write FOnBufferFilled;
  End;


procedure Register;

{*************************************************************************}

         implementation

{$R *.res}

{---------------TWaveOutGetErrorText------------John Mertus Oct 96---}

   Function TWaveOutGetErrorText(iErr : Integer) : String;

{  This just gets the error text assocated with the output error ierr.  }
{									}
{**********************************************************************}
Var
  ErrorMsgC   : Array [0..255] of Char;

BEGIN
  waveOutGetErrorText(iErr,ErrorMsgC,Sizeof(ErrorMsgC));
  Result := StrPas(ErrorMsgC);
END;

{---------------TWaveInGetErrorText------------John Mertus Oct 96---}

   Function TWaveInGetErrorText(iErr : Integer) : String;

{  This just gets the error text assocated with the output error ierr.  }
{									}
{**********************************************************************}
Var
  ErrorMsgC   : Array [0..255] of Char;

BEGIN
  waveInGetErrorText(iErr,ErrorMsgC,Sizeof(ErrorMsgC));
  Result := StrPas(ErrorMsgC);
END;

procedure Register;
begin
  RegisterComponents('Sound', [TAudioOut, TAudioIn]);
end;

{---------------SetBufferSize-------------------John Mertus Oct 96---}

   Procedure TAudioIO.SetBufferSize(Value : Integer);

{  This just set the buffersize, making sure it is too small.           }
{									}
{**********************************************************************}
BEGIN
   If (Value < 512) Then Value := 512;
  { make the wave buffer size a multiple of the block align... }
   FRequestedBufferSize := Value;
   MakeWaveFmtConsistent;
   FreePCMBuffers;
   AllocPCMBuffers;
END;

{---------------SetNumBuffers-------------------John Mertus Oct 96---}

   Procedure TAudioIO.SetNumBuffers(Value : Integer);

{  This just set the numbers of buffers making sure it is between       }
{ and MaxNumberBuffers                                                  }
{									}
{**********************************************************************}
BEGIN
   If (Value < 2) Then Value := 2;
   If (Value > MAXBUFFERS) Then Value := MAXBUFFERS;
   FNumBuffers := Value;
END;

{---------------SetStereo-----------------------John Mertus Oct 96---}

   Procedure TAudioIO.SetStereo(Value : Boolean);

{  This just set the numbers of channels, True 2, false 1.              }
{									}
{**********************************************************************}
BEGIN
  If Value Then
     FWaveFmtEx.nChannels := 2
  Else
     FWaveFmtEx.nChannels := 1;
   MakeWaveFmtConsistent;
END;

{---------------SetBits-------------------------John Mertus Oct 96---}

   Procedure TAudioIO.SetBits(Value : Word);

{  This just set the numbers of buffers making sure it is between       }
{ and MaxNumberBuffers                                                  }
{									}
{**********************************************************************}
BEGIN
   If (Value < 8) Then Value := 8;
   If (Value > 8) Then Value := 16;
   FWaveFmtEx.wBitsPerSample := Value;
   MakeWaveFmtConsistent;
END;

{---------------SetFrameRate--------------------John Mertus Oct 96---}

   Procedure TAudioIO.SetFrameRate(Value : Integer);

{  This just set the frame rate for sampling.                           }
{									}
{**********************************************************************}
BEGIN
   FWaveFmtEx.nSamplesPerSec := Value;
   MakeWaveFmtConsistent;
END;

{---------------GetFrameRate--------------------John Mertus Oct 96---}

   Function TAudioIO.GetFrameRate : Integer;

{  This just returns the framerate for the current header.              }
{									}
{**********************************************************************}
BEGIN
  Result := FWaveFmtEx.nSamplesPerSec;
END;

{---------------GetStereo-----------------------John Mertus Oct 96---}

   Function TAudioIO.GetStereo : Boolean;

{  This just returns the True if stereo, e.g. 2 channels                }
{									}
{**********************************************************************}
BEGIN
  Result := (FWaveFmtEx.nChannels = 2);
END;


{-----------------Create------------------------John Mertus Oct 96---}

   Constructor TAudioIO.Create(AOwner: TComponent);

{  This just set the numbers of buffers making sure it is between       }
{ and MaxNumberBuffers                                                  }
{									}
{**********************************************************************}
Var
  i : Integer;


BEGIN
   Inherited Create(AOwner);
   FNumBuffers := 4;
   FRequestedBufferSize := 8192;
   Active := FALSE;
   FPaused := FALSE;
   FWaveDevice := WAVE_MAPPER;
   ErrorMessage := '';

  { Set the indendent sampling rates }
   FWaveFmtEx.wFormatTag := WAVE_FORMAT_PCM;
   FWaveFmtEx.wBitsPerSample := 16;
   FWaveFmtEx.nchannels := 1;
   FWaveFmtEx.nSamplesPerSec := 22050;
   MakeWaveFmtConsistent;

  { Now make sure we know buffers are not allocated }
   For i := 0 to MAXBUFFERS-1 Do WaveBuffer[i] := Nil;

   AllocWaveHeaders;
   AllocPCMBuffers;
END;

{-----------------Destroy-----------------------John Mertus Oct 96---}

   Destructor TAudioIO.Destroy;

{  This cleans up the buffers.                                          }
{									}
{**********************************************************************}
BEGIN
  FreePCMBuffers;
  FreeWaveHeaders;
  Inherited Destroy;
END;

{-----------------MakeWaveFmtConsistent---------John Mertus Oct 96---}

   Procedure TAudioIO.MakeWaveFmtConsistent;

{  This just trys to find the correct avgbytes and blockalign that      }
{ one needs to use for the format.  I DO NOT UNDERSTAND WHY MICROSOFT   }
{ did this.                                                             }
{									}