mmwavin.pas

一套及时通讯的原码

{-- TMMCustomWaveIn -----------------------------------------------------------}
function TMMCustomWaveIn.GetPositionHigh: Cardinal;
{$IFNDEF DELPHI4}
var
   Temp: TLargeInteger;
{$ENDIF}
begin
   {$IFDEF DELPHI4}
   Result := (GetInternalPosition shr 32);
   {$ELSE}
   Temp.QuadPart := GetInternalPosition;
   Result := Temp.HighPart;
   {$ENDIF}
end;

{-- TMMCustomWaveIn -----------------------------------------------------------}
function TMMCustomWaveIn.GetPosition64: int64;
begin
   Result := GetInternalPosition;
end;

{-- TMMCustomWaveIn ------------------------------------------------------------}
Procedure TMMCustomWaveIn.SetCallBackMode(aValue: TMMCBMode);
begin
   if (wisOpen in FState) then
       Error(LoadResStr(IDS_PROPERTYOPEN));

   if (aValue <> FCallBackMode) then
   begin
      if (aValue = cmCallBack) then
      begin
         {$IFDEF WIN32}
         if not _Win95_ then
         {$ENDIF}
         begin
            Application.MessageBox('"CallBacks" are called at interrupt time !'#10#13+
                                   'This is currently only supported under Windows 95',
                                   'TMMWaveIn', MB_OK);
            exit;
         end;
      end;
      FCallBackMode := aValue;
   end;
   {$IFDEF WIN32}
   {$IFDEF TRIAL}
   {$DEFINE _HACK3}
   {$I MMHACK.INC}
   {$ENDIF}
   {$ENDIF}
end;

{-- TMMCustomWaveIn ------------------------------------------------------------}
function TMMCustomWaveIn.GetCallBackMode: TMMCBMode;
begin
   Result := FCallbackMode;
end;

{-- TMMCustomWaveIn ------------------------------------------------------------}
Procedure TMMCustomWaveIn.SetPWaveFormat(aValue: PWaveFormatEx);
begin
   { stop and close the device }
   Close;
   if (aValue <> nil) then
   begin
      if pcmIsValidFormat(aValue) then
      begin
         SampleRate := aValue^.nSamplesPerSec;
         BitLength := TMMBits(aValue^.wBitsPerSample div 8 - 1);
         Mode := TMMMode(aValue^.nChannels-1);
      end;
   end;
   inherited SetPWaveFormat(aValue);
end;

{-- TMMCustomWaveIn ------------------------------------------------------------}
procedure TMMCustomWaveIn.SetWaveParams;
begin
   pcmBuildWaveHeader(@FWaveFormat,(Ord(FBits)+1)*8,Ord(FMode)+1,FRate);
   PWaveFormat := @FWaveFormat;
end;

{-- TMMCustomWaveIn ------------------------------------------------------------}
Procedure TMMCustomWaveIn.SetMode(aValue: TMMMode);
begin
   if (FMode <> aValue) and (aValue in [mMono,mStereo]) then
   begin
      if (wisOpen in FState) then
          Error(LoadResStr(IDS_PROPERTYOPEN));

      FMode := aValue;
      SetWaveParams;
   end;
end;

{-- TMMCustomWaveIn ------------------------------------------------------------}
Procedure TMMCustomWaveIn.SetSampleRate(aValue: Longint);
begin
   if (FRate <> aValue) then
   begin
      if (wisOpen in FState) then
         Error(LoadResStr(IDS_PROPERTYOPEN));

      FRate := MinMax(aValue,8000,100000);
      SetWaveParams;
   end;
end;

{-- TMMCustomWaveIn ------------------------------------------------------------}
Procedure TMMCustomWaveIn.SetBits(aValue: TMMBits);
begin
   if (FBits <> aValue) then
   begin
      if (wisOpen in FState) then
         Error(LoadResStr(IDS_PROPERTYOPEN));

      FBits := aValue;
      SetWaveParams;
   end;
end;

{-- TMMCustomWaveIn ------------------------------------------------------------}
Procedure TMMCustomWaveIn.SetNumBuffers(aValue: integer);
begin
   if (aValue <> FNumBuffers) AND (aValue > 1) then
   begin
      if (wisOpen in FState) then
          Error(LoadResStr(IDS_PROPERTYOPEN));

      FNumBuffers := Min(aValue,MAXINBUFFERS);
   end;
   {$IFDEF WIN32}
   {$IFDEF TRIAL}
   {$DEFINE _HACK1}
   {$I MMHACK.INC}
   {$ENDIF}
   {$ENDIF}
