mmtrigg.pas

一套及时通讯的原码

procedure TMMTrigger.DoneCritical;
begin
   {$IFDEF WIN32}
   if DataSectionOK then
   begin
      DataSectionOK := False;
      DeleteCriticalSection(DataSection);
   end;
   {$ENDIF}
end;

{-- TMMTrigger -----------------------------------------------------------}
Procedure TMMTrigger.Open;
begin
   if (PWaveFormat = Nil) then
       Error('TriggerOpen:'#10#13+LoadResStr(IDS_NOFORMAT));

   if (trOpen in FState) then Close;

   if (Not(trOpen in FState)) and not FClosing then
   begin
      FClosing  := False;
      FStopping := False;
      try
         FCloseIt := False;

         { Create the window for callback notification }
         if (FHandle = 0) then FHandle := AllocateHwnd(TriggerHandler);

         inherited Opened;

         { create critical section object }
         InitCritical;

         {$IFDEF WIN32}
         InitThread;
         {$ENDIF}

         { create the Trigger header and buffer }
         AllocWaveHeader(FWaveHdr);

         FState := [trOpen];

         DoOpened;

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

{-- TMMTrigger -----------------------------------------------------------}
Procedure TMMTrigger.Close;
begin
   if (trOpen in FState) and (not FClosing or FCloseIt) then
   try
      FClosing := True;

      { stop playing }
      if (trPlay in FState) or (trPause in Fstate) then Stop;

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

         FState := [trClose];

         { notify all other components }
         inherited Closed;

         { shot down the thread and remove critical section }
         {$IFDEF WIN32}
         DoneThread;
         {$ENDIF}

         { free header memory and remove }
         FreeWaveHeader;

         DoClosed;
      end;

   except
      FClosing := False;
   end;
end;

{-- TMMTrigger ------------------------------------------------------------}
Procedure TMMTrigger.Start;
begin
   try
      if not (trOpen in FState) then Open;

      if (trOpen in FState) and not (trPlay in FState) then
      begin
         { setup for playing }

         { reset the total bytes played counter }
         FBytesPlayed := 0;
         FInHandler := 0;
         FStarted := False;
         FStopIt := False;
         FStopping := False;

         { now notify all other components }
         inherited Started;

         FMoreBuffers := True;

         FState := FState + [trPlay];

         { fill the buffer }
         if LoadWaveHeader(FWaveHdr) > 0 then
            QueueWaveHeader(FWaveHdr);

         DoStarted;
      end;

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

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

      if (trOpen in FState) and (not (trPause in FState)) then
      begin
         if (trPlay in FState) then
         try
            EnterCritical;

            {$IFDEF WIN32}
            FTriggerThread.Suspend;
            {$ENDIF}

            FState := FState + [trPause];

         finally
            LeaveCritical;
         end;

         DoPaused;
      end;

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

{-- TMMTrigger ------------------------------------------------------------}
procedure TMMTrigger.Restart;
begin
   try
      if (trPlay in FState) and (trPause in FState) then
      begin
         {$IFDEF WIN32}
         FTriggerThread.Resume;
         {$ENDIF}

         DoRestarted;
      end;

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

{-- TMMTrigger ------------------------------------------------------------}
procedure TMMTrigger.Stop;
begin
   if (trPlay in FState) or (trPause in FState) then
   begin
      try
         EnterCritical;
         try
            FStopping := True;
         finally
            LeaveCritical;
         end;

         DoStopped;

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

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

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

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

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

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

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

{-- TMMTrigger -----------------------------------------------------------}
procedure TMMTrigger.DoOpened;
begin
   if Assigned(FOnOpen) then FOnOpen(Self);
end;

{-- TMMTrigger -----------------------------------------------------------}
procedure TMMTrigger.DoClosed;
begin
   FClosing := False;

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

{-- TMMTrigger -----------------------------------------------------------}
procedure TMMTrigger.DoStarted;
begin
   if (FWaveHdr <> nil) and (FWaveHdr^.dwBytesRecorded > 0) then
   begin
      if not (trPause in FState) then
      begin
         { start the perpedum mobile :-) }
         {$IFDEF WIN32}
         SetEvent(FTriggerEvent);
         {$ENDIF}
      end;

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

