mmwavin.pas

一套及时通讯的原码

procedure TMMCustomWaveIn.Stopped;
begin
   if (wisRecord in FState) or (wisPause in FState) then
   begin
      if (FInHandler > 0) then FStopIt := True
      else
      begin
         FState := FState - [wisRecord,wisPause];

         FBufferIndex := 0;
         FBufferCounter := 0;
         FStopIt := False;

         DoneDSPMeter;

         { notify all other components }
         inherited Stopped;

         {$IFDEF _MMDEBUG}
         DebugStr(0,'Device is now stopped...');
         {$ENDIF}

         if not (csDestroying in ComponentState) then
            if assigned(FOnStop) then FOnStop(Self);

         if FCloseIt then Close;
      end;
   end;
end;

{-- TMMCustomWaveIn ------------------------------------------------------------}
procedure TMMCustomWaveIn.BufferReady(lpwh: PWaveHdr);
var
   bStopIt: Boolean;

begin
   StartDSPMeter;
   try
      { inc the bytes we have already recorded }
      inc(FBytesRecorded, lpwh^.dwBytesRecorded);
      if (FMaxRecTime > 0) and (FBytesRecorded >= FMaxRecBytes) then
      begin
         dec(lpwh^.dwBytesRecorded,FBytesRecorded-FMaxRecBytes);
         FBytesRecorded := FMaxRecBytes;
         bStopIt := True;
      end
      else bStopIt := False;

      inc(FBufferIndex);
      if FBufferIndex >= FNumBuffers then FBufferIndex := 0;

      inherited BufferReady(lpwh);

      if bStopIt then Stop;

   finally
      StopDSPMeter;
   end;
end;

{-- TMMCustomWaveIn ------------------------------------------------------------}
procedure TMMCustomWaveIn.ProcessWaveHeader(lpWaveHdr: PWaveHdr);
var
   CurPos,LastPos: Cardinal;
   Wrapped: integer;
begin
   if (wisRecord in FState) then
   begin
      if FReseting or FStopping then
      begin
         { Buffer has returned from driver but should not queued again }
         {$IFDEF _MMDEBUG}
         DebugStr(2,'Buffer '+IntToStr(lpWaveHdr^.dwUser)+' returned while reseting');
         {$ENDIF}
         if not FReseting and (lpWaveHdr^.dwBytesRecorded > 0) then
            BufferReady(lpWaveHdr);
         EnterCritical;
         dec(FBufferCounter);
         if (FBufferCounter = 0) then FReseting := False;
         LeaveCritical;
         if not FStopIt then exit;
      end;

      inc(FInHandler);
      try
         {$IFDEF _MMDEBUG}
         DebugStr(2,'Buffer '+IntToStr(lpWaveHdr^.dwUser)+' returned');
         {$ENDIF}

         EnterCritical;
         dec(FBufferCounter);
         LeaveCritical;

         try
            BufferReady(lpWaveHdr);

            if not FStopIt then
            begin
               {$IFDEF WIN32}
               { wrap arround handling }
               CurPos := GetSamplePosition;
               if (CurPos > 0) then
               begin
                  LastPos:= FLastPosition;
                  asm
                     mov  Wrapped, False
                     mov  eax, CurPos
                     cmp  eax, LastPos
                     jnb  @@exit

                     mov  eax, LastPos
                     sub  eax, CurPos
                     cmp  eax, $FFFF
                     jb   @@exit

                     mov  Wrapped, True
                  @@exit:
                  end;

                  if (Wrapped = 1) then
                  begin
                     { every driver wraps at a different position           }
                     { here we try to detect where the position has wrapped }
                     { hey, this looks realy cool                           }
                     FWrapSize := (FLastPosition and $FFF00000) or $FFFFF;
                     inc(FWrapArrounds);
                  end;

                  FLastPosition := CurPos;
               end;
               {$ENDIF}

               { Refresh the wave input device with new buffer. }
               AddWaveHeader(lpWaveHdr);
            end;

         except
            if assigned(FOnError) then FOnError(Self);
            raise;
         end;

      finally
         dec(FInHandler);
         if (FInHandler = 0) and FStopIt and not FPosted then
         begin
            FPosted := True;
            FStopping := True;
            {$IFDEF _MMDEBUG}
            DebugStr(0,'Stop Message posted...');
            {$ENDIF}
            PostMessage(FHandle,MM_WIM_STOP,FHWaveIn,0);
         end;
      end;
   end;
end;

{-- TMMCustomWaveIn ------------------------------------------------------------}
procedure TMMCustomWaveIn.WaveInHandler(Var Msg: TMessage );
begin
  with Msg do
  try
     if wParam = FHWaveIn then
     case Msg of
       MM_WIM_OPEN :
       begin
          { device is now open }
          FState:= [wisOpen];
       end;
       MM_WIM_CLOSE:
       begin
          { device is now closed }
          FState:= [wisClose];
       end;
       MM_WIM_DATA:
       begin
          { buffer has been returned to app, so queue it.}
          ProcessWaveHeader(PWaveHdr(lparam));
          exit;
       end;
       MM_WIM_STOP:
       begin
          { should stop the device }
          {$IFDEF _MMDEBUG}
          DebugStr(0,'Stop message received...');
          {$ENDIF}
          Stop;
          exit;
       end;
     end;
     Result := DefWindowProc(FHandle, Msg, wParam, lParam);

  except
     Close;
     Application.HandleException(Self);
  end;
end;

