mmwavin.pas

一套及时通讯的原码

{========================================================================}
{=                (c) 1995-98 SwiftSoft Ronald Dittrich                 =}
{========================================================================}
{=                          All Rights Reserved                         =}
{========================================================================}
{=  D 01099 Dresden             = Fax.: [phone]               =}
{=  Loewenstr.7a                = [e-mail]                     =}
{========================================================================}
{=  Actual versions on http://www.swiftsoft.de/index.html               =}
{========================================================================}
{=  This code is for reference purposes only and may not be copied or   =}
{=  distributed in any format electronic or otherwise except one copy   =}
{=  for backup purposes.                                                =}
{=                                                                      =}
{=  No Delphi Component Kit or Component individually or in a collection=}
{=  subclassed or otherwise from the code in this unit, or associated   =}
{=  .pas, .dfm, .dcu, .asm or .obj files may be sold or distributed     =}
{=  without express permission from SwiftSoft.                          =}
{=                                                                      =}
{=  For more licence informations please refer to the associated        =}
{=  HelpFile.                                                           =}
{========================================================================}
{=  $Date: 25.11.98 - 13:23:40 $                                        =}
{========================================================================}
unit MMWavIn;

{$C FIXED PRELOAD PERMANENT}

{$I COMPILER.INC}

{.$DEFINE _MMDEBUG}

interface

uses
{$IFDEF WIN32}
  Windows,
{$ELSE}
  WinTypes,
  WinProcs,
{$ENDIF}
  SysUtils,
  Messages,
  Classes,
  Graphics,
  Controls,
  Forms,
  Dialogs,
  MMSystem,
  MMUtils,
  MMObj,
  MMString,
  MMDSPObj,
  MMDSPMtr,
  MMRegs,
  MMPCMSup,
  MMAlloc,
  MMWaveIO
  {$IFDEF _MMDEBUG}
  ,MMDebug
  {$ENDIF};

{$IFDEF _MMDEBUG}
   {$DEFINE NUMERATE}
   const
        DEBUGLEVEL = 0; { 0,1,2 }
{$ENDIF}

const
  {$IFDEF CBUILDER3} {$EXTERNALSYM MAXERRORLENGTH} {$ENDIF}
  MAXERRORLENGTH   = 255;
  {$IFDEF CBUILDER3} {$EXTERNALSYM MAXINBUFFERS} {$ENDIF}
  MAXINBUFFERS     = 500;
  {$IFDEF CBUILDER3} {$EXTERNALSYM MINBUFFERSIZE} {$ENDIF}
  MINBUFFERSIZE    = 32;

type
  EMMWaveInError   = class(Exception);
  TMMWaveInStates  = (wisClose, wisOpen, wisRecord,wisPause);
  TMMWaveInState   = set of TMMWaveInStates;

  { Pointers to waveIn headers }
  TMMWaveInHdrs    = array[0..MAXINBUFFERS-1] of PWaveHdr;

  TMMCustomWaveIn  = class;

  {$IFDEF WIN32}
  {-- TMMWaveInThread ----------------------------------------------------}
  TMMWaveInThread = class(TMMDSPThread)
  private
     procedure Execute; override;
  end;
  {$ENDIF}

  {-- TMMCustomWaveIn ---------------------------------------------------------}
  TMMCustomWaveIn = class(TMMCustomSoundComponent)
  private
    FHandle        : THandle;        { handle used for callback window    }
    FPriority      : TThreadPriority;{ thread priority                    }
    FDeviceID      : TMMDeviceID;    { WAVEIN device ID                   }
    FHWaveIn       : HWaveIn;        { Handle to input device             }
    FState         : TMMWaveInState; { Current device state               }
    FWaveInHdrs    : TMMWaveInHdrs;  { WaveIn Headers and Buffers         }
    FBufferIndex   : integer;        { the current Header/BufferIndex     }
    FCallbackMode  : TMMCBMode;      { use Window or Callback function    }

    FError         : integer;        { Last WaveIn Error                  }
    FNumdevs       : integer;	     { Num. of input devices on system    }
    FWaveInCaps    : TWaveInCaps;    { Stuff from WAVEINCAPS              }
    FProductName   : String;
    FDriverVersion : integer;        { Specifies the driver version       }
                                     { high-order byte is major version   }
                                     { low-order byte is minor version    }
    FInHandler     : integer;        { marks that we in any event handler }
    FStopIt        : Boolean;        { we should stop playing if possible }
    FCloseIt       : Boolean;        { we should close device if possible }
    FStopping      : Boolean;        { we actually stop the device        }
    FClosing       : Boolean;        { we actually close the device       }
    FReseting      : Boolean;        { we actually resting the device     }
    FPosted        : Boolean;
    FBytesRecorded : Longint;        { total bytes we have recorded       }
    FLastPosition  : Cardinal;       { the last playback position         }
    FWrapArrounds  : Cardinal;       { number of position wrap-arrounds   }
    FWrapSize      : Cardinal;       { where has the position wrapped ?   }
    FNumBuffers    : integer;        { number of buffers for queue        }
    FBufferCounter : integer;        { buffer counter for buffers in use  }
    FTimeFormat    : TMMTimeFormats; { the actual time format for Position}
    FWaveFormat    : TWaveFormatEx;  { internal WaveFormatEx              }
    FMode          : TMMMode;        { Mono / Stereo                      }
    FBits          : TMMBits;        { 8 / 16 bits                        }
    FRate          : Longint;        { SampleRate                         }
    FMaxRecTime    : Longint;        { maximal recording time             }
    FMaxRecBytes   : Longint;
    FAllocator     : TMMAllocator;

    {$IFDEF WIN32}
    FThreadError   : Boolean;        { Erro in Thread handler             }
    FInThread      : TMMWaveInThread;{ Input Thread for callback handling }
    DataSection    : TRtlCriticalSection;{ CriticalSection Object         }
    DataSEctionOK  : Boolean;        { CriticalSection prepared           }
    FInEvent       : THandle;        { event object for notify handling   }
    FCloseEvent    : THandle;        { event object to close the device   }
    {$ENDIF}

    { Events }
    FOnError       : TNotifyEvent;   { Error occured                    }
    FOnOpen        : TNotifyEvent;   { Wave Device succ. opened         }
    FOnStart       : TNotifyEvent;   { Wave Device succ. started        }
    FOnPause       : TNotifyEvent;   { Wave Device succ. paused         }
    FOnRestart     : TNotifyEvent;   { Wave Device succ. restarted      }
    FOnStop        : TNotifyEvent;   { Wave Device succ. stopped        }
    FOnClose       : TNotifyEvent;   { Wave Device succ. closed         }

    function  WaveInErrorString(WError: integer): String;
    procedure SetPriority(aValue: TThreadPriority);
    procedure SetMode(aValue: TMMMode);
    procedure SetBits(aValue: TMMBits);
    procedure SetSampleRate(aValue: Longint);
    procedure SetTimeFormat(aValue: TMMTimeFormats);
    procedure SetMaxRecTime(aValue: Longint);
    procedure CalcMaxRecBytes;
    function  GetSamplePosition: Cardinal;
    function  GetInternalPosition: int64;
    function  GetPosition: MM_int64;
    function  GetPositionHigh: Cardinal;
    function  GetPosition64: int64;
    procedure SetWaveParams;
    procedure WaveInHandler(VAR Msg: TMessage);
    procedure AllocWaveHeaders;
    procedure FreeWaveHeaders;
    procedure PrepareWaveHeaders;
    procedure UnPrepareWaveHeaders;
    procedure AddWaveHeader(lpWaveHdr: PWaveHdr);
    procedure ProcessWaveHeader(lpWaveHdr: PWaveHdr);

    {$IFDEF WIN32}
    procedure InitThread;
    procedure DoneThread;
    procedure CloseEvents;
    {$ENDIF}

    procedure InitCritical;
    procedure EnterCritical;
    procedure LeaveCritical;
    procedure DoneCritical;

  protected
    {-- Private Waveform API declarations to be overridden in descendants --}
    waveInGetNumDevs: function: UINT; stdcall;
    waveInGetDevCaps: function(hwin: HWAVEIN; lpCaps: PWaveInCaps; uSize: UINT): MMRESULT; stdcall;
    waveInGetErrorText: function(mmrError: MMRESULT; lpText: PChar; uSize: UINT): MMRESULT; stdcall;
    waveInOpen: function(lphWaveIn: PHWAVEIN; uDeviceID: UINT; lpFormatEx: PWaveFormatEx; dwCallback, dwInstance, dwFlags: DWORD): MMRESULT; stdcall;
    waveInClose: function(hWaveIn: HWAVEIN): MMRESULT; stdcall;
    waveInPrepareHeader: function(hWaveIn: HWAVEIN; lpWaveInHdr: PWaveHdr; uSize: UINT): MMRESULT; stdcall;
    waveInUnprepareHeader: function(hWaveIn: HWAVEIN; lpWaveInHdr: PWaveHdr; uSize: UINT): MMRESULT; stdcall;
    waveInAddBuffer: function(hWaveIn: HWAVEIN; lpWaveInHdr: PWaveHdr; uSize: UINT): MMRESULT; stdcall;
    waveInStart: function(hWaveIn: HWAVEIN): MMRESULT; stdcall;
    waveInStop: function(hWaveIn: HWAVEIN): MMRESULT; stdcall;
    waveInReset: function(hWaveIn: HWAVEIN): MMRESULT; stdcall;
    waveInGetPosition: function(hWaveIn: HWAVEIN; lpInfo: PMMTime; uSize: UINT): MMRESULT; stdcall;
    waveInGetID: function(hWaveIn: HWAVEIN; lpuDeviceID: PUINT): MMRESULT; stdcall;

    { And set up all this stuff! }
    procedure SetupWaveEngine; virtual; abstract;

    procedure SetPWaveFormat(aValue: PWaveFormatEx); override;
    procedure SetBufferSize(aValue: Longint); override;
    function  GetBufferSize: Longint; override;
    procedure SetNumBuffers(aValue: integer); override;
    function  GetNumBuffers: integer; override;
    procedure SetDeviceID(aValue: TMMDeviceID); override;
    function  GetDeviceID: TMMDeviceID; override;
    procedure SetProductName(aValue: string); override;
    function  GetProductName: string; override;
    procedure SetCallBackMode(aValue: TMMCBMode); override;
    function  GetCallBackMode: TMMCBMode; override;

    procedure Opened; override;
    procedure Started; override;
    procedure Paused; override;
    procedure Restarted; override;
    procedure Stopped; override;
    procedure Closed; override;
    procedure BufferReady(lpwh: PWaveHdr); override;
    procedure Error(Msg: string); virtual;

  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    procedure Open; virtual;
    procedure Close; virtual;
    procedure Start; virtual;
    procedure Pause; virtual;
    procedure Restart; virtual;
    procedure Stop; virtual;
    function  QueryDevice(aDeviceID: TMMDeviceID; pwfx: PWaveFormatEx): Boolean;

    {$IFDEF WIN32}
    { maybe you must syncronize anything if UseThread = True ? }
    procedure SynchronizeVCL(VCLProc: TThreadMethod);
    {$ENDIF}

    property Handle: HWaveIn read FHWaveIn;
    property WaveInCaps: TWaveInCaps read FWaveInCaps;
    property Numdevs: integer read FNumdevs;
    property State: TMMWaveInState read FState;
    property DriverVersion: integer read FDriverVersion;
    property BytesRecorded: Longint read FBytesRecorded;
    property Position: MM_int64 read GetPosition;
    property PositionHigh: Cardinal read GetPositionHigh;
    property Position64: int64 read GetPosition64;
    property BufferIndex: integer read FBufferIndex;
    property PWaveFormat;
    {$IFNDEF CBUILDER3}
    property WaveHdrs: TMMWaveInHdrs read FWaveInHdrs;
    {$ENDIf}

  published
    { Events }
    property OnError: TNotifyEvent read FOnError write FOnError;
    property OnOpen: TNotifyEvent read FOnOpen write FOnOpen;
    property OnStart: TNotifyEvent read FOnStart write FOnStart;
    property OnPause: TNotifyEvent read FOnPause write FOnPause;
    property OnRestart: TNotifyEvent read FOnRestart write FOnRestart;
    property OnStop: TNotifyEvent read FOnStop write FOnStop;
    property OnClose: TNotifyEvent read FOnClose write FOnClose;
    property OnBufferReady;

    property Output;
    property BufferSize;
    property CallBackMode;
    property DeviceID;
    property NumBuffers;
    property ProductName;
    property Mode: TMMMode read FMode write SetMode default mMono;
    property BitLength: TMMBits read FBits write SetBits default b8Bit;
    property SampleRate: Longint read FRate write SetSampleRate default 11025;
    property TimeFormat: TMMTimeFormats read FTimeFormat write SetTimeFormat default tfByte;
    property MaxRecordTime: Longint read FMaxRecTime write SetMaxRecTime default -1;
    property Priority: TThreadPriority read FPriority write SetPriority default tpHigher;
  end;

  {-- TMMWaveIn ---------------------------------------------------------------}
  TMMWaveIn = class(TMMCustomWaveIn)
  protected
    procedure SetupWaveEngine; override;
  end;

function WaveInGetDeviceName(DeviceID: TMMDeviceID): String;
function WaveInReady(DeviceID: TMMDeviceID): Boolean;
function DeviceFullDuplex(DeviceID: TMMDeviceID; pwfx: PWaveFormatEx): Boolean;

var
   Devices: TStringList = nil;
   
implementation

uses consts;

const
     MM_WIM_STOP = MM_USER+2;

{$IFNDEF WIN32}
{ Bug fix for Error in Delphi 1.0 MMSystem declaration }
function WaveInClose(hWaveIn: THandle): Word; far; external 'MMSYSTEM' index 505;
{$ENDIF}

procedure WaveInFunc(hWaveIn:HWaveIn;wMsg:UINT;dwInstance,dwParam1,dwParam2:Longint);
export;{$IFDEF WIN32}stdcall;{$ENDIF}forward;

{$IFDEF _MMDEBUG}
{-------------------------------------------------------------------------}
procedure DebugStr(Level: integer; s: String);
begin
   if (s <> ' ') then s := 'WaveIn: '+s;
   DB_WriteStrLn(Level,s);
end;
{$ENDIF}

{-------------------------------------------------------------------------}
function DeviceFullDuplex(DeviceID: TMMDeviceID; pwfx: PWaveFormatEx): Boolean;
var
   InHandle,OutHandle: HWAVEOUT;
   Error: MMRESULT;
   wfx: TWaveFormatEx;

begin
   Result := False;
   if (DeviceID < waveOutGetNumDevs) and (DeviceID >= integer(WAVE_MAPPER)) then
   try
      OutHandle := 0;
      InHandle := 0;
      if (pwfx = nil) then
      begin
         pwfx := @wfx;
         pcmBuildWaveHeader(pwfx, 16, 2, 22050);
      end;
      {$IFDEF WIN32}
      Error := WaveInOpen(@InHandle, DeviceId, MMSystem.PWaveFormatEx(pwfx), 0, 0, CALLBACK_NULL);
      {$ELSE}
      Error := WaveInOpen(@InHandle, DeviceId, Pointer(pwfx), 0, 0, CALLBACK_NULL);
      {$ENDIF}
      if (Error = MMSYSERR_NOERROR) then
      begin
         {$IFDEF WIN32}
         Error := WaveOutOpen(@OutHandle, DeviceID, MMSystem.PWaveFormatEx(pwfx), 0, 0, CALLBACK_NULL);
         {$ELSE}
         Error := WaveOutOpen(@OutHandle, DeviceID, Pointer(pwfx), 0, 0, CALLBACK_NULL);
         {$ENDIF}
         if (Error = MMSYSERR_NOERROR) then Result := True;
      end;
   finally
      if (OutHandle <> 0) then WaveOutClose(OutHandle);
      if (InHandle <> 0) then WaveInClose(InHandle);
   end;
end;

{-------------------------------------------------------------------------}
function WaveInReady(DeviceID: TMMDeviceID): Boolean;
var
   InHandle: HWAVEOUT;
   Error: MMRESULT;
   wfx: TWaveFormatEx;

begin
   Result := False;
   if (DeviceID < waveInGetNumDevs) and (DeviceID >= integer(WAVE_MAPPER)) then
   try
      InHandle := 0;
      pcmBuildWaveHeader(@wfx, 8, 1, 22050);
      {$IFDEF WIN32}
      Error := WaveInOpen(@InHandle, DeviceId, MMSystem.PWaveFormatEx(@wfx), 0, 0, CALLBACK_NULL);
      {$ELSE}
      Error := WaveInOpen(@InHandle, DeviceId, Pointer(@wfx), 0, 0, CALLBACK_NULL);
      {$ENDIF}
      if (Error = MMSYSERR_NOERROR) then
      begin
         Result := True;
      end;
   finally
      if (InHandle <> 0) then WaveInClose(InHandle);
   end;
end;

{-------------------------------------------------------------------------}
function WaveInGetDeviceName(DeviceID: TMMDeviceID): String;
var
   Caps   : TWaveInCaps;

begin
   Result := '';
   if (DeviceID < waveInGetNumDevs) and (DeviceID >= integer(WAVE_MAPPER)) then
   begin
      { Set the name and other WAVEOUTCAPS properties to match the ID }
      if waveInGetDevCaps(DeviceID, @Caps, sizeof(TWaveInCaps)) = 0 then
         Result := StrPas(Caps.szPname);
   end;
end;

{-- TMMCustomWaveIn ------------------------------------------------------------}
constructor TMMCustomWaveIn.Create(AOwner: TComponent);
begin