mmdswout.pas

一套及时通讯的原码

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

{$IFDEF BUILD_ACTIVEX}
         DSSetHWND(0, ParentWindow);
{$ELSE}
         if (Owner <> nil) then
         begin
            if (Owner is TForm) then
                DSSetHWND(0, TForm(Owner).Handle)
            else if (Owner.Owner <> nil) then
                DSSetHWND(0, TForm(Owner.Owner).Handle);
         end;
{$ENDIF}
         { create critical section object }
         InitCritical;

         if (FCallBackMode = cmThread) then InitThread;

         { now open Wave output device. }
         FError := DSWaveOutOpen(@FHDSWaveOut,
                                 integer(Devices[DeviceId].lpGUID),
                                 Pointer(PWaveFormat),
                                 Longint(@DSWaveOutFunc),
                                 Longint(Self),
                                 DS_NEEDVOLUME or DS_NEEDPAN or DS_NEEDFREQ or
                                 CALLBACK_FUNCTION);
         if (FError <> 0) then
	     Error('DSWaveOutOpen:'#10#13+LoadResStr(IDS_OPENERROR));

         FError := DSCreatePrimaryBuffer(FHDSWaveOut, PWaveFormat);
         if (FError <> 0) then
	     Error('DSWaveOutOpen:'#10#13+LoadResStr(IDS_PRIMARYERROR));

         { set the initial volume }
         FError := DSWaveOutSetVolume(FHDSWaveOut, FVolume);
         if (FError <> 0) then
	     Error('DSWaveOutSetVolume:'#10#13+LoadResStr(IDS_VOLUMEERROR));

         { set the initial pan }
         FError := DSWaveOutSetPan(FHDSWaveOut, FPan);
         if (FError <> 0) then
	     Error('DSWaveOutSetPan:'#10#13+LoadResStr(IDS_PANERROR));

         { set the initial frequency to FPWaveFormats }
         //FRate := 0;
         FError := DSWaveOutSetPlayBackRate(FHDSWaveOut, FRate);
         if (FError <> 0) then
	     Error('DSWaveOutSetPlayBackRate:'#10#13+LoadResStr(IDS_RATEERROR));

         TimeOut := 100;
         { wait until the device returns its status }
         repeat
             Delay(10,False);
             dec(TimeOut);
         until (dssOpen in FState) or (TimeOut <= 0);

         if (TimeOut <= 0) then
	     Error('DSWaveOutOpen:'#10#13+LoadResStr(IDS_CANTOPENDEVICE));

         DoOpened;

      except
         if assigned(FOnError) then FOnError(Self);
         FState := [dssOpen];
         Close;
         FState := [dssClose];
         raise;
      end;
   end;
end;

{-- TMMDSWaveOut --------------------------------------------------------}
Procedure TMMDSWaveOut.Close;
var
   TimeOut: integer;
begin
   if (dssOpen in FState) and (not FClosing or FCloseIt) then
   try
      FClosing := True;

      { stop playing }
      if (dssPlay in FState) or (dssPause in FState) then Stop;

      { Close the device (finally!) }
      if FStopIt then FCloseIt := True
      else
      begin
         FCloseIt := False;

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

            FError := DSWaveOutClose(FHDSWaveOut);
            if FError <> 0 then
               Error('DSWaveOutClose:'#10#13+LoadResStr(IDS_CLOSEERROR));

            TimeOut := 100;
            { wait until the device returns its status }
            repeat
               Delay(10,False);
               dec(TimeOut);
            until (dssClose in FState) or (TimeOut <= 0);

         end
         else
         begin
            FState := [dssClose];
         end;

         inherited Closed;

         if (FCallBackMode = cmThread) then
             { shot down the thread }
             DoneThread;

         DoClosed;

         if (TimeOut <= 0) then
     	     Error('DSWaveOutOpen:'#10#13+LoadResStr(IDS_CANTCLOSEDEVICE));
      end;

   except
      FClosing := False;
   end;
end;

{-- TMMDSWaveOut --------------------------------------------------------}
Procedure TMMDSWaveOut.Reset;
var
   i: integer;
   TimeOut: Longint;
   Msg: TMsg;

begin
   if ((dssPlay in FState) or (dssPause in FState)) and not FReseting then
   begin
      try
         FReseting := True;

         if not (dssPause in FState) then
         begin
            FError := DSWaveOutPause(FHDSWaveOut);
            if FError <> 0 then
               Error('DSWaveOutPause:'#10#13+LoadResStr(IDS_PAUSEERROR));
         end;

         if (FCallBackMode = cmWindow) then
            { remove all pending Messages from the queue }
            while PeekMessage(Msg, FHandle, MM_WOM_DONE, MM_WOM_DONE, PM_REMOVE) do
         {$IFDEF WIN32}
         else if (FCallBackMode = cmThread) then
         begin
            { remove all pending messages from threads queue }
            SetEvent(FResetEvent);
            { Wait for it to reset... }
            while WaitForSingleObject(FResetEvent, 0) = WAIT_OBJECT_0 do;
         end;
         {$ENDIF};

         FError := DSWaveOutReset(FHDSWaveOut);
         if FError > 0 then
            Error('DSWaveOutReset:'#10#13+LoadResStr(IDS_RESETERROR));

         TimeOut := 100;
         repeat
             Delay(10,False);
             dec(TimeOut);
         until not FReseting or (TimeOut <= 0);

         FBufferInIdx := 0;
         FBufferOutIdx := 0;
         FBufferCounter := 0;
         FOldPosition := 0;
         FLoopPos := 0;

         { notify all other components }
         Reseting;

         FMoreBuffers := True;

         { Load the number of buffers required }
         i := 0;
         while (i < FNumBuffers) and FMoreBuffers do
         begin
            { fill the buffer and send to driver }
            if LoadWaveHeader(FDSWaveOutHdrs[i]) > 0 then
               QueueWaveHeader(FDSWaveOutHdrs[i])
            else break;
            inc(i);
         end;
         FBuffersUsed := i;

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

         if FBuffersUsed = 0 then Stop;

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

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

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

      if (dssOpen in FState) and not (dssPlay in FState) then
      begin
         { setup for playing }

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

         { change the cursor to HourGlass }
         oldCursor := Screen.Cursor;
         if (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 := DSWaveOutPause(FHDSWaveOut);
            if FError <> 0 then
               Error('DSWaveOutPause:'#10#13+LoadResStr(IDS_PAUSEERROR));

            { 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(FDSWaveOutHdrs[i]);

               {$IFDEF NUMERATE}
               FDSWaveOutHdrs[i]^.dwUser := i;
               {$ENDIF}

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

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

            FState := FState + [dssPlay];

         finally
            Screen.Cursor := oldCursor;
         end;

         DoStarted;
      end;

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

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

      if (dssOpen in FState) and (not (dssPause in FState)) then
      begin
         if (dssPlay in FState) then
         try
            EnterCritical;

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

            FError := DSWaveOutPause(FHDSWaveOut);
            if FError <> 0 then
               Error('DSWaveOutPause:'#10#13+LoadResStr(IDS_PAUSEERROR));

            FState := FState + [dssPause];

            if FFullDuplex then
            begin
               inc(FOldPosition, GetSamplePosition);

               FReseting := True;
               FError := DSWaveOutReset(FHDSWaveOut);
               if FError > 0 then
                  Error('DSWaveOutReset:'#10#13+LoadResStr(IDS_RESETERROR));

               FBufferInIdx := 0;
               FBufferOutIdx := 0;
               { ev. warten bis alle puffer zur點k ! Oder in Restart ? }
            end;

         finally
            LeaveCritical;
         end;

         DoPaused;
      end;

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

{-- TMMDSWaveOut --------------------------------------------------------}
procedure TMMDSWaveOut.Restart;
begin
   try
      if (dssPlay in FState) and (dssPause in FState) then
      begin
         FReseting := False;

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

         FError := DSWaveOutRestart(FHDSWaveOut);
         if FError <> 0 then
            Error('DSWaveOutRestart:'#10#13+LoadResStr(IDS_RESTARTERROR));

         DoRestarted;
      end;

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

{-- TMMDSWaveOut --------------------------------------------------------}
procedure TMMDSWaveOut.Stop;
begin
   if (dssPlay in FState) OR (dssPause 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}

            FError := DSWaveOutReset(FHDSWaveOut);
            if FError > 0 then
               Error('DSWaveOutReset:'#10#13+LoadResStr(IDS_RESETERROR));

         finally
            LeaveCritical;
         end;

         DoStopped;

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

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

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

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

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

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

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

{-- TMMDSWaveOut --------------------------------------------------------}