end;

{-- TMMCustomWaveIn ------------------------------------------------------------}
function TMMCustomWaveIn.GetNumBuffers: integer;
begin
   Result := FNumBuffers;
end;

{-- TMMCustomWaveIn ------------------------------------------------------------}
Procedure TMMCustomWaveIn.SetBufferSize(aValue: Longint);
begin
   if (aValue <> inherited GetBufferSize) then
   begin
      if (wisOpen in FState) then
          Error(LoadResStr(IDS_PROPERTYOPEN));

      if assigned(FAllocator) then
         FAllocator.Discard;

      inherited SetBufferSize(Max(aValue,MINBUFFERSIZE));
   end;
end;

{-- TMMCustomWaveIn ------------------------------------------------------------}
function TMMCustomWaveIn.GetBufferSize: Longint;
begin
   Result := inherited GetBufferSize;
end;

{-- TMMCustomWaveIn ------------------------------------------------------------}
Procedure TMMCustomWaveIn.PrepareWaveHeaders;
Var
   i: integer;

begin
   { Prepare waveform headers for recording }
   for i := 0 to FNumBuffers-1 do
   begin
      if FWaveInHdrs[i] <> Nil then
      begin
         FError := waveInPrepareHeader(FHWaveIn,
                                       FWaveInHdrs[i],
                                       sizeOf(TWaveHdr));
         if FError <> 0 then
            Error('WaveInPrepareHeader:'#10#13+WaveInErrorString(FError));
      end;
   end;
end;

{-- TMMCustomWaveIn ------------------------------------------------------------}
Procedure TMMCustomWaveIn.UnPrepareWaveHeaders;
Var
   i: integer;
   TimeOut: Longint;

begin
   {$IFDEF _MMDEBUG}
   DebugStr(1,' ');
   {$ENDIF}

   for i := 0 to FNumBuffers-1 do
   begin
      if (FWaveInHdrs[i] <> Nil) then
      begin
         TimeOut := 65000;
         { wait until the buffer is marked as done }
         repeat
             dec(TimeOut);
         until (FWaveInHdrs[i]^.dwFlags and WHDR_DONE = WHDR_DONE) or (TimeOut = 0);

         { mark buffer as done }
         if (TimeOut = 0) then FWaveInHdrs[i]^.dwFlags := WHDR_DONE;

         { unprepare buffer }
         FError := WaveInUnprepareHeader(FHWaveIn,
                                         FWaveInHdrs[i],
                                         sizeOf(TWAVEHDR));
         if FError <> 0 then
            Error('WaveInUnprepareHeader:'#10#13+WaveInErrorString(FError));

         {$IFDEF _MMDEBUG}
         DebugStr(1,'UnprepareHeader '+IntToStr(i));
         {$ENDIF}
      end;
   end;

   {$IFDEF _MMDEBUG}
   DebugStr(1,' ');
   {$ENDIF}
end;

{-- TMMCustomWaveIn ------------------------------------------------------------}
Procedure TMMCustomWaveIn.AddWaveHeader(lpWaveHdr: PWaveHdr);
begin
   { reset flags field (remove WHDR_DONE attribute) }
   lpWaveHdr^.dwFlags := lpWaveHdr^.dwFlags and not WHDR_DONE or WHDR_PREPARED;

   { queue the buffer for input... }
   FError := WaveInAddBuffer(FHWaveIn,
                             lpWaveHdr,
                             sizeof(TWAVEHDR));
   if FError <> 0 then
      Error('WaveInAddBuffer:'#10#13+WaveInErrorString(FError));

   inc(FBufferCounter);

   {$IFDEF _MMDEBUG}
   DebugStr(2,'Wave-Header '+IntToStr(lpWaveHdr^.dwUser)+' queued');
   {$ENDIF}
end;

{$IFDEF WIN32}
{-- TMMCustomWaveIn ------------------------------------------------------------}
procedure TMMCustomWaveIn.SynchronizeVCL(VCLProc: TThreadMethod);
begin
   if (FCallBackMode = cmThread) and (FInEvent <> 0) then
   begin
      FInThread.Synchronize(VCLProc);
   end
   else VCLProc;
end;

{-- TMMCustomWaveIn ------------------------------------------------------------}
procedure TMMCustomWaveIn.InitThread;
begin
   if (FCallBackMode = cmThread) then
   begin
      EnterCritical;
      try
         FThreadError := False;

         { create event objects }
         FInEvent   := CreateEvent(nil, False, False, nil);
         FCloseEvent := CreateEvent(nil, False, False, nil);

         { create the output thread }
         FInThread := TMMWaveInThread.CreateSuspended(Self);
         if (FInThread = nil) then
             Error('WaveIn:'#10#13+LoadResStr(IDS_THREADERROR));

         FInThread.FreeOnTerminate := True;
         FInThread.Resume;

         { Wait for it to start... }
         if WaitForSingleObject(FInEvent, 5000) <> WAIT_OBJECT_0 then
            Error('WaveIn:'#10#13+LoadResStr(IDS_THREADERROR));

         {$IFDEF _MMDEBUG}
         DebugStr(0,'Thread Started');
         {$ENDIF}

      finally
        LeaveCritical;
      end;
   end;
end;

{-- TMMCustomWaveIn ------------------------------------------------------------}
procedure TMMCustomWaveIn.DoneThread;
begin
   if (FCallBackMode = cmThread) and not FThreadError then
   begin
      { Force the output thread to close... }
      SetEvent(FCloseEvent);

      { ...and wait for it to die }
      WaitForSingleObject(FInEvent, 5000);

      { close all events and remove critical section }
      CloseEvents;

      {$IFDEF _MMDEBUG}
      DebugStr(0,'Thread Terminated');
      {$ENDIF}
   end;
end;

{-- TMMCustomWaveIn ------------------------------------------------------------}
procedure TMMCustomWaveIn.CloseEvents;
begin
   { release events }
   CloseHandle(FInEvent);
   CloseHandle(FCloseEvent);

   { Free the critical section }
   DoneCritical;
end;
{$ENDIF}

{-- TMMCustomWaveIn ------------------------------------------------------------}
procedure TMMCustomWaveIn.InitCritical;
begin
   {$IFDEF WIN32}
   if (FCallBackMode <> cmWindow) then
   begin
      { create critical section object }
      FillChar(DataSection, SizeOf(DataSection), 0);
      InitializeCriticalSection(DataSection);
      DataSEctionOK := True;
   end;
   {$ENDIF}
end;

{-- TMMCustomWaveIn ------------------------------------------------------------}
procedure TMMCustomWaveIn.EnterCritical;
begin
   {$IFDEF WIN32}
   if (FCallBackMode <> cmWindow) and DataSectionOK then
      EnterCriticalSection(DataSection);
   {$ENDIF}
end;

{-- TMMCustomWaveIn ------------------------------------------------------------}
procedure TMMCustomWaveIn.LeaveCritical;
begin
   {$IFDEF WIN32}
   if (FCallBackMode <> cmWindow) and DataSectionOK then
      LeaveCriticalSection(DataSection);
   {$ENDIF}
end;

{-- TMMCustomWaveIn ------------------------------------------------------------}
procedure TMMCustomWaveIn.DoneCritical;
begin
   {$IFDEF WIN32}
   if (FCallBackMode <> cmWindow) and DataSectionOK then
   begin
      DataSectionOK := False;
      DeleteCriticalSection(DataSection);
   end;
   {$ENDIF}
end;

{-- TMMCustomWaveIn ------------------------------------------------------------}
Procedure TMMCustomWaveIn.Open;
var
   TimeOut: integer;
   aState: TMMWaveInState;
begin
   if (FNumDevs = 0) then
      Error(LoadResStr(IDS_WINODEVICE));

   if (FDeviceID = InvalidId) then
      Error(LoadResStr(IDS_INVALIDDEVICEID));

   if (PWaveFormat = nil) then
      Error(LoadResStr(IDS_NOFORMAT));

   if (wisOpen in FState) then Close;

   if (Not(wisOpen in FState)) and not FClosing then
   begin
      TimeOut := 100;
      FClosing := False;
      FReseting := False;
      FStopping := False;
      FPosted := False;
      try
         if not QueryDevice(FDeviceID, PWaveFormat) then
            Error('WaveInOpen:'#10#13+LoadResStr(IDS_CANTRECORD));

         { Create the window for callback notification }
         if (FHandle = 0) then FHandle := AllocateHwnd(WaveInHandler);

         FHWaveIn := 0;
         FCloseIt := False;