{== TMMWaveIn =================================================================}
procedure TMMWaveIn.SetupWaveEngine;
begin
  @waveInGetNumDevs       := @MMSystem.waveInGetNumDevs;
  @waveInGetDevCaps       := @MMSystem.waveInGetDevCaps;
  @waveInGetErrorText     := @MMSystem.waveInGetErrorText;
  @waveInOpen             := @MMSystem.waveInOpen;
  @waveInClose            := @MMSystem.waveInClose;
  @waveInPrepareHeader    := @MMSystem.waveInPrepareHeader;
  @waveInUnprepareHeader  := @MMSystem.waveInUnprepareHeader;
  @waveInAddBuffer        := @MMSystem.waveInAddBuffer;
  @waveInStart            := @MMSystem.waveInStart;
  @waveInStop             := @MMSystem.waveInStop;
  @waveInReset            := @MMSystem.waveInReset;
  @waveInGetPosition      := @MMSystem.waveInGetPosition;
  @waveInGetID            := @MMSystem.waveInGetID;
end;

{-- WaveInFunc -----------------------------------------------------------}
procedure WaveInFunc(hWaveIn:HWaveIn;wMsg:UINT;dwInstance,dwParam1,dwParam2:Longint);
begin
   if (dwInstance <> 0) then
   with TMMCustomWaveIn(dwInstance) do
   {$IFDEF WIN32}
   try
   {$ELSE}
   begin
   {$ENDIF}
      case wMsg of
         WIM_OPEN :
         begin
            { device is now open }
            FState:= [wisOpen];
         end;
         WIM_CLOSE:
         begin
            { device is now closed }
            FState:= [wisClose];
         end;
         WIM_DATA :
         begin
            case FCallBackMode of
                  cmWindow: PostMessage(FHandle,MM_WIM_DATA,hWaveIn,dwParam1);
                {$IFDEF WIN32}
                cmCallBack: ProcessWaveHeader(PWaveHdr(dwparam1));
                  cmThread: PostThreadMessage(FInThread.ThreadID,MM_WIM_DATA,hWaveIn,dwParam1);
                {$ENDIF}
            end;
         end;
      end;

   {$IFDEF WIN32}
   except
      Close;
      Application.HandleException(TMMCustomWaveIn(dwInstance));
   {$ENDIF}
   end;
end;

{$IFDEF WIN32}
{-------------------------------------------------------------------------}
procedure TMMWaveInThread.Execute;
{- Wait for and process input messages }
var
   Res       : DWORD;
   Msg       : TMsg;
   {$IFDEF _MMDEBUG}
   _Error    : Longint;
   {$ENDIF}

begin
   with TMMCustomWaveIn(Owner) do
   try
      SetPriority(FPriority);
      
      { make sure we have a message queue... }
      PeekMessage(Msg, 0, 0, 0, PM_NOREMOVE);

      { Ready to go, set the input event }
      SetEvent(FInEvent);

      { Repeat until device is closed }
      while not Terminated do
      try
         if not PeekMessage(msg, 0, 0, 0, PM_REMOVE) then
         begin
            Res := MsgWaitForMultipleObjects(1, FCloseEvent, False,
                                             INFINITE, QS_ALLEVENTS);
            case Res of
                WAIT_FAILED:       { Wait failed.  Shouldn't happen. }
                begin
                   {$IFDEF _MMDEBUG}
                   _Error := GetLastError;
                   DebugStr(0,'Wait Failed... Error: '+SysErrorMessage(_Error));
                   {$ENDIF}

                   Continue;
                end;
                WAIT_OBJECT_0:     { CloseEvent signaled!            }
                begin
                   { Finished here, okay to close device }
                   {$IFDEF _MMDEBUG}
                   DebugStr(0,'CloseEvent signaled...');
                   {$ENDIF}

                   exit;
                end;
                WAIT_OBJECT_0+1:    { New message was received.      }
                begin
                   { Get the message that woke us up by looping again.}
                   {$IFDEF _MMDEBUG}
                   DebugStr(2,'WaveIn message reveived...');
                   {$ENDIF}

                   Continue;
                end;
            end;
         end;

         { Process the message. }
         with msg do
         begin
            if (wParam = FHWaveIn) and (message = MM_WIM_DATA) then
            begin             { done playing queued wave buffer... }
               ProcessWaveHeader(PWaveHdr(lparam));
            end
            else
            begin
               {$IFDEF _MMDEBUG}
               DebugStr(0,'Unknown message received...');
               {$ENDIF}

               TranslateMessage(Msg);
               DispatchMessage(msg);
            end;
         end;

      except
         FThreadError := True;
         if (FHWaveIn <> 0) then
         begin
            FClosing := True;
            Stop;
            UnPrepareWaveHeaders;
            WaveInClose(FHWaveIn);
            Closed;
            CloseEvents;
         end;
         Application.HandleException(nil);
         exit;
      end;

   finally
     SetEvent(FInEvent);

     {$IFDEF _MMDEBUG}
     DebugStr(0,'Exit Thread-Proc');
     {$ENDIF}
   end;
end;
{$ENDIF}

procedure InitWaveInDevices;
var
   i: integer;
   Name: string;

   function CheckDevice(DeviceID: integer; var Name: string): Boolean;
   var
      Res: integer;
      Caps: TWAVEINCAPS;
   begin
      Result := False;
      Name   := '';
      Res := WaveInGetDevCaps(i,@Caps,sizeof(Caps));
      if (Res = 0) then
      begin
         Name := StrPas(Caps.szPname);
         Result := True;
      end;
   end;

begin
   Devices := TStringList.Create;
   for i := 0 to WaveInGetNumDevs-1 do
   begin
      if CheckDevice(i,Name) then
         Devices.AddObject(Name,Pointer(i));
   end;
end;

initialization
   InitWaveInDevices;
{$IFDEF _MMDEBUG}
   DB_Level(DEBUGLEVEL);
{$ENDIF}
finalization
   if (Devices <> nil) then
       Devices.Free;
end.