mmdswout.pas

一套及时通讯的原码

procedure TMMDSWaveOut.DoOpened;
begin
   {$IFDEF _MMDEBUG}
   DebugStr(0,'Device is now open...');
   {$ENDIF}

   if Assigned(FOnOpen) then FOnOpen(Self);
end;

{-- TMMDSWaveOut --------------------------------------------------------}
procedure TMMDSWaveOut.DoClosed;
begin
   FHDSWaveOut := 0;

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

   FClosing := False;

   if not (csDestroying in ComponentState) then
      if Assigned(FOnClose) then FOnClose(Self);
end;

{-- TMMDSWaveOut --------------------------------------------------------}
procedure TMMDSWaveOut.DoStarted;
begin
   if (FBuffersUsed > 0) then
   begin

      if not (dssPause in FState) then
      begin
         { start the buffers playing (unpause) }
         FError := DSWaveOutRestart(FHDSWaveOut);
         if FError <> 0 then
            Error('DSWaveOutRestart:'#10#13+LoadResStr(IDS_RESTARTERROR));
      end;

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

      InitDSPMeter;

      if Assigned(FOnStart) then FOnStart(Self);
   end
   else
   try
      inherited Stopped;
      Error('DSWaveOutStarted:'#10#13+LoadResStr(IDS_STARTERROR));
   finally
      Close;
   end;
end;

{-- TMMDSWaveOut --------------------------------------------------------}
procedure TMMDSWaveOut.DoPaused;
begin
   FState := FState + [dssPause];

   inherited Paused;

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

   if Assigned(FOnPause) then FOnPause(Self);
end;

{-- TMMDSWaveOut --------------------------------------------------------}
procedure TMMDSWaveOut.DoRestarted;
begin
   FState := FState - [dssPause];

   inherited Restarted;

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

   if Assigned(FOnRestart) then FOnRestart(Self);
end;

{-- TMMDSWaveOut --------------------------------------------------------}
procedure TMMDSWaveOut.DoStopped;
var
   TimeOut: Longint;
begin
   if (dssPlay in FState) or (dssPause in FState) then
   begin
      if (FInHandler > 0) then FStopIt := True
      else
      begin
         FState := FState - [dssPlay,dssPause];

         DoneDSPMeter;

         TimeOut := TimeGetTime;
         repeat
         until (FBufferCounter = 0) or (TimeGetTime-TimeOut > 500);

         { notify all other components }
         inherited Stopped;

         { unprepare wave headers }
         UnPrepareWaveHeaders;

         { free header memory and remove }
         FreeWaveHeaders;

         FBuffersUsed := 0;
         FBufferCounter := 0;
         FBufferInIdx := 0;
         FBufferOutIdx := 0;

         FStopIt := False;

         {$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;

{-- TMMDSWaveOut --------------------------------------------------------}
procedure TMMDSWaveOut.DoBufferFilled(lpwh: PWaveHdr);
begin
   if assigned(FOnBufferFilled) then FOnBufferFilled(Self, lpwh);
end;

{-- TMMDSWaveOut --------------------------------------------------------}
procedure TMMDSWaveOut.BufferLoad(lpwh: PWaveHdr; var MoreBuffers: Boolean);
begin
   StartDSPMeter;
   try
      with PMMWaveHdr(lpwh)^ do
      begin
         wh.dwBufferLength := BufferSize;
         wh.dwBytesRecorded := 0;
         LoopRec.dwLoop := FLooping;
         if FLooping then
         begin
            LoopRec.dwLoopCnt    := FLoopCount;
            LoopRec.dwLoopTmpCnt := FLoopTempCount;
            LoopRec.dwLooping    := False;
         end;

         inherited BufferLoad(lpwh, MoreBuffers);

         wh.dwBufferLength := wh.dwBytesRecorded;

         if FLooping then FLoopTempCount := LoopRec.dwLoopTmpCnt;
      end;

   finally
      StopDSPMeter;
   end;
end;

{-- TMMDSWaveOut --------------------------------------------------------}
procedure TMMDSWaveOut.BufferReady(lpwh: PWaveHdr);
begin
end;

{-- TMMDSWaveOut --------------------------------------------------------}
procedure TMMDSWaveOut.DoBufferReady(lpwh: PWaveHdr);
begin
   { buffer has returned from driver, notify the other components }
   StartDSPMeter;
   try
      inc(FBufferOutIdx);
      if FBufferOutIdx >= FBuffersUsed then FBufferOutIdx := 0;

      { we use a trick here and point to the current header which is playing }
      lpwh^.lpNext := FDSWaveOutHdrs[FBufferOutIdx];

      inherited BufferReady(lpwh);

   finally
      StopDSPMeter;
   end;
end;

{-- TMMDSWaveOut ---------------------------------------------------------}
procedure TMMDSWaveOut.ProcessWaveHeader(lpWaveHdr: PWaveHdr);
begin
   if (dssPlay in FState) and not FReseting and not FStopping then
   begin
      inc(FInHandler);
      try
         { some drivers, for example the SB return the buffers }
         { in bad order, so wee can try to fix this            }
         if FIX_BUFFERS then
            lpWaveHdr := FDSWaveOutHdrs[FBufferOutIdx];

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

         EnterCritical;
         inc(FBytesPlayed, lpWaveHdr^.dwBufferLength);
         LeaveCritical;

         try
            DoBufferReady(lpWaveHdr);

            if FMoreBuffers and not FStopIt then
            begin
               { file restarted ? }
               if FLooping and PMMWaveHdr(lpWaveHdr)^.LoopRec.dwLooping then
               begin
                  { adjust GetPosition }
                  EnterCritical;
                  FLoopPos := GetSamplePosition;
                  PMMWaveHdr(lpWaveHdr)^.LoopRec.dwLooping := False;
                  LeaveCritical;
                  if assigned(FOnLooping) then FOnLooping(Self);
               end;

               { send the next buffer to the driver }
               if (LoadWaveHeader(lpWaveHdr) <= 0) and not FStopIt  then
                  Error(LoadResStr(IDS_FILLERROR));

               if not FStopIt then QueueWaveHeader(lpWaveHdr);
            end;

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

      finally
         dec(FInHandler);
         { can we stop it ? }
         if (FInHandler = 0) then  { no more buffers, stop }
             if FStopIt or (FBufferCounter = 0) then
             begin
                FStopping := True;

                {$IFDEF _MMDEBUG}
                DebugStr(0,'Stop Message posted...');
                {$ENDIF}

                { pause the device first so it stops playing }
                { some cards play the last buffer looped ! }
                FError := DSWaveOutPause(FHDSWaveOut);
                if FError <> 0 then
                   Error('DSWaveOutPause:'#10#13+LoadResStr(IDS_PAUSEERROR));

                PostMessage(FHandle,MM_WOM_STOP,FHDSWaveOut,0);
             end;
      end;
   end;
end;

{-- TMMDSWaveOut --------------------------------------------------------}
procedure TMMDSWaveOut.DSWaveOutHandler(Var Msg: TMessage );
begin
  with Msg do
  try
      if (wParam = FHDSWaveOut) then
      case msg of
         MM_WOM_DONE: begin
     	   	         { done playing queued wave buffer... }
                         ProcessWaveHeader(PWaveHdr(lparam));
                         exit;
                      end;
         MM_WOM_STOP: begin
                         {$IFDEF _MMDEBUG}
                         DebugStr(0,'Stop message received...');
                         {$ENDIF}

                         { should stop the device }
                         Stop;
                         exit;
                      end;
      end;
      Result := DefWindowProc(FHandle, Msg, wParam, lParam);

  except
     if assigned(FOnError) then FOnError(Self);
     Close;
     Application.HandleException(Self);
  end;
end;

{-- DSWaveOutFunc -------------------------------------------------------}
procedure DSWaveOutFunc(hWaveOut:HWaveOut;wMsg:UINT;dwInstance,dwParam1,dwParam2:Longint);
begin
   if (dwInstance <> 0) then
   with TMMDSWaveOut(dwInstance) do
   try
      case wMsg of
         WOM_OPEN :
         begin
            { device is now open }
            FState := [dssOpen];
         end;
         WOM_CLOSE:
         begin
            { device is now closed }
            FState := [dssClose];
         end;
         WOM_DONE :
         begin
            { device has returnded a buffer }
            dec(FBufferCounter);
            if FReseting then
            begin
               if FBufferCounter = 0 then FReseting := False;
            end
            else if not FStopping then
            case FCallBackMode of
                cmCallBack: ProcessWaveHeader(PWaveHdr(dwparam1));
                  cmWindow: PostMessage(FHandle,MM_WOM_DONE,hWaveOut,dwParam1);
                {$IFDEF WIN32}
                  cmThread: PostThreadMessage(FOutThread.ThreadID,MM_WOM_DONE,hWaveOut,dwParam1);
                {$ENDIF}
            end;
         end;
      end;

   except
      Close;
      Application.HandleException(TMMDSWaveOut(dwInstance));
   end;
end;

{-------------------------------------------------------------------------}
procedure TMMDSWaveOutThread.Execute;
{- Wait for and process output messages }
var
   Res  : DWORD;
   Msg  : TMsg;
   {$IFDEF _MMDEBUG}
   _Error: DWORD;
   {$ENDIF}
   Handles: array[0..1] of THandle;

begin
   with TMMDSWaveOut(Owner) do
   try
      Priority := DSWAVEOUT_PRIORITY;

      Handles[0] := FCloseEvent;
      Handles[1] := FResetEvent;

      { Ready to go, set the output event }
      SetEvent(FOutEvent);

      { Repeat until device is closed }
      while not Terminated do
      try
         if not PeekMessage(msg, 0, 0, 0, PM_REMOVE) then
         begin
            Res := MsgWaitForMultipleObjects(2, Handles, 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
                   {$IFDEF _MMDEBUG}
                   DebugStr(0,'CloseEvent signaled...');
                   {$ENDIF}

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

                   { remove all pending Messages from the queue }
                   while PeekMessage(Msg, 0, MM_WOM_DONE, MM_WOM_DONE, PM_REMOVE) do;
                   ResetEvent(FResetEvent);

                   Continue;
                end;
                WAIT_OBJECT_0+2:    { New message was received.      }
                begin
                   {$IFDEF _MMDEBUG}
                   DebugStr(2,'WaveOut message reveived...');
                   {$ENDIF}

                   { Get the message that woke us up by looping again.}
                   Continue;
                end;
            end;
         end;

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

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

      except
         FThreadError := True;
         Application.HandleException(nil);

         if (FHDSWaveOut <> 0) then
         begin
            FClosing := True;
            Stop;
            DSWaveOutClose(FHDSWaveOut);
            DoClosed;
            CloseEvents;
         end;
         exit;
      end;

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

     SetEvent(FOutEvent);
   end;
end;

{$IFDEF _MMDEBUG}
initialization
   DB_Level(DEBUGLEVEl);
{$ENDIF}
end.