开通博客赚积分
发布资源赚积分
分类

源码开发语言/平台
当前位置：首页 > 源码/资料 > Delphi控件源码 > 查看源码
MMWavIn.pas
资源名称：qqdelphiprog.rar　[点击查看]
上传用户：hylc_2004
上传日期：2014-01-23
资源大小：46800k
文件大小：61k
源码类别：

Delphi控件源码

开发平台：

Delphi

MMWavIn.pas：源码内容
  1. {========================================================================}
  2. {=                (c) 1995-98 SwiftSoft Ronald Dittrich                 =}
  3. {========================================================================}
  4. {=                          All Rights Reserved                         =}
  5. {========================================================================}
  6. {=  D 01099 Dresden             = Fax.: +49(0)351-8037944               =}
  7. {=  Loewenstr.7a                = info@swiftsoft.de                     =}
  8. {========================================================================}
  9. {=  Actual versions on http://www.swiftsoft.de/index.html               =}
  10. {========================================================================}
  11. {=  This code is for reference purposes only and may not be copied or   =}
  12. {=  distributed in any format electronic or otherwise except one copy   =}
  13. {=  for backup purposes.                                                =}
  14. {=                                                                      =}
  15. {=  No Delphi Component Kit or Component individually or in a collection=}
  16. {=  subclassed or otherwise from the code in this unit, or associated   =}
  17. {=  .pas, .dfm, .dcu, .asm or .obj files may be sold or distributed     =}
  18. {=  without express permission from SwiftSoft.                          =}
  19. {=                                                                      =}
  20. {=  For more licence informations please refer to the associated        =}
  21. {=  HelpFile.                                                           =}
  22. {========================================================================}
  23. {=  $Date: 25.11.98 - 13:23:40 $                                        =}
  24. {========================================================================}
  25. unit MMWavIn;
  27. {$C FIXED PRELOAD PERMANENT}
  29. {$I COMPILER.INC}
  31. {.$DEFINE _MMDEBUG}
  33. interface
  35. uses
  36. {$IFDEF WIN32}
  37.   Windows,
  38. {$ELSE}
  39.   WinTypes,
  40.   WinProcs,
  41. {$ENDIF}
  42.   SysUtils,
  43.   Messages,
  44.   Classes,
  45.   Graphics,
  46.   Controls,
  47.   Forms,
  48.   Dialogs,
  49.   MMSystem,
  50.   MMUtils,
  51.   MMObj,
  52.   MMString,
  53.   MMDSPObj,
  54.   MMDSPMtr,
  55.   MMRegs,
  56.   MMPCMSup,
  57.   MMAlloc,
  58.   MMWaveIO
  59.   {$IFDEF _MMDEBUG}
  60.   ,MMDebug
  61.   {$ENDIF};
  63. {$IFDEF _MMDEBUG}
  64.    {$DEFINE NUMERATE}
  65.    const
  66.         DEBUGLEVEL = 0; { 0,1,2 }
  67. {$ENDIF}
  69. const
  70.   {$IFDEF CBUILDER3} {$EXTERNALSYM MAXERRORLENGTH} {$ENDIF}
  71.   MAXERRORLENGTH   = 255;
  72.   {$IFDEF CBUILDER3} {$EXTERNALSYM MAXINBUFFERS} {$ENDIF}
  73.   MAXINBUFFERS     = 500;
  74.   {$IFDEF CBUILDER3} {$EXTERNALSYM MINBUFFERSIZE} {$ENDIF}
  75.   MINBUFFERSIZE    = 32;
  77. type
  78.   EMMWaveInError   = class(Exception);
  79.   TMMWaveInStates  = (wisClose, wisOpen, wisRecord,wisPause);
  80.   TMMWaveInState   = set of TMMWaveInStates;
  82.   { Pointers to waveIn headers }
  83.   TMMWaveInHdrs    = array[0..MAXINBUFFERS-1] of PWaveHdr;
  85.   TMMCustomWaveIn  = class;
  87.   {$IFDEF WIN32}
  88.   {-- TMMWaveInThread ----------------------------------------------------}
  89.   TMMWaveInThread = class(TMMDSPThread)
  90.   private
  91.      procedure Execute; override;
  92.   end;
  93.   {$ENDIF}
  95.   {-- TMMCustomWaveIn ---------------------------------------------------------}
  96.   TMMCustomWaveIn = class(TMMCustomSoundComponent)
  97.   private
  98.     FHandle        : THandle;        { handle used for callback window    }
  99.     FPriority      : TThreadPriority;{ thread priority                    }
  100.     FDeviceID      : TMMDeviceID;    { WAVEIN device ID                   }
  101.     FHWaveIn       : HWaveIn;        { Handle to input device             }
  102.     FState         : TMMWaveInState; { Current device state               }
  103.     FWaveInHdrs    : TMMWaveInHdrs;  { WaveIn Headers and Buffers         }
  104.     FBufferIndex   : integer;        { the current Header/BufferIndex     }
  105.     FCallbackMode  : TMMCBMode;      { use Window or Callback function    }
  107.     FError         : integer;        { Last WaveIn Error                  }
  108.     FNumdevs       : integer;      { Num. of input devices on system    }
  109.     FWaveInCaps    : TWaveInCaps;    { Stuff from WAVEINCAPS              }
  110.     FProductName   : String;
  111.     FDriverVersion : integer;        { Specifies the driver version       }
  112.                                      { high-order byte is major version   }
  113.                                      { low-order byte is minor version    }
  114.     FInHandler     : integer;        { marks that we in any event handler }
  115.     FStopIt        : Boolean;        { we should stop playing if possible }
  116.     FCloseIt       : Boolean;        { we should close device if possible }
  117.     FStopping      : Boolean;        { we actually stop the device        }
  118.     FClosing       : Boolean;        { we actually close the device       }
  119.     FReseting      : Boolean;        { we actually resting the device     }
  120.     FPosted        : Boolean;
  121.     FBytesRecorded : Longint;        { total bytes we have recorded       }
  122.     FLastPosition  : Cardinal;       { the last playback position         }
  123.     FWrapArrounds  : Cardinal;       { number of position wrap-arrounds   }
  124.     FWrapSize      : Cardinal;       { where has the position wrapped ?   }
  125.     FNumBuffers    : integer;        { number of buffers for queue        }
  126.     FBufferCounter : integer;        { buffer counter for buffers in use  }
  127.     FTimeFormat    : TMMTimeFormats; { the actual time format for Position}
  128.     FWaveFormat    : TWaveFormatEx;  { internal WaveFormatEx              }
  129.     FMode          : TMMMode;        { Mono / Stereo                      }
  130.     FBits          : TMMBits;        { 8 / 16 bits                        }
  131.     FRate          : Longint;        { SampleRate                         }
  132.     FMaxRecTime    : Longint;        { maximal recording time             }
  133.     FMaxRecBytes   : Longint;
  134.     FAllocator     : TMMAllocator;
  136.     {$IFDEF WIN32}
  137.     FThreadError   : Boolean;        { Erro in Thread handler             }
  138.     FInThread      : TMMWaveInThread;{ Input Thread for callback handling }
  139.     DataSection    : TRtlCriticalSection;{ CriticalSection Object         }
  140.     DataSEctionOK  : Boolean;        { CriticalSection prepared           }
  141.     FInEvent       : THandle;        { event object for notify handling   }
  142.     FCloseEvent    : THandle;        { event object to close the device   }
  143.     {$ENDIF}
  145.     { Events }
  146.     FOnError       : TNotifyEvent;   { Error occured                    }
  147.     FOnOpen        : TNotifyEvent;   { Wave Device succ. opened         }
  148.     FOnStart       : TNotifyEvent;   { Wave Device succ. started        }
  149.     FOnPause       : TNotifyEvent;   { Wave Device succ. paused         }
  150.     FOnRestart     : TNotifyEvent;   { Wave Device succ. restarted      }
  151.     FOnStop        : TNotifyEvent;   { Wave Device succ. stopped        }
  152.     FOnClose       : TNotifyEvent;   { Wave Device succ. closed         }
  154.     function  WaveInErrorString(WError: integer): String;
  155.     procedure SetPriority(aValue: TThreadPriority);
  156.     procedure SetMode(aValue: TMMMode);
  157.     procedure SetBits(aValue: TMMBits);
  158.     procedure SetSampleRate(aValue: Longint);
  159.     procedure SetTimeFormat(aValue: TMMTimeFormats);
  160.     procedure SetMaxRecTime(aValue: Longint);
  161.     procedure CalcMaxRecBytes;
  162.     function  GetSamplePosition: Cardinal;
  163.     function  GetInternalPosition: int64;
  164.     function  GetPosition: MM_int64;
  165.     function  GetPositionHigh: Cardinal;
  166.     function  GetPosition64: int64;
  167.     procedure SetWaveParams;
  168.     procedure WaveInHandler(VAR Msg: TMessage);
  169.     procedure AllocWaveHeaders;
  170.     procedure FreeWaveHeaders;
  171.     procedure PrepareWaveHeaders;
  172.     procedure UnPrepareWaveHeaders;
  173.     procedure AddWaveHeader(lpWaveHdr: PWaveHdr);
  174.     procedure ProcessWaveHeader(lpWaveHdr: PWaveHdr);
  176.     {$IFDEF WIN32}
  177.     procedure InitThread;
  178.     procedure DoneThread;
  179.     procedure CloseEvents;
  180.     {$ENDIF}
  182.     procedure InitCritical;
  183.     procedure EnterCritical;
  184.     procedure LeaveCritical;
  185.     procedure DoneCritical;
  187.   protected
  188.     {-- Private Waveform API declarations to be overridden in descendants --}
  189.     waveInGetNumDevs: function: UINT; stdcall;
  190.     waveInGetDevCaps: function(hwin: HWAVEIN; lpCaps: PWaveInCaps; uSize: UINT): MMRESULT; stdcall;
  191.     waveInGetErrorText: function(mmrError: MMRESULT; lpText: PChar; uSize: UINT): MMRESULT; stdcall;
  192.     waveInOpen: function(lphWaveIn: PHWAVEIN; uDeviceID: UINT; lpFormatEx: PWaveFormatEx; dwCallback, dwInstance, dwFlags: DWORD): MMRESULT; stdcall;
  193.     waveInClose: function(hWaveIn: HWAVEIN): MMRESULT; stdcall;
  194.     waveInPrepareHeader: function(hWaveIn: HWAVEIN; lpWaveInHdr: PWaveHdr; uSize: UINT): MMRESULT; stdcall;
  195.     waveInUnprepareHeader: function(hWaveIn: HWAVEIN; lpWaveInHdr: PWaveHdr; uSize: UINT): MMRESULT; stdcall;
  196.     waveInAddBuffer: function(hWaveIn: HWAVEIN; lpWaveInHdr: PWaveHdr; uSize: UINT): MMRESULT; stdcall;
  197.     waveInStart: function(hWaveIn: HWAVEIN): MMRESULT; stdcall;
  198.     waveInStop: function(hWaveIn: HWAVEIN): MMRESULT; stdcall;
  199.     waveInReset: function(hWaveIn: HWAVEIN): MMRESULT; stdcall;
  200.     waveInGetPosition: function(hWaveIn: HWAVEIN; lpInfo: PMMTime; uSize: UINT): MMRESULT; stdcall;
  201.     waveInGetID: function(hWaveIn: HWAVEIN; lpuDeviceID: PUINT): MMRESULT; stdcall;
  203.     { And set up all this stuff! }
  204.     procedure SetupWaveEngine; virtual; abstract;
  206.     procedure SetPWaveFormat(aValue: PWaveFormatEx); override;
  207.     procedure SetBufferSize(aValue: Longint); override;
  208.     function  GetBufferSize: Longint; override;
  209.     procedure SetNumBuffers(aValue: integer); override;
  210.     function  GetNumBuffers: integer; override;
  211.     procedure SetDeviceID(aValue: TMMDeviceID); override;
  212.     function  GetDeviceID: TMMDeviceID; override;
  213.     procedure SetProductName(aValue: string); override;
  214.     function  GetProductName: string; override;
  215.     procedure SetCallBackMode(aValue: TMMCBMode); override;
  216.     function  GetCallBackMode: TMMCBMode; override;
  218.     procedure Opened; override;
  219.     procedure Started; override;
  220.     procedure Paused; override;
  221.     procedure Restarted; override;
  222.     procedure Stopped; override;
  223.     procedure Closed; override;
  224.     procedure BufferReady(lpwh: PWaveHdr); override;
  225.     procedure Error(Msg: string); virtual;
  227.   public
  228.     constructor Create(AOwner: TComponent); override;
  229.     destructor Destroy; override;
  231.     procedure Open; virtual;
  232.     procedure Close; virtual;
  233.     procedure Start; virtual;
  234.     procedure Pause; virtual;
  235.     procedure Restart; virtual;
  236.     procedure Stop; virtual;
  237.     function  QueryDevice(aDeviceID: TMMDeviceID; pwfx: PWaveFormatEx): Boolean;
  239.     {$IFDEF WIN32}
  240.     { maybe you must syncronize anything if UseThread = True ? }
  241.     procedure SynchronizeVCL(VCLProc: TThreadMethod);
  242.     {$ENDIF}
  244.     property Handle: HWaveIn read FHWaveIn;
  245.     property WaveInCaps: TWaveInCaps read FWaveInCaps;
  246.     property Numdevs: integer read FNumdevs;
  247.     property State: TMMWaveInState read FState;
  248.     property DriverVersion: integer read FDriverVersion;
  249.     property BytesRecorded: Longint read FBytesRecorded;
  250.     property Position: MM_int64 read GetPosition;
  251.     property PositionHigh: Cardinal read GetPositionHigh;
  252.     property Position64: int64 read GetPosition64;
  253.     property BufferIndex: integer read FBufferIndex;
  254.     property PWaveFormat;
  255.     {$IFNDEF CBUILDER3}
  256.     property WaveHdrs: TMMWaveInHdrs read FWaveInHdrs;
  257.     {$ENDIf}
  259.   published
  260.     { Events }
  261.     property OnError: TNotifyEvent read FOnError write FOnError;
  262.     property OnOpen: TNotifyEvent read FOnOpen write FOnOpen;
  263.     property OnStart: TNotifyEvent read FOnStart write FOnStart;
  264.     property OnPause: TNotifyEvent read FOnPause write FOnPause;
  265.     property OnRestart: TNotifyEvent read FOnRestart write FOnRestart;
  266.     property OnStop: TNotifyEvent read FOnStop write FOnStop;
  267.     property OnClose: TNotifyEvent read FOnClose write FOnClose;
  268.     property OnBufferReady;
  270.     property Output;
  271.     property BufferSize;
  272.     property CallBackMode;
  273.     property DeviceID;
  274.     property NumBuffers;
  275.     property ProductName;
  276.     property Mode: TMMMode read FMode write SetMode default mMono;
  277.     property BitLength: TMMBits read FBits write SetBits default b8Bit;
  278.     property SampleRate: Longint read FRate write SetSampleRate default 11025;
  279.     property TimeFormat: TMMTimeFormats read FTimeFormat write SetTimeFormat default tfByte;
  280.     property MaxRecordTime: Longint read FMaxRecTime write SetMaxRecTime default -1;
  281.     property Priority: TThreadPriority read FPriority write SetPriority default tpHigher;
  282.   end;
  284.   {-- TMMWaveIn ---------------------------------------------------------------}
  285.   TMMWaveIn = class(TMMCustomWaveIn)
  286.   protected
  287.     procedure SetupWaveEngine; override;
  288.   end;
  290. function WaveInGetDeviceName(DeviceID: TMMDeviceID): String;
  291. function WaveInReady(DeviceID: TMMDeviceID): Boolean;
  292. function DeviceFullDuplex(DeviceID: TMMDeviceID; pwfx: PWaveFormatEx): Boolean;
  294. var
  295.    Devices: TStringList = nil;
  296.    
  297. implementation
  299. uses consts;
  301. const
  302.      MM_WIM_STOP = MM_USER+2;
  304. {$IFNDEF WIN32}
  305. { Bug fix for Error in Delphi 1.0 MMSystem declaration }
  306. function WaveInClose(hWaveIn: THandle): Word; far; external 'MMSYSTEM' index 505;
  307. {$ENDIF}
  309. procedure WaveInFunc(hWaveIn:HWaveIn;wMsg:UINT;dwInstance,dwParam1,dwParam2:Longint);
  310. export;{$IFDEF WIN32}stdcall;{$ENDIF}forward;
  312. {$IFDEF _MMDEBUG}
  313. {-------------------------------------------------------------------------}
  314. procedure DebugStr(Level: integer; s: String);
  315. begin
  316.    if (s <> ' ') then s := 'WaveIn: '+s;
  317.    DB_WriteStrLn(Level,s);
  318. end;
  319. {$ENDIF}
  321. {-------------------------------------------------------------------------}
  322. function DeviceFullDuplex(DeviceID: TMMDeviceID; pwfx: PWaveFormatEx): Boolean;
  323. var
  324.    InHandle,OutHandle: HWAVEOUT;
  325.    Error: MMRESULT;
  326.    wfx: TWaveFormatEx;
  328. begin
  329.    Result := False;
  330.    if (DeviceID < waveOutGetNumDevs) and (DeviceID >= integer(WAVE_MAPPER)) then
  331.    try
  332.       OutHandle := 0;
  333.       InHandle := 0;
  334.       if (pwfx = nil) then
  335.       begin
  336.          pwfx := @wfx;
  337.          pcmBuildWaveHeader(pwfx, 16, 2, 22050);
  338.       end;
  339.       {$IFDEF WIN32}
  340.       Error := WaveInOpen(@InHandle, DeviceId, MMSystem.PWaveFormatEx(pwfx), 0, 0, CALLBACK_NULL);
  341.       {$ELSE}
  342.       Error := WaveInOpen(@InHandle, DeviceId, Pointer(pwfx), 0, 0, CALLBACK_NULL);
  343.       {$ENDIF}
  344.       if (Error = MMSYSERR_NOERROR) then
  345.       begin
  346.          {$IFDEF WIN32}
  347.          Error := WaveOutOpen(@OutHandle, DeviceID, MMSystem.PWaveFormatEx(pwfx), 0, 0, CALLBACK_NULL);
  348.          {$ELSE}
  349.          Error := WaveOutOpen(@OutHandle, DeviceID, Pointer(pwfx), 0, 0, CALLBACK_NULL);
  350.          {$ENDIF}
  351.          if (Error = MMSYSERR_NOERROR) then Result := True;
  352.       end;
  353.    finally
  354.       if (OutHandle <> 0) then WaveOutClose(OutHandle);
  355.       if (InHandle <> 0) then WaveInClose(InHandle);
  356.    end;
  357. end;
  359. {-------------------------------------------------------------------------}
  360. function WaveInReady(DeviceID: TMMDeviceID): Boolean;
  361. var
  362.    InHandle: HWAVEOUT;
  363.    Error: MMRESULT;
  364.    wfx: TWaveFormatEx;
  366. begin
  367.    Result := False;
  368.    if (DeviceID < waveInGetNumDevs) and (DeviceID >= integer(WAVE_MAPPER)) then
  369.    try
  370.       InHandle := 0;
  371.       pcmBuildWaveHeader(@wfx, 8, 1, 22050);
  372.       {$IFDEF WIN32}
  373.       Error := WaveInOpen(@InHandle, DeviceId, MMSystem.PWaveFormatEx(@wfx), 0, 0, CALLBACK_NULL);
  374.       {$ELSE}
  375.       Error := WaveInOpen(@InHandle, DeviceId, Pointer(@wfx), 0, 0, CALLBACK_NULL);
  376.       {$ENDIF}
  377.       if (Error = MMSYSERR_NOERROR) then
  378.       begin
  379.          Result := True;
  380.       end;
  381.    finally
  382.       if (InHandle <> 0) then WaveInClose(InHandle);
  383.    end;
  384. end;
  386. {-------------------------------------------------------------------------}
  387. function WaveInGetDeviceName(DeviceID: TMMDeviceID): String;
  388. var
  389.    Caps   : TWaveInCaps;
  391. begin
  392.    Result := '';
  393.    if (DeviceID < waveInGetNumDevs) and (DeviceID >= integer(WAVE_MAPPER)) then
  394.    begin
  395.       { Set the name and other WAVEOUTCAPS properties to match the ID }
  396.       if waveInGetDevCaps(DeviceID, @Caps, sizeof(TWaveInCaps)) = 0 then
  397.          Result := StrPas(Caps.szPname);
  398.    end;
  399. end;
  401. {-- TMMCustomWaveIn ------------------------------------------------------------}
  402. constructor TMMCustomWaveIn.Create(AOwner: TComponent);
  403. begin
  404.    inherited Create(AOwner);
  406.    SetupWaveEngine;
  408.    { Set defaults }
  409.    FHWaveIn       := 0;
  410.    FState         := [wisClose];
  411.    FError         := 0;
  412.    FNumBuffers    := 10;
  413.    FMode          := mMono;
  414.    FBits          := b8Bit;
  415.    FRate          := 11025;
  416.    FProductName   := '';
  417.    FDriverVersion := 0;
  418.    FBytesRecorded := 0;
  419.    FTimeFormat    := tfByte;
  420.    FCallBackMode  := cmWindow;
  421.    FStopping      := False;
  422.    FPosted        := False;
  423.    FClosing       := False;
  424.    FReseting      := False;
  425.    FMaxRecTime    := -1;
  426.    FMaxRecBytes   := MaxLongint;
  427.    FPriority      := tpHigher;
  429.    FAllocator     := TMMAllocator.Create;
  431.    FBufferIndex := 0;
  433.    { clear all pointers to Nil }
  434.    FillChar(FWaveInHdrs, sizeOf(TMMWaveInHdrs), 0);
  436.    FNumDevs := waveInGetNumDevs;
  438.    SetWaveParams;
  440.    SetDeviceID(0);
  442.    {$IFDEF WIN32}
  443.    DataSectionOK := False;
  444.    {$ENDIF}
  446.    { Create the window for callback notification }
  447.    if not (csDesigning in ComponentState) then
  448.            FHandle := AllocateHwnd(WaveInHandler);
  450.    ErrorCode := ComponentRegistered(InitCode, Self, ClassName);
  451.    if (ErrorCode <> 0) then RegisterFailed(InitCode, Self , ClassName);
  452. end;
  454. {-- TMMCustomWaveIn ------------------------------------------------------------}
  455. destructor TMMCustomWaveIn.Destroy;
  456. begin
  457.    { Close the device if it's open }
  458.    if (FHWaveIn <> 0) then Close;
  460.    { Destroy the window for callback notification }
  461.    if (FHandle <> 0) then DeallocateHwnd(FHandle);
  463.    if (FAllocator <> nil) then FAllocator.Free;
  465.    inherited Destroy;
  466. end;
  468. {-- TMMCustomWaveIn ------------------------------------------------------------}
  469. procedure TMMCustomWaveIn.Error(Msg: string);
  470. begin
  471.    if assigned(FOnError) then FOnError(Self);
  473.    raise EMMWaveInError.Create(Msg);
  474. end;
  476. {-- TMMCustomWaveIn ------------------------------------------------------------}
  477. { Allocate memory for the WaveIn header and buffers }
  478. procedure TMMCustomWaveIn.AllocWaveHeaders;
  479. Var
  480.    i: integer;
  481.    lpwh: PWaveHdr;
  483. begin
  484.    if (BufferSize > 0) then
  485.    begin
  486.       for i := 0 to FNumBuffers-1 do
  487.       begin
  488.          if (FWaveInHdrs[i] = Nil) then
  489.          begin
  490.               { set up a wave header for recording and lock     }
  491.               lpwh := FAllocator.AllocBuffer(GPTR, SizeOf(TMMWaveHdr) + BufferSize);
  492.               if lpwh = NIL then
  493.                  Error(LoadResStr(IDS_HEADERMEMERROR));
  495.               { Data occurs directly after the header }
  496.               lpwh^.lpData         := PChar(lpwh) + sizeOf(TMMWaveHdr);
  497.               lpwh^.dwBufferLength := BufferSize;
  498.               lpwh^.dwBytesRecorded:= 0;
  499.               lpwh^.dwFlags        := 0;
  500.               lpwh^.dwLoops        := 0;
  501.               lpwh^.dwUser         := 0;
  502.               lpwh^.lpNext         := nil;
  503.               FWaveInHdrs[i]       := lpwh;
  504.          end;
  505.       end;
  506.    end;
  507. end;
  509. {-- TMMCustomWaveIn ------------------------------------------------------------}
  510. procedure TMMCustomWaveIn.FreeWaveHeaders;
  511. Var
  512.    i: integer;
  514. begin
  515.    for i := 0 to FNumBuffers-1 do
  516.    begin
  517.       { unlock and free memory for WaveInHdr }
  518.       if FWaveInHdrs[i] <> NIL then
  519.       begin
  520.          FAllocator.FreeBuffer(Pointer(FWaveInHdrs[i]));
  521.          FWaveInHdrs[i] := Nil;
  522.       end;
  523.    end;
  524. end;
  526. {-- TMMCustomWaveIn ------------------------------------------------------------}
  527. function TMMCustomWaveIn.WaveInErrorString(WError: integer): String;
  528. Var
  529.    errorDesc: PChar;
  531. begin
  532.    { convert the numeric return code from an MMSYSTEM function to a string }
  533.    errorDesc := Nil;
  534.    try
  535.       errorDesc := StrAlloc(MAXERRORLENGTH);
  536.       if waveInGetErrorText(WError, errorDesc, MAXERRORLENGTH) = 0 then
  537.          Result := StrPas(errorDesc)
  538.       else
  539.          Result := LoadResStr(IDS_ERROROUTOFRANGE);
  541.    finally
  542.       StrDispose(errorDesc);
  543.    end;
  544. end;
  546. {-- TMMCustomWaveIn ------------------------------------------------------------}
  547. Procedure TMMCustomWaveIn.SetDeviceID(aValue: TMMDeviceID);
  548. begin
  549.    if (wisOpen in FState) then
  550.       Error(LoadResStr(IDS_PROPERTYOPEN));
  552.    FProductName := LoadResStr(IDS_WINODEVICE);
  553.    FDriverVersion := 0;
  555.    if (FNumDevs > 0) and (aValue >= MapperId) and (aValue < FNumDevs) then
  556.    begin
  557.       { Set the name and other WAVEINCAPS properties to match the ID }
  558.       FError := waveInGetDevCaps(aValue, @FWaveInCaps, sizeof(TWaveInCaps));
  559.       if FError = 0 then
  560.       with FWaveInCaps do
  561.       begin
  562.          FProductName := StrPas(szPname);
  563.          FDriverVersion := vDriverVersion;
  564.       end
  565.    end;
  567.    { set the new device }
  568.    FDeviceID := aValue;
  569.    if (aValue < MapperId) or (aValue >= FNumDevs) then
  570.        FDeviceID := InvalidID;
  572.    {$IFDEF WIN32}
  573.    {$IFDEF TRIAL}
  574.    {$DEFINE _HACK1}
  575.    {$I MMHACK.INC}
  576.    {$ENDIF}
  577.    {$ENDIF}
  578. end;
  580. {-- TMMCustomWaveIn ------------------------------------------------------------}
  581. function TMMCustomWaveIn.GetDeviceID: TMMDeviceID;
  582. begin
  583.    Result := FDeviceID;
  584. end;
  586. {-- TMMCustomWaveIn ------------------------------------------------------------}
  587. procedure TMMCustomWaveIn.SetProductName(aValue: String);
  588. begin
  589.    { dummy }
  590. end;
  592. {-- TMMCustomWaveIn ------------------------------------------------------------}
  593. function TMMCustomWaveIn.GetProductName: String;
  594. begin
  595.    Result := FProductName;
  596. end;
  598. {-- TMMCustomWaveIn ------------------------------------------------------------}
  599. function TMMCustomWaveIn.QueryDevice(aDeviceID: TMMDeviceID; pwfx: PWaveFormatEx): Boolean;
  600. Var
  601.    aRate: Word;
  602.    aMode: Word;
  603.    aBits: Word;
  604.    aWaveInCaps: TWaveInCaps;
  605.    aHandle: HWaveIn;
  607. begin
  608.    if (aDeviceID >= MapperId) and (aDeviceID < FNumDevs) and (pwfx <> nil) then
  609.    begin
  610.       { query the Wave input device. }
  611.       Result := WaveInOpen(@aHandle,
  612.                            aDeviceId,
  613.                            Pointer(pwfx),
  614.                            0, 0,
  615.                            WAVE_FORMAT_QUERY) = 0;
  617.       if Result and (pwfx^.wFormatTag = WAVE_FORMAT_PCM) then
  618.       begin
  619.          Result := waveInGetDevCaps(aDeviceID,
  620.                                     @aWaveInCaps,
  621.                                     sizeof(TWaveInCaps)) = 0;
  622.          if Result then
  623.          with aWaveInCaps do
  624.          begin
  625.              aRate := pwfx^.nSamplesPerSec;
  626.              aMode := pwfx^.nChannels;
  627.              aBits := pwfx^.wBitsPerSample;
  628.              case aRate of
  629.              8000..11025: case aMode of
  630.                              1: case aBits of
  631.                                    8: Result := (dwFormats AND Wave_Format_1M08 <> 0);
  632.                                   16: Result := (dwFormats AND Wave_Format_1M16 <> 0);
  633.                                 end;
  634.                              2: case aBits of
  635.                                    8: Result := (dwFormats AND Wave_Format_1S08 <> 0);
  636.                                   16: Result := (dwFormats AND Wave_Format_1S16 <> 0);
  637.                                 end;
  638.                           end;
  639.             11026..22050: case aMode of
  640.                              1: case aBits of
  641.                                    8: Result := (dwFormats AND Wave_Format_2M08 <> 0);
  642.                                   16: Result := (dwFormats AND Wave_Format_2M16 <> 0);
  643.                                 end;
  644.                              2: case aBits of
  645.                                    8: Result := (dwFormats AND Wave_Format_2S08 <> 0);
  646.                                   16: Result := (dwFormats AND Wave_Format_2S16 <> 0);
  647.                                 end;
  648.                           end;
  649.             22051..48000: case aMode of
  650.                              1: case aBits of
  651.                                    8: Result := (dwFormats AND Wave_Format_4M08 <> 0);
  652.                                   16: Result := (dwFormats AND Wave_Format_4M16 <> 0);
  653.                                 end;
  654.                              2: case aBits of
  655.                                    8: Result := (dwFormats AND Wave_Format_4S08 <> 0);
  656.                                   16: Result := (dwFormats AND Wave_Format_4S16 <> 0);
  657.                                 end;
  658.                           end;
  659.              end;
  660.          end;
  661.       end;
  662.    end
  663.    else Result := False;
  664.    {$IFDEF WIN32}
  665.    {$IFDEF TRIAL}
  666.    {$DEFINE _HACK2}
  667.    {$I MMHACK.INC}
  668.    {$ENDIF}
  669.    {$ENDIF}
  670. end;
  672. {-- TMMCustomWaveIn -----------------------------------------------------------}
  673. procedure TMMCustomWaveIn.SetTimeFormat(aValue: TMMTimeFormats);
  674. begin
  675.    if (aValue <> FTimeFormat) then
  676.    begin
  677.       FTimeFormat := aValue;
  679.       if (FMaxRecTime >= 0) then
  680.       begin
  681.          case FTimeFormat of
  682.              tfMillisecond: FMaxRecTime := wioBytesToTime(PWaveFormat,FMaxRecBytes);
  683.              tfSample     : FMaxRecTime := wioBytesToSamples(PWaveFormat,FMaxRecBytes);
  684.            else FMaxRecTime:= FMaxRecBytes;
  685.          end;
  686.       end;
  687.    end;
  688. end;
  690. {-- TMMCustomWaveIn -----------------------------------------------------------}
  691. procedure TMMCustomWaveIn.SetMaxRecTime(aValue: Longint);
  692. begin
  693.    if (aValue <> FMaxRecTime) then
  694.    begin
  695.       FMaxRecTime := aValue;
  696.       CalcMaxRecBytes;
  697.    end;
  698. end;
  700. {-- TMMCustomWaveIn -----------------------------------------------------------}
  701. procedure TMMCustomWaveIn.CalcMaxRecBytes;
  702. begin
  703.    if (FMaxRecTime >= 0) and (PWaveFormat <> nil) then
  704.    begin
  705.       try
  706.          case FTimeFormat of
  707.             tfMillisecond: FMaxRecBytes := wioTimeToBytes(PWaveFormat,FMaxRecTime);
  708.             tfSample     : FMaxRecBytes := wioSamplesToBytes(PWaveFormat,FMaxRecTime);
  709.             else FMaxRecBytes := FMaxRecTime;
  710.          end;
  711.       except
  712.          FMaxRecBytes := MaxLongint;
  713.       end;
  714.    end
  715.    else FMaxRecBytes := MaxLongint;
  716.    FMaxRecBytes := FMaxRecBytes-(FMaxRecBytes mod PWaveFormat^.nBlockAlign);
  717. end;
  719. {-- TMMCustomWaveIn -----------------------------------------------------------}
  720. procedure TMMCustomWaveIn.SetPriority(aValue: TThreadPriority);
  721. begin
  722.    FPriority := aValue;
  723.    if (FInThread <> nil) then
  724.        FInThread.Priority := FPriority;
  725. end;
  727. {-- TMMCustomWaveIn -----------------------------------------------------------}
  728. function TMMCustomWaveIn.GetSamplePosition: Cardinal;
  729. Var
  730.    MMTime: TMMTime;
  732. begin
  733.    Result := 0;
  734.    if (wisOpen in FState) and (PWaveFormat <> Nil) and not FClosing then
  735.    begin
  736.       MMTime.wType := Time_Samples;
  737.       FError := WaveInGetPosition(FHWaveIn, @MMTime, SizeOf(TMMTime));
  738.       if (FError <> 0) or (MMTime.wType <> Time_Samples) then
  739.       begin
  740.          MMTime.wType := Time_Bytes;
  741.          FError := WaveInGetPosition(FHWaveIn, @MMTime, SizeOf(TMMTime));
  742.          if (FError <> 0) then
  743.              Error('WaveInGetPosition:'#10#13+WaveInErrorString(FError));
  745.          MMTime.Sample := wioBytesToSamples(PWaveFormat,MMTime.cb);
  746.       end;
  747.       Result := MMTime.Sample;
  748.    end;
  749. end;
  751. {-- TMMCustomWaveIn -----------------------------------------------------------}
  752. function TMMCustomWaveIn.GetInternalPosition: Int64;
  753. var
  754.    Samples,Pos: int64;
  755.    S: Cardinal;
  756.    WrapSize: int64;
  757. begin
  758.    Result := 0;
  759.    if (wisOpen in FState) and (PWaveFormat <> Nil) and not FCloseIt then
  760.    begin
  761.       S := GetSamplePosition;
  762.       {$IFDEF WIN32}
  763.       asm
  764.          mov   eax, S
  765.          mov   dword ptr Pos[0], eax
  766.          xor   eax, eax
  767.          mov   dword ptr Pos[4], eax
  769.          mov   eax, Self
  770.          mov   eax, TMMWaveIn(eax).FWrapSize
  771.          mov   dword ptr WrapSize[0], eax
  772.          xor   eax, eax
  773.          mov   dword ptr WrapSize[4], eax
  774.       end;
  776.       Samples := (FWrapArrounds*WrapSize)+Pos;
  777.       {$ELSE}
  778.       Samples := S;
  779.       {$ENDIF}
  781.       case FTimeFormat of
  782.            tfMilliSecond: Result := wioSamplesToTime64(PWaveFormat,Samples);
  783.            tfByte       : Result := wioSamplesToBytes64(PWaveFormat,Samples);
  784.            tfSample     : Result := Samples;
  785.       end;
  787.       if (FMaxRecTime > 0) and (Result >= FMaxRecTime) then
  788.           Result := FMaxRecTime;
  789.    end;
  790. end;
  792. {-- TMMCustomWaveIn -----------------------------------------------------------}
  793. function TMMCustomWaveIn.GetPosition: MM_int64;
  794. {$IFNDEF DELPHI4}
  795. var
  796.    Temp: TLargeInteger;
  797. {$ENDIF}
  798. begin
  799.    {$IFDEF DELPHI4}
  800.    Result := GetInternalPosition;
  801.    {$ELSE}
  802.    Temp.QuadPart := GetInternalPosition;
  803.    Result := Temp.LowPart;
  804.    {$ENDIF}
  805. end;
  807. {-- TMMCustomWaveIn -----------------------------------------------------------}
  808. function TMMCustomWaveIn.GetPositionHigh: Cardinal;
  809. {$IFNDEF DELPHI4}
  810. var
  811.    Temp: TLargeInteger;
  812. {$ENDIF}
  813. begin
  814.    {$IFDEF DELPHI4}
  815.    Result := (GetInternalPosition shr 32);
  816.    {$ELSE}
  817.    Temp.QuadPart := GetInternalPosition;
  818.    Result := Temp.HighPart;
  819.    {$ENDIF}
  820. end;
  822. {-- TMMCustomWaveIn -----------------------------------------------------------}
  823. function TMMCustomWaveIn.GetPosition64: int64;
  824. begin
  825.    Result := GetInternalPosition;
  826. end;
  828. {-- TMMCustomWaveIn ------------------------------------------------------------}
  829. Procedure TMMCustomWaveIn.SetCallBackMode(aValue: TMMCBMode);
  830. begin
  831.    if (wisOpen in FState) then
  832.        Error(LoadResStr(IDS_PROPERTYOPEN));
  834.    if (aValue <> FCallBackMode) then
  835.    begin
  836.       if (aValue = cmCallBack) then
  837.       begin
  838.          {$IFDEF WIN32}
  839.          if not _Win95_ then
  840.          {$ENDIF}
  841.          begin
  842.             Application.MessageBox('"CallBacks" are called at interrupt time !'#10#13+
  843.                                    'This is currently only supported under Windows 95',
  844.                                    'TMMWaveIn', MB_OK);
  845.             exit;
  846.          end;
  847.       end;
  848.       FCallBackMode := aValue;
  849.    end;
  850.    {$IFDEF WIN32}
  851.    {$IFDEF TRIAL}
  852.    {$DEFINE _HACK3}
  853.    {$I MMHACK.INC}
  854.    {$ENDIF}
  855.    {$ENDIF}
  856. end;
  858. {-- TMMCustomWaveIn ------------------------------------------------------------}
  859. function TMMCustomWaveIn.GetCallBackMode: TMMCBMode;
  860. begin
  861.    Result := FCallbackMode;
  862. end;
  864. {-- TMMCustomWaveIn ------------------------------------------------------------}
  865. Procedure TMMCustomWaveIn.SetPWaveFormat(aValue: PWaveFormatEx);
  866. begin
  867.    { stop and close the device }
  868.    Close;
  869.    if (aValue <> nil) then
  870.    begin
  871.       if pcmIsValidFormat(aValue) then
  872.       begin
  873.          SampleRate := aValue^.nSamplesPerSec;
  874.          BitLength := TMMBits(aValue^.wBitsPerSample div 8 - 1);
  875.          Mode := TMMMode(aValue^.nChannels-1);
  876.       end;
  877.    end;
  878.    inherited SetPWaveFormat(aValue);
  879. end;
  881. {-- TMMCustomWaveIn ------------------------------------------------------------}
  882. procedure TMMCustomWaveIn.SetWaveParams;
  883. begin
  884.    pcmBuildWaveHeader(@FWaveFormat,(Ord(FBits)+1)*8,Ord(FMode)+1,FRate);
  885.    PWaveFormat := @FWaveFormat;
  886. end;
  888. {-- TMMCustomWaveIn ------------------------------------------------------------}
  889. Procedure TMMCustomWaveIn.SetMode(aValue: TMMMode);
  890. begin
  891.    if (FMode <> aValue) and (aValue in [mMono,mStereo]) then
  892.    begin
  893.       if (wisOpen in FState) then
  894.           Error(LoadResStr(IDS_PROPERTYOPEN));
  896.       FMode := aValue;
  897.       SetWaveParams;
  898.    end;
  899. end;
  901. {-- TMMCustomWaveIn ------------------------------------------------------------}
  902. Procedure TMMCustomWaveIn.SetSampleRate(aValue: Longint);
  903. begin
  904.    if (FRate <> aValue) then
  905.    begin
  906.       if (wisOpen in FState) then
  907.          Error(LoadResStr(IDS_PROPERTYOPEN));
  909.       FRate := MinMax(aValue,8000,100000);
  910.       SetWaveParams;
  911.    end;
  912. end;
  914. {-- TMMCustomWaveIn ------------------------------------------------------------}
  915. Procedure TMMCustomWaveIn.SetBits(aValue: TMMBits);
  916. begin
  917.    if (FBits <> aValue) then
  918.    begin
  919.       if (wisOpen in FState) then
  920.          Error(LoadResStr(IDS_PROPERTYOPEN));
  922.       FBits := aValue;
  923.       SetWaveParams;
  924.    end;
  925. end;
  927. {-- TMMCustomWaveIn ------------------------------------------------------------}
  928. Procedure TMMCustomWaveIn.SetNumBuffers(aValue: integer);
  929. begin
  930.    if (aValue <> FNumBuffers) AND (aValue > 1) then
  931.    begin
  932.       if (wisOpen in FState) then
  933.           Error(LoadResStr(IDS_PROPERTYOPEN));
  935.       FNumBuffers := Min(aValue,MAXINBUFFERS);
  936.    end;
  937.    {$IFDEF WIN32}
  938.    {$IFDEF TRIAL}
  939.    {$DEFINE _HACK1}
  940.    {$I MMHACK.INC}
  941.    {$ENDIF}
  942.    {$ENDIF}
  943. end;
  945. {-- TMMCustomWaveIn ------------------------------------------------------------}
  946. function TMMCustomWaveIn.GetNumBuffers: integer;
  947. begin
  948.    Result := FNumBuffers;
  949. end;
  951. {-- TMMCustomWaveIn ------------------------------------------------------------}
  952. Procedure TMMCustomWaveIn.SetBufferSize(aValue: Longint);
  953. begin
  954.    if (aValue <> inherited GetBufferSize) then
  955.    begin
  956.       if (wisOpen in FState) then
  957.           Error(LoadResStr(IDS_PROPERTYOPEN));
  959.       if assigned(FAllocator) then
  960.          FAllocator.Discard;
  962.       inherited SetBufferSize(Max(aValue,MINBUFFERSIZE));
  963.    end;
  964. end;
  966. {-- TMMCustomWaveIn ------------------------------------------------------------}
  967. function TMMCustomWaveIn.GetBufferSize: Longint;
  968. begin
  969.    Result := inherited GetBufferSize;
  970. end;
  972. {-- TMMCustomWaveIn ------------------------------------------------------------}
  973. Procedure TMMCustomWaveIn.PrepareWaveHeaders;
  974. Var
  975.    i: integer;
  977. begin
  978.    { Prepare waveform headers for recording }
  979.    for i := 0 to FNumBuffers-1 do
  980.    begin
  981.       if FWaveInHdrs[i] <> Nil then
  982.       begin
  983.          FError := waveInPrepareHeader(FHWaveIn,
  984.                                        FWaveInHdrs[i],
  985.                                        sizeOf(TWaveHdr));
  986.          if FError <> 0 then
  987.             Error('WaveInPrepareHeader:'#10#13+WaveInErrorString(FError));
  988.       end;
  989.    end;
  990. end;
  992. {-- TMMCustomWaveIn ------------------------------------------------------------}
  993. Procedure TMMCustomWaveIn.UnPrepareWaveHeaders;
  994. Var
  995.    i: integer;
  996.    TimeOut: Longint;
  998. begin
  999.    {$IFDEF _MMDEBUG}
  1000.    DebugStr(1,' ');
  1001.    {$ENDIF}
  1003.    for i := 0 to FNumBuffers-1 do
  1004.    begin
  1005.       if (FWaveInHdrs[i] <> Nil) then
  1006.       begin
  1007.          TimeOut := 65000;
  1008.          { wait until the buffer is marked as done }
  1009.          repeat
  1010.              dec(TimeOut);
  1011.          until (FWaveInHdrs[i]^.dwFlags and WHDR_DONE = WHDR_DONE) or (TimeOut = 0);
  1013.          { mark buffer as done }
  1014.          if (TimeOut = 0) then FWaveInHdrs[i]^.dwFlags := WHDR_DONE;
  1016.          { unprepare buffer }
  1017.          FError := WaveInUnprepareHeader(FHWaveIn,
  1018.                                          FWaveInHdrs[i],
  1019.                                          sizeOf(TWAVEHDR));
  1020.          if FError <> 0 then
  1021.             Error('WaveInUnprepareHeader:'#10#13+WaveInErrorString(FError));
  1023.          {$IFDEF _MMDEBUG}
  1024.          DebugStr(1,'UnprepareHeader '+IntToStr(i));
  1025.          {$ENDIF}
  1026.       end;
  1027.    end;
  1029.    {$IFDEF _MMDEBUG}
  1030.    DebugStr(1,' ');
  1031.    {$ENDIF}
  1032. end;
  1034. {-- TMMCustomWaveIn ------------------------------------------------------------}
  1035. Procedure TMMCustomWaveIn.AddWaveHeader(lpWaveHdr: PWaveHdr);
  1036. begin
  1037.    { reset flags field (remove WHDR_DONE attribute) }
  1038.    lpWaveHdr^.dwFlags := lpWaveHdr^.dwFlags and not WHDR_DONE or WHDR_PREPARED;
  1040.    { queue the buffer for input... }
  1041.    FError := WaveInAddBuffer(FHWaveIn,
  1042.                              lpWaveHdr,
  1043.                              sizeof(TWAVEHDR));
  1044.    if FError <> 0 then
  1045.       Error('WaveInAddBuffer:'#10#13+WaveInErrorString(FError));
  1047.    inc(FBufferCounter);
  1049.    {$IFDEF _MMDEBUG}
  1050.    DebugStr(2,'Wave-Header '+IntToStr(lpWaveHdr^.dwUser)+' queued');
  1051.    {$ENDIF}
  1052. end;
  1054. {$IFDEF WIN32}
  1055. {-- TMMCustomWaveIn ------------------------------------------------------------}
  1056. procedure TMMCustomWaveIn.SynchronizeVCL(VCLProc: TThreadMethod);
  1057. begin
  1058.    if (FCallBackMode = cmThread) and (FInEvent <> 0) then
  1059.    begin
  1060.       FInThread.Synchronize(VCLProc);
  1061.    end
  1062.    else VCLProc;
  1063. end;
  1065. {-- TMMCustomWaveIn ------------------------------------------------------------}
  1066. procedure TMMCustomWaveIn.InitThread;
  1067. begin
  1068.    if (FCallBackMode = cmThread) then
  1069.    begin
  1070.       EnterCritical;
  1071.       try
  1072.          FThreadError := False;
  1074.          { create event objects }
  1075.          FInEvent   := CreateEvent(nil, False, False, nil);
  1076.          FCloseEvent := CreateEvent(nil, False, False, nil);
  1078.          { create the output thread }
  1079.          FInThread := TMMWaveInThread.CreateSuspended(Self);
  1080.          if (FInThread = nil) then
  1081.              Error('WaveIn:'#10#13+LoadResStr(IDS_THREADERROR));
  1083.          FInThread.FreeOnTerminate := True;
  1084.          FInThread.Resume;
  1086.          { Wait for it to start... }
  1087.          if WaitForSingleObject(FInEvent, 5000) <> WAIT_OBJECT_0 then
  1088.             Error('WaveIn:'#10#13+LoadResStr(IDS_THREADERROR));
  1090.          {$IFDEF _MMDEBUG}
  1091.          DebugStr(0,'Thread Started');
  1092.          {$ENDIF}
  1094.       finally
  1095.         LeaveCritical;
  1096.       end;
  1097.    end;
  1098. end;
  1100. {-- TMMCustomWaveIn ------------------------------------------------------------}
  1101. procedure TMMCustomWaveIn.DoneThread;
  1102. begin
  1103.    if (FCallBackMode = cmThread) and not FThreadError then
  1104.    begin
  1105.       { Force the output thread to close... }
  1106.       SetEvent(FCloseEvent);
  1108.       { ...and wait for it to die }
  1109.       WaitForSingleObject(FInEvent, 5000);
  1111.       { close all events and remove critical section }
  1112.       CloseEvents;
  1114.       {$IFDEF _MMDEBUG}
  1115.       DebugStr(0,'Thread Terminated');
  1116.       {$ENDIF}
  1117.    end;
  1118. end;
  1120. {-- TMMCustomWaveIn ------------------------------------------------------------}
  1121. procedure TMMCustomWaveIn.CloseEvents;
  1122. begin
  1123.    { release events }
  1124.    CloseHandle(FInEvent);
  1125.    CloseHandle(FCloseEvent);
  1127.    { Free the critical section }
  1128.    DoneCritical;
  1129. end;
  1130. {$ENDIF}
  1132. {-- TMMCustomWaveIn ------------------------------------------------------------}
  1133. procedure TMMCustomWaveIn.InitCritical;
  1134. begin
  1135.    {$IFDEF WIN32}
  1136.    if (FCallBackMode <> cmWindow) then
  1137.    begin
  1138.       { create critical section object }
  1139.       FillChar(DataSection, SizeOf(DataSection), 0);
  1140.       InitializeCriticalSection(DataSection);
  1141.       DataSEctionOK := True;
  1142.    end;
  1143.    {$ENDIF}
  1144. end;
  1146. {-- TMMCustomWaveIn ------------------------------------------------------------}
  1147. procedure TMMCustomWaveIn.EnterCritical;
  1148. begin
  1149.    {$IFDEF WIN32}
  1150.    if (FCallBackMode <> cmWindow) and DataSectionOK then
  1151.       EnterCriticalSection(DataSection);
  1152.    {$ENDIF}
  1153. end;
  1155. {-- TMMCustomWaveIn ------------------------------------------------------------}
  1156. procedure TMMCustomWaveIn.LeaveCritical;
  1157. begin
  1158.    {$IFDEF WIN32}
  1159.    if (FCallBackMode <> cmWindow) and DataSectionOK then
  1160.       LeaveCriticalSection(DataSection);
  1161.    {$ENDIF}
  1162. end;
  1164. {-- TMMCustomWaveIn ------------------------------------------------------------}
  1165. procedure TMMCustomWaveIn.DoneCritical;
  1166. begin
  1167.    {$IFDEF WIN32}
  1168.    if (FCallBackMode <> cmWindow) and DataSectionOK then
  1169.    begin
  1170.       DataSectionOK := False;
  1171.       DeleteCriticalSection(DataSection);
  1172.    end;
  1173.    {$ENDIF}
  1174. end;
  1176. {-- TMMCustomWaveIn ------------------------------------------------------------}
  1177. Procedure TMMCustomWaveIn.Open;
  1178. var
  1179.    TimeOut: integer;
  1180.    aState: TMMWaveInState;
  1181. begin
  1182.    if (FNumDevs = 0) then
  1183.       Error(LoadResStr(IDS_WINODEVICE));
  1185.    if (FDeviceID = InvalidId) then
  1186.       Error(LoadResStr(IDS_INVALIDDEVICEID));
  1188.    if (PWaveFormat = nil) then
  1189.       Error(LoadResStr(IDS_NOFORMAT));
  1191.    if (wisOpen in FState) then Close;
  1193.    if (Not(wisOpen in FState)) and not FClosing then
  1194.    begin
  1195.       TimeOut := 100;
  1196.       FClosing := False;
  1197.       FReseting := False;
  1198.       FStopping := False;
  1199.       FPosted := False;
  1200.       try
  1201.          if not QueryDevice(FDeviceID, PWaveFormat) then
  1202.             Error('WaveInOpen:'#10#13+LoadResStr(IDS_CANTRECORD));
  1204.          { Create the window for callback notification }
  1205.          if (FHandle = 0) then FHandle := AllocateHwnd(WaveInHandler);
  1207.          FHWaveIn := 0;
  1208.          FCloseIt := False;
  1210.          {$IFDEF _MMDEBUG}
  1211.          DebugStr(0,'Try to open device...');
  1212.          {$ENDIF}
  1214.          { some fullduplex drivers require that WaveIn is opened before WaveOut  }
  1215.          { so we open the WaveIn device first and then open all other components }
  1217.          { create critical section object }
  1218.          InitCritical;
  1220.          {$IFDEF WIN32}
  1221.          if (FCallBackMode = cmThread) then InitThread;
  1222.          {$ENDIF}
  1224.          { now open Wave input device. }
  1225.          if _Win9x_ or _WinNT4_ then
  1226.          begin
  1227.             FError := WaveInOpen(@FHWaveIn,
  1228.                                  FDeviceId,
  1229.                                  Pointer(PWaveFormat),
  1230.                                  Longint(@WaveInFunc),
  1231.                                  Longint(Self),
  1232.                                  CALLBACK_FUNCTION);
  1233.          end
  1234.          else
  1235.          begin
  1236.             FError := WaveInOpen(@FHWaveIn,
  1237.                                  FDeviceId,
  1238.                                  Pointer(PWaveFormat),
  1239.                                  FHandle,
  1240.                                  0,
  1241.                                  CALLBACK_WINDOW);
  1242.          end;
  1244.          if (FError <> 0) then
  1245.          begin
  1246.             Error('WaveInOpen:'#10#13+WaveInErrorString(FError));
  1247.          end;
  1249.          aState := FState;
  1250.          FState := [wisClose];
  1252.          inherited Opened;
  1254.          FState := aState;
  1256.          { wait until the device returns its status }
  1257.          repeat
  1258.              if _Win9x_ or _WinNT4_ then
  1259.                 Delay(10,False)
  1260.              else
  1261.                 Delay(10,True);
  1262.              dec(TimeOut);
  1263.          until (wisOpen in FState) or (TimeOut <= 0);
  1265.          if (TimeOut <= 0) then
  1266.      Error('WaveInOpen:'#10#13+LoadResStr(IDS_CANTOPENDEVICE));
  1268.          { create the waveIn headers and buffers }
  1269.          AllocWaveHeaders;
  1271.          { Prepare waveform headers for recording }
  1272.          PrepareWaveHeaders;
  1274.          Opened;
  1276.       except
  1277.          if assigned(FOnError) then FOnError(Self);
  1278.          FState := [wisOpen];
  1279.          Close;
  1280.          FState := [wisClose];
  1281.          raise;
  1282.       end;
  1283.    end;
  1284. end;
  1286. {-- TMMCustomWaveIn ------------------------------------------------------------}
  1287. Procedure TMMCustomWaveIn.Close;
  1288. var
  1289.    TimeOut: integer;
  1291. begin
  1292.    if (wisOpen in FState) and (not FClosing or FCloseIt) then
  1293.    try
  1294.       FClosing := True;
  1296.       { stop recording }
  1297.       if (wisRecord in FState) OR (wisPause in FState) then Stop;
  1299.       TimeOut := 100;
  1301.       { Close the device (finally!) }
  1302.       if FStopIt then FCloseIt := True
  1303.       else
  1304.       begin
  1305.          FCloseIt := False;
  1306.          if (FHWaveIn <> 0) then
  1307.          begin
  1308.             WaveInStop(FHWaveIn);
  1309.             WaveInReset(FHWaveIn);
  1311.             { unprepare wave headers }
  1312.             UnPrepareWaveHeaders;
  1314.             {$IFDEF _MMDEBUG}
  1315.             if (FInHandler > 0) then
  1316.                DebugStr(0,'Try to close device (while in Handler)...')
  1317.             else
  1318.                DebugStr(0,'Try to close device...');
  1319.             {$ENDIF}
  1321.             FError := WaveInClose(FHWaveIn);
  1322.             if FError <> 0 then
  1323.                Error('WaveInClose:'#10#13+WaveInErrorString(FError));
  1325.             {$IFDEF _MMDEBUG}
  1326.             DebugStr(0,'Waiting for state...');
  1327.             {$ENDIF}
  1329.             { wait until the device returns its status }
  1330.             repeat
  1331.                if _Win9x_ or _WinNT4_ then
  1332.                   Delay(10,False)
  1333.                else
  1334.                   Delay(10,True);
  1335.                dec(TimeOut);
  1336.             until (wisClose in FState) or (TimeOut <= 0);
  1338.             FWrapArrounds   := 0;
  1339.             FWrapSize       := 0;
  1340.          end
  1341.          else
  1342.          begin
  1343.             FState := [wisClose];
  1344.          end;
  1346.          { now notify all other components }
  1347.          inherited Closed;
  1349.          {$IFDEF WIN32}
  1350.          if (FCallBackMode = cmThread) then
  1351.              DoneThread
  1352.          else
  1353.              DoneCritical;
  1354.          {$ENDIF}
  1356.          Closed;
  1358.           if (TimeOut <= 0) then
  1359.             Error('WaveInOpen:'#10#13+LoadResStr(IDS_CANTCLOSEDEVICE));
  1360.       end;
  1362.    except
  1363.       FClosing := False;
  1364.    end;
  1365. end;
  1367. {-- TMMCustomWaveIn ------------------------------------------------------------}
  1368. Procedure TMMCustomWaveIn.Start;
  1369. Var
  1370.    i: integer;
  1371. begin
  1372.    try
  1373.       if not (wisOpen in FState) then Open;
  1375.       if (wisOpen in FState) and (not (wisRecord in FState)) then
  1376.       begin
  1377.          { reset the total bytes recorded counter }
  1378.          FBytesRecorded := 0;
  1379.          FBufferIndex := 0;
  1380.          FInHandler := 0;
  1381.          FStopIt := False;
  1382.          FStopping := False;
  1383.          FReseting := False;
  1384.          FPosted := False;
  1385.          FBufferCounter := 0;
  1386.          FLastPosition := 0;
  1387.          FWrapArrounds := 0;
  1388.          FWrapSize := 0;
  1390.          CalcMaxRecBytes;
  1392.          { To start recording, send the buffers to driver }
  1393.          for i := 0 to FNumBuffers-1 do
  1394.          begin
  1395.             {$IFDEF NUMERATE}
  1396.             FWaveInHdrs[i]^.dwUser := i;
  1397.             {$ENDIF}
  1398.             AddWaveHeader(FWaveInHdrs[i]);
  1399.          end;
  1401.          Started;
  1402.       end;
  1404.    except
  1405.       if assigned(FOnError) then FOnError(Self);
  1406.       FState := FState + [wisRecord];
  1407.       Close;
  1408.       FState := [wisClose];
  1409.       raise;
  1410.    end;
  1411. end;
  1413. {-- TMMCustomWaveIn ------------------------------------------------------------}
  1414. Procedure TMMCustomWaveIn.Pause;
  1415. begin
  1416.    try
  1417.       if not (wisOpen in FState) then Open;
  1419.       if (wisOpen in FState) and (not (wisPause in FState)) then
  1420.       begin
  1421.          if (wisRecord in FState) then
  1422.          begin
  1423.             {$IFDEF _MMDEBUG}
  1424.             DebugStr(0,'Try to pause device...');
  1425.             {$ENDIF}
  1427.             FError := WaveInStop(FHWaveIn);
  1428.             if FError <> 0 then
  1429.                Error('WaveInPause:'#10#13+WaveInErrorString(FError));
  1430.          end;
  1432.          Paused;
  1433.       end;
  1435.    except
  1436.       if assigned(FOnError) then FOnError(Self);
  1437.       Close;
  1438.       raise;
  1439.    end;
  1440. end;
  1442. {-- TMMCustomWaveIn ------------------------------------------------------------}
  1443. Procedure TMMCustomWaveIn.Restart;
  1444. begin
  1445.    try
  1446.       if (wisRecord in FState) and (wisPause in FState) then
  1447.       begin
  1448.          {$IFDEF _MMDEBUG}
  1449.          DebugStr(0,'Try to restart device...');
  1450.          {$ENDIF}
  1452.          FError := WaveInStart(FHWaveIn);
  1453.          if FError <> 0 then
  1454.             Error('WaveInRestart:'#10#13+WaveInErrorString(FError));
  1456.          Restarted;
  1457.       end;
  1459.    except
  1460.       if assigned(FOnError) then FOnError(Self);
  1461.       Close;
  1462.       raise;
  1463.    end;
  1464. end;
  1466. {-- TMMCustomWaveIn ------------------------------------------------------------}
  1467. procedure TMMCustomWaveIn.Stop;
  1468. var
  1469.    TimeOut: Longint;
  1470. begin
  1471.    if (wisRecord in FState) or (wisPause in FState) then
  1472.    begin
  1473.       try
  1474.          EnterCritical;
  1475.          try
  1476.             FStopping := True;
  1478.             {$IFDEF _MMDEBUG}
  1479.             if (FInHandler > 0) then
  1480.                DebugStr(0,'Try to stop device (while in Handler)...')
  1481.             else
  1482.                DebugStr(0,'Try to stop device...');
  1483.             {$ENDIF}
  1485.             FError := WaveInStop(FHWaveIn);
  1486.             if FError <> 0 then
  1487.                Error('WaveInStop:'#10#13+WaveInErrorString(FError));
  1489.             {$IFDEF _MMDEBUG}
  1490.             DebugStr(0,'WaveInStop Done...');
  1491.             {$ENDIF}
  1493.             FWrapArrounds := 0;
  1494.             FWrapSize     := 0;
  1496.             FReseting := True;
  1497.             FError := WaveInReset(FHWaveIn);
  1498.             if FError <> 0 then
  1499.                Error('WaveInReset:'#10#13+WaveInErrorString(FError));
  1501.             {$IFDEF _MMDEBUG}
  1502.             DebugStr(0,'WaveInReset Done...');
  1503.             {$ENDIF}
  1505.          finally
  1506.             LeaveCritical;
  1507.          end;
  1509.          if (FInHandler = 0) then
  1510.          begin
  1511.             TimeOut := 100;
  1512.             repeat
  1513.                if (FCallBackMode <> cmWindow) then
  1514.                    Delay(10,False)
  1515.                else
  1516.                    Delay(10,True);
  1517.                dec(TimeOut);
  1518.             until (FBufferCounter = 0) or (TimeOut <= 0);
  1519.          end;
  1521.          Stopped;
  1523.       except
  1524.          if assigned(FOnError) then FOnError(Self);
  1525.          Close;
  1526.          raise;
  1527.       end;
  1528.    end;
  1529. end;
  1531. {-- TMMCustomWaveIn ------------------------------------------------------------}
  1532. procedure TMMCustomWaveIn.Opened;
  1533. begin
  1534.    {$IFDEF _MMDEBUG}
  1535.    DebugStr(0,'Device is now open...');
  1536.    {$ENDIF}
  1538.    if Assigned(FOnOpen) then FOnOpen(Self);
  1539. end;
  1541. {-- TMMCustomWaveIn ------------------------------------------------------------}
  1542. procedure TMMCustomWaveIn.Closed;
  1543. begin
  1544.    FHWaveIn := 0;
  1546.    { free memory and remove }
  1547.    FreeWaveHeaders;
  1549.    {$IFDEF _MMDEBUG}
  1550.    DebugStr(0,'Device is now closed...');
  1551.    {$ENDIF}
  1553.    FClosing := False;
  1555.    if not (csDestroying in ComponentState) then
  1556.       if Assigned(FOnClose) then FOnClose(Self);
  1557. end;
  1559. {-- TMMCustomWaveIn ------------------------------------------------------------}
  1560. procedure TMMCustomWaveIn.Started;
  1561. begin
  1562.    Include(FState, wisRecord);
  1564.    if not (wisPause in FState) then
  1565.    begin
  1566.       { start the buffers recording (unpause) }
  1567.       FError := WaveInStart(FHWaveIn);
  1568.       if FError <> 0 then
  1569.         Error('WaveInStart:'#10#13+WaveInErrorString(FError));
  1570.    end;
  1572.    { now notify all other components }
  1573.    inherited Started;
  1575.    {$IFDEF _MMDEBUG}
  1576.    DebugStr(0,'Device is now started...');
  1577.    {$ENDIF}
  1579.    InitDSPMeter;
  1581.    if assigned(FOnStart) then FOnStart(Self);
  1582. end;
  1584. {-- TMMCustomWaveIn ------------------------------------------------------------}
  1585. procedure TMMCustomWaveIn.Paused;
  1586. begin
  1587.    Include(FState, wisPause);
  1589.    inherited Paused;
  1591.    {$IFDEF _MMDEBUG}
  1592.    DebugStr(0,'Device is now paused...');
  1593.    {$ENDIF}
  1595.    if assigned(FOnPause) then FOnPause(Self);
  1596. end;
  1598. {-- TMMCustomWaveIn ------------------------------------------------------------}
  1599. procedure TMMCustomWaveIn.Restarted;
  1600. begin
  1601.    FState := FState - [wisPause];
  1603.    inherited Restarted;
  1605.    {$IFDEF _MMDEBUG}
  1606.    DebugStr(0,'Device is now restarted...');
  1607.    {$ENDIF}
  1609.    if assigned(FOnRestart) then FOnRestart(Self);
  1610. end;
  1612. {-- TMMCustomWaveIn ------------------------------------------------------------}
  1613. procedure TMMCustomWaveIn.Stopped;
  1614. begin
  1615.    if (wisRecord in FState) or (wisPause in FState) then
  1616.    begin
  1617.       if (FInHandler > 0) then FStopIt := True
  1618.       else
  1619.       begin
  1620.          FState := FState - [wisRecord,wisPause];
  1622.          FBufferIndex := 0;
  1623.          FBufferCounter := 0;
  1624.          FStopIt := False;
  1626.          DoneDSPMeter;
  1628.          { notify all other components }
  1629.          inherited Stopped;
  1631.          {$IFDEF _MMDEBUG}
  1632.          DebugStr(0,'Device is now stopped...');
  1633.          {$ENDIF}
  1635.          if not (csDestroying in ComponentState) then
  1636.             if assigned(FOnStop) then FOnStop(Self);
  1638.          if FCloseIt then Close;
  1639.       end;
  1640.    end;
  1641. end;
  1643. {-- TMMCustomWaveIn ------------------------------------------------------------}
  1644. procedure TMMCustomWaveIn.BufferReady(lpwh: PWaveHdr);
  1645. var
  1646.    bStopIt: Boolean;
  1648. begin
  1649.    StartDSPMeter;
  1650.    try
  1651.       { inc the bytes we have already recorded }
  1652.       inc(FBytesRecorded, lpwh^.dwBytesRecorded);
  1653.       if (FMaxRecTime > 0) and (FBytesRecorded >= FMaxRecBytes) then
  1654.       begin
  1655.          dec(lpwh^.dwBytesRecorded,FBytesRecorded-FMaxRecBytes);
  1656.          FBytesRecorded := FMaxRecBytes;
  1657.          bStopIt := True;
  1658.       end
  1659.       else bStopIt := False;
  1661.       inc(FBufferIndex);
  1662.       if FBufferIndex >= FNumBuffers then FBufferIndex := 0;
  1664.       inherited BufferReady(lpwh);
  1666.       if bStopIt then Stop;
  1668.    finally
  1669.       StopDSPMeter;
  1670.    end;
  1671. end;
  1673. {-- TMMCustomWaveIn ------------------------------------------------------------}
  1674. procedure TMMCustomWaveIn.ProcessWaveHeader(lpWaveHdr: PWaveHdr);
  1675. var
  1676.    CurPos,LastPos: Cardinal;
  1677.    Wrapped: integer;
  1678. begin
  1679.    if (wisRecord in FState) then
  1680.    begin
  1681.       if FReseting or FStopping then
  1682.       begin
  1683.          { Buffer has returned from driver but should not queued again }
  1684.          {$IFDEF _MMDEBUG}
  1685.          DebugStr(2,'Buffer '+IntToStr(lpWaveHdr^.dwUser)+' returned while reseting');
  1686.          {$ENDIF}
  1687.          if not FReseting and (lpWaveHdr^.dwBytesRecorded > 0) then
  1688.             BufferReady(lpWaveHdr);
  1689.          EnterCritical;
  1690.          dec(FBufferCounter);
  1691.          if (FBufferCounter = 0) then FReseting := False;
  1692.          LeaveCritical;
  1693.          if not FStopIt then exit;
  1694.       end;
  1696.       inc(FInHandler);
  1697.       try
  1698.          {$IFDEF _MMDEBUG}
  1699.          DebugStr(2,'Buffer '+IntToStr(lpWaveHdr^.dwUser)+' returned');
  1700.          {$ENDIF}
  1702.          EnterCritical;
  1703.          dec(FBufferCounter);
  1704.          LeaveCritical;
  1706.          try
  1707.             BufferReady(lpWaveHdr);
  1709.             if not FStopIt then
  1710.             begin
  1711.                {$IFDEF WIN32}
  1712.                { wrap arround handling }
  1713.                CurPos := GetSamplePosition;
  1714.                if (CurPos > 0) then
  1715.                begin
  1716.                   LastPos:= FLastPosition;
  1717.                   asm
  1718.                      mov  Wrapped, False
  1719.                      mov  eax, CurPos
  1720.                      cmp  eax, LastPos
  1721.                      jnb  @@exit
  1723.                      mov  eax, LastPos
  1724.                      sub  eax, CurPos
  1725.                      cmp  eax, $FFFF
  1726.                      jb   @@exit
  1728.                      mov  Wrapped, True
  1729.                   @@exit:
  1730.                   end;
  1732.                   if (Wrapped = 1) then
  1733.                   begin
  1734.                      { every driver wraps at a different position           }
  1735.                      { here we try to detect where the position has wrapped }
  1736.                      { hey, this looks realy cool                           }
  1737.                      FWrapSize := (FLastPosition and $FFF00000) or $FFFFF;
  1738.                      inc(FWrapArrounds);
  1739.                   end;
  1741.                   FLastPosition := CurPos;
  1742.                end;
  1743.                {$ENDIF}
  1745.                { Refresh the wave input device with new buffer. }
  1746.                AddWaveHeader(lpWaveHdr);
  1747.             end;
  1749.          except
  1750.             if assigned(FOnError) then FOnError(Self);
  1751.             raise;
  1752.          end;
  1754.       finally
  1755.          dec(FInHandler);
  1756.          if (FInHandler = 0) and FStopIt and not FPosted then
  1757.          begin
  1758.             FPosted := True;
  1759.             FStopping := True;
  1760.             {$IFDEF _MMDEBUG}
  1761.             DebugStr(0,'Stop Message posted...');
  1762.             {$ENDIF}
  1763.             PostMessage(FHandle,MM_WIM_STOP,FHWaveIn,0);
  1764.          end;
  1765.       end;
  1766.    end;
  1767. end;
  1769. {-- TMMCustomWaveIn ------------------------------------------------------------}
  1770. procedure TMMCustomWaveIn.WaveInHandler(Var Msg: TMessage );
  1771. begin
  1772.   with Msg do
  1773.   try
  1774.      if wParam = FHWaveIn then
  1775.      case Msg of
  1776.        MM_WIM_OPEN :
  1777.        begin
  1778.           { device is now open }
  1779.           FState:= [wisOpen];
  1780.        end;
  1781.        MM_WIM_CLOSE:
  1782.        begin
  1783.           { device is now closed }
  1784.           FState:= [wisClose];
  1785.        end;
  1786.        MM_WIM_DATA:
  1787.        begin
  1788.           { buffer has been returned to app, so queue it.}
  1789.           ProcessWaveHeader(PWaveHdr(lparam));
  1790.           exit;
  1791.        end;
  1792.        MM_WIM_STOP:
  1793.        begin
  1794.           { should stop the device }
  1795.           {$IFDEF _MMDEBUG}
  1796.           DebugStr(0,'Stop message received...');
  1797.           {$ENDIF}
  1798.           Stop;
  1799.           exit;
  1800.        end;
  1801.      end;
  1802.      Result := DefWindowProc(FHandle, Msg, wParam, lParam);
  1804.   except
  1805.      Close;
  1806.      Application.HandleException(Self);
  1807.   end;
  1808. end;
  1810. {== TMMWaveIn =================================================================}
  1811. procedure TMMWaveIn.SetupWaveEngine;
  1812. begin
  1813.   @waveInGetNumDevs       := @MMSystem.waveInGetNumDevs;
  1814.   @waveInGetDevCaps       := @MMSystem.waveInGetDevCaps;
  1815.   @waveInGetErrorText     := @MMSystem.waveInGetErrorText;
  1816.   @waveInOpen             := @MMSystem.waveInOpen;
  1817.   @waveInClose            := @MMSystem.waveInClose;
  1818.   @waveInPrepareHeader    := @MMSystem.waveInPrepareHeader;
  1819.   @waveInUnprepareHeader  := @MMSystem.waveInUnprepareHeader;
  1820.   @waveInAddBuffer        := @MMSystem.waveInAddBuffer;
  1821.   @waveInStart            := @MMSystem.waveInStart;
  1822.   @waveInStop             := @MMSystem.waveInStop;
  1823.   @waveInReset            := @MMSystem.waveInReset;
  1824.   @waveInGetPosition      := @MMSystem.waveInGetPosition;
  1825.   @waveInGetID            := @MMSystem.waveInGetID;
  1826. end;
  1828. {-- WaveInFunc -----------------------------------------------------------}
  1829. procedure WaveInFunc(hWaveIn:HWaveIn;wMsg:UINT;dwInstance,dwParam1,dwParam2:Longint);
  1830. begin
  1831.    if (dwInstance <> 0) then
  1832.    with TMMCustomWaveIn(dwInstance) do
  1833.    {$IFDEF WIN32}
  1834.    try
  1835.    {$ELSE}
  1836.    begin
  1837.    {$ENDIF}
  1838.       case wMsg of
  1839.          WIM_OPEN :
  1840.          begin
  1841.             { device is now open }
  1842.             FState:= [wisOpen];
  1843.          end;
  1844.          WIM_CLOSE:
  1845.          begin
  1846.             { device is now closed }
  1847.             FState:= [wisClose];
  1848.          end;
  1849.          WIM_DATA :
  1850.          begin
  1851.             case FCallBackMode of
  1852.                   cmWindow: PostMessage(FHandle,MM_WIM_DATA,hWaveIn,dwParam1);
  1853.                 {$IFDEF WIN32}
  1854.                 cmCallBack: ProcessWaveHeader(PWaveHdr(dwparam1));
  1855.                   cmThread: PostThreadMessage(FInThread.ThreadID,MM_WIM_DATA,hWaveIn,dwParam1);
  1856.                 {$ENDIF}
  1857.             end;
  1858.          end;
  1859.       end;
  1861.    {$IFDEF WIN32}
  1862.    except
  1863.       Close;
  1864.       Application.HandleException(TMMCustomWaveIn(dwInstance));
  1865.    {$ENDIF}
  1866.    end;
  1867. end;
  1869. {$IFDEF WIN32}
  1870. {-------------------------------------------------------------------------}
  1871. procedure TMMWaveInThread.Execute;
  1872. {- Wait for and process input messages }
  1873. var
  1874.    Res       : DWORD;
  1875.    Msg       : TMsg;
  1876.    {$IFDEF _MMDEBUG}
  1877.    _Error    : Longint;
  1878.    {$ENDIF}
  1880. begin
  1881.    with TMMCustomWaveIn(Owner) do
  1882.    try
  1883.       SetPriority(FPriority);
  1884.       
  1885.       { make sure we have a message queue... }
  1886.       PeekMessage(Msg, 0, 0, 0, PM_NOREMOVE);
  1888.       { Ready to go, set the input event }
  1889.       SetEvent(FInEvent);
  1891.       { Repeat until device is closed }
  1892.       while not Terminated do
  1893.       try
  1894.          if not PeekMessage(msg, 0, 0, 0, PM_REMOVE) then
  1895.          begin
  1896.             Res := MsgWaitForMultipleObjects(1, FCloseEvent, False,
  1897.                                              INFINITE, QS_ALLEVENTS);
  1898.             case Res of
  1899.                 WAIT_FAILED:       { Wait failed.  Shouldn't happen. }
  1900.                 begin
  1901.                    {$IFDEF _MMDEBUG}
  1902.                    _Error := GetLastError;
  1903.                    DebugStr(0,'Wait Failed... Error: '+SysErrorMessage(_Error));
  1904.                    {$ENDIF}
  1906.                    Continue;
  1907.                 end;
  1908.                 WAIT_OBJECT_0:     { CloseEvent signaled!            }
  1909.                 begin
  1910.                    { Finished here, okay to close device }
  1911.                    {$IFDEF _MMDEBUG}
  1912.                    DebugStr(0,'CloseEvent signaled...');
  1913.                    {$ENDIF}
  1915.                    exit;
  1916.                 end;
  1917.                 WAIT_OBJECT_0+1:    { New message was received.      }
  1918.                 begin
  1919.                    { Get the message that woke us up by looping again.}
  1920.                    {$IFDEF _MMDEBUG}
  1921.                    DebugStr(2,'WaveIn message reveived...');
  1922.                    {$ENDIF}
  1924.                    Continue;
  1925.                 end;
  1926.             end;
  1927.          end;
  1929.          { Process the message. }
  1930.          with msg do
  1931.          begin
  1932.             if (wParam = FHWaveIn) and (message = MM_WIM_DATA) then
  1933.             begin             { done playing queued wave buffer... }
  1934.                ProcessWaveHeader(PWaveHdr(lparam));
  1935.             end
  1936.             else
  1937.             begin
  1938.                {$IFDEF _MMDEBUG}
  1939.                DebugStr(0,'Unknown message received...');
  1940.                {$ENDIF}
  1942.                TranslateMessage(Msg);
  1943.                DispatchMessage(msg);
  1944.             end;
  1945.          end;
  1947.       except
  1948.          FThreadError := True;
  1949.          if (FHWaveIn <> 0) then
  1950.          begin
  1951.             FClosing := True;
  1952.             Stop;
  1953.             UnPrepareWaveHeaders;
  1954.             WaveInClose(FHWaveIn);
  1955.             Closed;
  1956.             CloseEvents;
  1957.          end;
  1958.          Application.HandleException(nil);
  1959.          exit;
  1960.       end;
  1962.    finally
  1963.      SetEvent(FInEvent);
  1965.      {$IFDEF _MMDEBUG}
  1966.      DebugStr(0,'Exit Thread-Proc');
  1967.      {$ENDIF}
  1968.    end;
  1969. end;
  1970. {$ENDIF}
  1972. procedure InitWaveInDevices;
  1973. var
  1974.    i: integer;
  1975.    Name: string;
  1977.    function CheckDevice(DeviceID: integer; var Name: string): Boolean;
  1978.    var
  1979.       Res: integer;
  1980.       Caps: TWAVEINCAPS;
  1981.    begin
  1982.       Result := False;
  1983.       Name   := '';
  1984.       Res := WaveInGetDevCaps(i,@Caps,sizeof(Caps));
  1985.       if (Res = 0) then
  1986.       begin
  1987.          Name := StrPas(Caps.szPname);
  1988.          Result := True;
  1989.       end;
  1990.    end;
  1992. begin
  1993.    Devices := TStringList.Create;
  1994.    for i := 0 to WaveInGetNumDevs-1 do
  1995.    begin
  1996.       if CheckDevice(i,Name) then
  1997.          Devices.AddObject(Name,Pointer(i));
  1998.    end;
  1999. end;
  2001. initialization
  2002.    InitWaveInDevices;
  2003. {$IFDEF _MMDEBUG}
  2004.    DB_Level(DEBUGLEVEL);
  2005. {$ENDIF}
  2006. finalization
  2007.    if (Devices <> nil) then
  2008.        Devices.Free;
  2009. end.