{-- TMMTrigger -----------------------------------------------------------}
procedure TMMTrigger.DoPaused;
begin
   FState := FState + [trPause];

   inherited Paused;

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

{-- TMMTrigger -----------------------------------------------------------}
procedure TMMTrigger.DoRestarted;
begin
   FState := FState - [trPause];

   inherited Restarted;

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

{-- TMMTrigger -----------------------------------------------------------}
procedure TMMTrigger.DoStopped;
begin
   if (trPlay in FState) or (trPause in FState) then
   begin
      if (FInHandler > 0) then FStopIt := True
      else
      begin
         FState := FState - [trPlay,trPause];

         FStopIt := False;

         { notify all other components }
         inherited Stopped;

         if assigned(FOnStop) then FOnStop(Self);

         if FCloseIt then Close;
      end;
   end;
end;

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

{-- TMMTrigger -----------------------------------------------------------}
procedure TMMTrigger.BufferLoad(lpwh: PWaveHdr; var MoreBuffers: Boolean);
begin
   with PMMWaveHdr(lpwh)^ do
   begin
      wh.dwBufferLength := BufferSize;
      wh.dwBytesRecorded := 0;
      LoopRec.dwLoop := False;

      inherited BufferLoad(lpwh, MoreBuffers);

      wh.dwBufferLength := wh.dwBytesRecorded;
   end;
end;

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

{-- TMMTrigger -----------------------------------------------------------}
procedure TMMTrigger.DoBufferReady(lpwh: PWaveHdr);
begin
   { buffer has returned from driver, notify the other components }
   inherited BufferReady(lpwh);
end;

{-- TMMTrigger -----------------------------------------------------------}
procedure TMMTrigger.ProcessWaveHeader(lpWaveHdr: PWaveHdr);
begin
   if (trPlay in FState) and not FStopping then
   begin
      inc(FInHandler);
      try
         EnterCritical;
         try
            inc(FBytesPlayed, lpWaveHdr^.dwBufferLength);
         finally
            LeaveCritical;
         end;

         try
            DoBufferReady(lpWaveHdr);

            {$IFDEF _MMDEBUG}
            DebugStr(2,'DoBufferReady Done...');
            {$ENDIF}

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

               if not FStopIt then
               begin
                  QueueWaveHeader(lpWaveHdr);
                  if not FMoreBuffers then DoBufferReady(lpWaveHdr);
               end;
            end;

         except
            FHandled := False;
            if assigned(FOnError) then FOnError(Self);
            if assigned(FOnErrorEx) then FOnErrorEx(Self,FHandled);
            if not FHandled then
               raise;
         end;

      finally
         dec(FInHandler);
         { can we stop it ? }
         if (FInHandler = 0) then  { no more buffers, stop }
             if FStopIt or not FMoreBuffers then
             begin
                FStopping := True;
                PostMessage(FHandle,MM_WOM_STOP,0,0);
             end;
      end;
   end;
end;

{-- TMMTrigger -----------------------------------------------------------}
procedure TMMTrigger.TriggerHandler(Var Msg: TMessage );
begin
  with Msg do
  try
      case msg of
         MM_WOM_STOP: begin
                         { should stop the device }
                         Stop;
                         exit;
                      end;
      end;
      Result := DefWindowProc(FHandle, Msg, wParam, lParam);

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

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

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

      Priority := TRIGGER_PRIORITY;

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

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

      { Ready to go, set the general event }
      SetEvent(FGeneralEvent);

      { Repeat until device is closed }
      while not Terminated do
      try
         Res := WaitForMultipleObjects(2, @Handles, False, INFINITE);
         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:    { TriggerEvent received.         }
              begin
                 {$IFDEF _MMDEBUG}
                 DebugStr(2,'Trigger message reveived...');
                 {$ENDIF}

                 if not FStopping then ProcessWaveHeader(FWaveHdr);
                 if not FStopping then Sleep(Max(FInterval,1));
                 if not FStopping then SetEvent(FTriggerEvent);
                 if not FStopping then WinYield(Application.Handle);
                 Continue;
              end;
         end;

      except
         FThreadError := True;
         Application.HandleException(nil);
         if trOpen in FState then Close;
         CloseEvents;
         exit;
      end;

   finally
     if not FThreadError then SetEvent(FGeneralEvent);

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

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