mmwavout.pas

一套及时通讯的原码

            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;

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

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

      { BUG-FIX for NT 4.0 SP4, it does set dwBytesRecorded to zero }
      lpwh^.dwBytesRecorded := PMMWaveHdr(lpwh)^.dwUser2;

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

      { BUG-FIX for NT 4.0 SP4, it does set dwBytesRecorded to zero }
      PMMWaveHdr(PMMWaveHdr(lpwh)^.lpNext)^.wh.dwBytesRecorded := PMMWaveHdr(PMMWaveHdr(lpwh)^.lpNext)^.dwUser2;

      inherited BufferReady(lpwh);

   finally
      StopDSPMeter;
   end;
end;

{-- TMMWaveOut -----------------------------------------------------------}
procedure TMMWaveOut.ProcessWaveHeader(lpWaveHdr: PWaveHdr);
var
   CurPos,LastPos: Cardinal;
   Wrapped: integer;
   TimeOut: Longint;
begin
   if (wosPlay 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 := FWaveOutHdrs[FBufferOutIdx]
         else
            WaveOutUnPrepareHeader(FHWaveOut, lpWaveHdr, sizeOf(TWaveHdr));

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

         EnterCritical;
         FBytesPlayed := FBytesPlayed + lpWaveHdr^.dwBufferLength;
         LeaveCritical;

         try
            DoBufferReady(lpWaveHdr);

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

            {$IFDEF WIN32}
            { wrap arround handling }
            CurPos := GetSamplePosition;
            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;

            {$IFDEF _MMDEBUG}
            if Wrapped <> 0 then
            begin
               DB_WriteStr(0,'Wrapped, LastPos: '+IntToStr(FLastPosition)+' (');
               DB_WriteHex(0,FLastPosition);
               DB_WriteStr(0,'), CurPos: '+IntToStr(CurPos)+' (');
               DB_WriteHex(0,CurPos);
               DB_WriteStr(0,'), WrapSize: '+IntToStr(FWrapSize)+' (');
               DB_WriteHex(0,FWrapSize);
               DB_WriteStr(0,'), Position: '+TimeToString64Ex(Position,True));
               DB_WriteStrLn(0,')');
            end;
            {$ENDIF}

            FLastPosition := CurPos;
            {$ENDIF}

            if FMoreBuffers and not FStopIt then
            begin
               { file restarted ? }
               if FLooping and PMMWaveHdr(lpWaveHdr)^.LoopRec.dwLooping then
               begin
                  EnterCritical;
                  { adjust GetPosition }
                  FLoopPos := CurPos;
                  PMMWaveHdr(lpWaveHdr)^.LoopRec.dwLooping := False;
                  LeaveCritical;
                  
                  { notify other components that we have looped }
                  Looped;
                  if assigned(FOnLooping) then FOnLooping(Self);
               end;

               { wait until the buffer is marked as done, or we get trouble ! }
               TimeOut := 65000;
               { wait until the buffer is marked as done }
               while (lpWaveHdr^.dwFlags and WHDR_DONE <> WHDR_DONE) and (TimeOut > 0) do
               begin
                  dec(TimeOut);
                  {$IFDEF WIN32}
                  Sleep(2);
                  {$ENDIF}
               end;

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

               { send the next buffer to the driver }
               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)) and not FPosted then
             begin
                FPosted := True;
                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 := WaveOutPause(FHWaveOut);
                if FError <> 0 then
                   Error('WaveOutPause:'#10#13+WaveOutErrorString(FError));

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

{-- TMMWaveOut -----------------------------------------------------------}
procedure TMMWaveOut.WaveOutHandler(Var Msg: TMessage);
begin
  with Msg do
  try
      if (wParam = FHWaveOut) then
      case msg of
        MM_WOM_OPEN :
        begin
           { device is now open }
           FState := [wosOpen];
        end;
        MM_WOM_CLOSE:
        begin
           { device is now closed }
           FState := [wosClose];
        end;
        MM_WOM_DONE : begin
                         {$IFDEF _USE_CALLBACK}
                         if not _Win9x_ and not _WinNT4_ then
                         {$ENDIF}
                         begin
                            dec(FBufferCounter);
                            if FReseting then
                            begin
                               if FBufferCounter = 0 then FReseting := False;
                               exit;
                            end;
                         end;
                         if not FStopping then 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;

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

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

begin
   with TMMWaveOut(Owner) do
   try
      {$IFDEF _MMDEBUG}
      DebugStr(0,'Setting Thread Priority');
      {$ENDIF}

      SetPriority(FPriority);

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

      { make sure we have a message queue... }
      PeekMessage(Msg, 0, 0, 0, PM_NOREMOVE);

      {$IFDEF _MMDEBUG}
      DebugStr(0,'Setting OutEvent,ready to go !');
      {$ENDIF}

      { 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}
                   Err := GetLastError;
                   DebugStr(0,'Wait Failed... Error: '+SysErrorMessage(Err));
                   {$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 = FHWaveOut) and (message = MM_WOM_DONE) then
            begin
               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;
         if (FHWaveOut <> 0) then
         begin
            FClosing := True;
            Stop;
            WaveOutClose(FHWaveOut);
            DoClosed;
            CloseEvents;
         end;
         Application.HandleException(nil);
         exit;
      end;

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

     if not FThreadError then SetEvent(FOutEvent);
   end;
end;
{$ENDIF}

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