mmwavout.pas

一套及时通讯的原码

         begin
            { fill the buffer and send to driver }
            if LoadWaveHeader(FWaveOutHdrs[i]) > 0 then
               QueueWaveHeader(FWaveOutHdrs[i])
            else break;
            inc(i);
         end;
         FBuffersUsed := i;

         { start the buffers playing (unpause) }
         if not (wosPause in FState) then
         begin
            FError := WaveOutRestart(FHWaveOut);
            if FError <> 0 then
               Error('WaveOutRestart:'#10#13+WaveOutErrorString(FError));
         end;

         if FBuffersUsed = 0 then Stop;

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

{-- TMMWaveOut ------------------------------------------------------------}
Procedure TMMWaveOut.Start;
Var
   oldCursor: TCursor;
   i: integer;

begin
   try
      if not (wosOpen in FState) then Open;

      if (wosOpen in FState) and not (wosPlay in FState) then
      begin
         { setup for playing }

         { reset the total bytes played counter }
         FBytesPlayed := 0;
         FOldPosition := 0;
         FLastPosition := 0;
         FWrapArrounds := 0;
         FWrapSize := 0;
         FLoopPos := 0;
         FLoopTempCount := FLoopCount;
         FInHandler := 0;
         FStarted := False;
         FStopIt := False;
         FReseting := False;
         FStopping := False;
         FPosted := False;
         FBufferOutIdx := 0;
         FBufferCounter := 0;

         { change the cursor to HourGlass }
         oldCursor := Screen.Cursor;
         if FShowHourGlass and (BufferSize * NumBuffers > 100000) then
            Screen.Cursor := crHourGlass;
         try
            {$IFDEF _MMDEBUG}
            DebugStr(0,'Try to start device...');
            {$ENDIF}

            { pause the output so the buffers won't play until we tell it to }
            FError := WaveOutPause(FHWaveOut);
            if FError <> 0 then
               Error('WaveOutPause:'#10#13+WaveOutErrorString(FError));

            { now notify all other components }
            inherited Started;

            FMoreBuffers := True;

            i := 0; { Load the number of buffers required }
            while (i < FNumBuffers) and FMoreBuffers do
            begin
               { create the waveOut header and buffer }
               AllocWaveHeader(FWaveOutHdrs[i]);

               {$IFDEF _NUMERATE}
               FWaveOutHdrs[i]^.dwUser := i;
               {$ENDIF}

               { prepare the waveform header for playing }
               PrepareWaveHeader(FWaveOutHdrs[i]);

               { fill the buffer and send to driver }
               if LoadWaveHeader(FWaveOutHdrs[i]) > 0 then
                  QueueWaveHeader(FWaveOutHdrs[i])
               else break;
               inc(i);
            end;
            FBuffersUsed := i;

            FState := FState + [wosPlay];

         finally
            Screen.Cursor := oldCursor;
         end;

         DoStarted;
      end;

   except
      if assigned(FOnError) then FOnError(Self);
      FState := FState + [wosPlay];
      Close;
      FState := [wosClose];
      raise;
   end;
end;

{-- TMMWaveOut ------------------------------------------------------------}
procedure TMMWaveOut.Pause;
begin
   try
      if not (wosOpen in FState) then Open;

      if (wosOpen in FState) and (not (wosPause in FState)) then
      begin
         if (wosPlay in FState) then
         try
            EnterCritical;

            {$IFDEF _MMDEBUG}
            DebugStr(0,'Try to pause device...');
            {$ENDIF}

            FError := WaveOutPause(FHWaveOut);
            if FError <> 0 then
               Error('WaveOutPause:'#10#13+WaveOutErrorString(FError));

            FState := FState + [wosPause];

            if FFullDuplex then
            begin
               inc(FOldPosition, GetSamplePosition);

               FReseting := True;
               FError := WaveOutReset(FHWaveOut);
               if FError > 0 then
                  Error('WaveOutReset:'#10#13+WaveOutErrorString(FError));

               FBufferOutIdx := 0;
               FBufferCounter := 0;
            end;

         finally
            LeaveCritical;
         end;

         DoPaused;
      end;

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

{-- TMMWaveOut ------------------------------------------------------------}
procedure TMMWaveOut.Restart;
begin
   try
      if (wosPlay in FState) and (wosPause in FState) then
      begin
         FReseting := False;

         {$IFDEF _MMDEBUG}
         DebugStr(0,'Try to restart device...');
         {$ENDIF}

         inherited Restarted;

         FError := WaveOutRestart(FHWaveOut);
         if FError <> 0 then
            Error('WaveOutRestart:'#10#13+WaveOutErrorString(FError));

         DoRestarted;
      end;

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

{-- TMMWaveOut ------------------------------------------------------------}
procedure TMMWaveOut.Stop;
begin
   if (wosPlay in FState) or (wosPause in FState) then
   begin
      try
         EnterCritical;
         try
            FStopping := True;
            FReseting := True;

            {$IFDEF _MMDEBUG}
            if (FInHandler > 0) then
               DebugStr(0,'Try to stop device (while in Handler)...')
            else
               DebugStr(0,'Try to stop device...');
            {$ENDIF}

         finally
            LeaveCritical;
         end;

         { save the stop position }
         FEndingPosition := Position;
         FWrapArrounds   := 0;
         FWrapSize       := 0;

         FError := WaveOutReset(FHWaveOut);
         if FError > 0 then
            Error('WaveOutReset:'#10#13+WaveOutErrorString(FError));

         DoStopped;

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

{-- TMMWaveOut -----------------------------------------------------------}
procedure TMMWaveOut.Opened;
begin
   Open;
end;

{-- TMMWaveOut -----------------------------------------------------------}
procedure TMMWaveOut.Closed;
begin
   Close;
end;

{-- TMMWaveOut -----------------------------------------------------------}
procedure TMMWaveOut.Started;
begin
   Start;
end;

{-- TMMWaveOut -----------------------------------------------------------}
procedure TMMWaveOut.Paused;
begin
   Pause;
end;

{-- TMMWaveOut -----------------------------------------------------------}
procedure TMMWaveOut.Restarted;
begin
   Restart;
end;

{-- TMMWaveOut -----------------------------------------------------------}
procedure TMMWaveOut.Stopped;
begin
   Stop;
end;

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

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

{-- TMMWaveOut -----------------------------------------------------------}
procedure TMMWaveOut.DoClosed;
begin
   FHWaveOut := 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;

{-- TMMWaveOut -----------------------------------------------------------}
procedure TMMWaveOut.DoStarted;
begin
   if (FBuffersUsed > 0) then
   begin
      if not (wosPause in FState) then
      begin
         { start the buffers playing (unpause) }
         FError := WaveOutRestart(FHWaveOut);
         if FError <> 0 then
            Error('WaveOutRestart:'#10#13+WaveOutErrorString(FError));
      end;

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

      InitDSPMeter;

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

{-- TMMWaveOut -----------------------------------------------------------}
procedure TMMWaveOut.DoPaused;
begin
   FState := FState + [wosPause];

   inherited Paused;

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

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

{-- TMMWaveOut -----------------------------------------------------------}
procedure TMMWaveOut.DoRestarted;
begin
   FState := FState - [wosPause];

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

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

{-- TMMWaveOut -----------------------------------------------------------}
procedure TMMWaveOut.DoStopped;
var
   TimeOut: integer;

begin
   if (wosPlay in FState) or (wosPause in FState) then
   begin
      if (FInHandler > 0) then FStopIt := True
      else
      begin
         FState := FState - [wosPlay,wosPause];

         DoneDSPMeter;

         TimeOut := 500;
         { wait until all buffers returned }
         repeat
             {$IFDEF _USE_CALLBACK}
             if _Win9x_ or _WinNT4_ then
                Delay(10,False)
             else
             {$ENDIF}
                Delay(10,True);
            dec(TimeOut);
         until (FBufferCounter = 0) or (TimeOut <= 0);

         {$IFDEF _MMDEBUG}
         if (FBufferCounter > 0) then
             DebugStr(0,'TimeOut while waiting for returned headers!');
         {$ENDIF}

         { notify all other components }
         inherited Stopped;

         { unprepare wave headers }
         UnPrepareWaveHeaders;

         { free header memory and remove }
         FreeWaveHeaders;

         FBuffersUsed := 0;
         FBufferCounter := 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;

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

{-- TMMWaveOut -----------------------------------------------------------}
procedure TMMWaveOut.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