mmwavout.pas

一套及时通讯的原码

      {$IFDEF _MMDEBUG}
      DebugStr(2,'Try to send Wave-Header '+IntToStr(lpWaveHdr^.dwUser)+' to driver');
      {$ENDIF}

      PMMWaveHdr(lpWaveHdr)^.dwUser2 := lpWaveHdr^.dwBytesRecorded;

      { now queue the buffer for output }
      FError := WaveOutWrite(FHWaveOut,
                             lpWaveHdr,
                             SizeOf(TWAVEHDR));

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

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

      EnterCritical;
      inc(FBufferCounter);
      LeaveCritical;

      {$IFDEF _MMDEBUG}
      DebugStr(2,'Wave-Header '+IntToStr(lpWaveHdr^.dwUser)+' queued');
      {$ENDIF}
   end;
end;

{$IFDEF WIN32}
{-- TMMWaveOut -----------------------------------------------------------}
procedure TMMWaveOut.SynchronizeVCL(VCLProc: TThreadMethod);
begin
   if (FCallBackMode = cmThread) and (FOutEvent <> 0) then
   begin
      FOutThread.Synchronize(VCLProc);
   end
   else VCLProc;
end;

{-- TMMWaveOut -----------------------------------------------------------}
procedure TMMWaveOut.SetPriority(aValue: TThreadPriority);
begin
   FPriority := aValue;
   if (FOutThread <> nil) then
       FOutThread.Priority := FPriority;
end;

{-- TMMWaveOut -----------------------------------------------------------}
procedure TMMWaveOut.InitThread;
begin
   if (FCallBackMode = cmThread) then
   begin
      EnterCritical;
      try
         FThreadError := False;

         { create event objects }
         FOutEvent    := CreateEvent(nil, False, False, nil);
         FCloseEvent  := CreateEvent(nil, False, False, nil);
         FResetEvent  := CreateEvent(nil, True, False, nil);

         { create the output thread }
         FOutThread := TMMWaveOutThread.CreateSuspended(Self);
         if (FOutThread = nil) then
             Error('WaveOut:'#10#13+LoadResStr(IDS_THREADERROR));

         FOutThread.FreeOnTerminate := True;
         FOutThread.Resume;

         {$IFDEF _MMDEBUG}
         DebugStr(0,'Wait for Thread start...');
         {$ENDIF}

         { Wait for it to start... }
         if WaitForSingleObject(FOutEvent, 5000) <> WAIT_OBJECT_0 then
            Error('WaveOut:'#10#13+LoadResStr(IDS_THREADERROR));

         {$IFDEF _MMDEBUG}
         DebugStr(0,'Thread Started');
         {$ENDIF}

      finally
        LeaveCritical;
      end;
   end;
end;

{-- TMMWaveOut -----------------------------------------------------------}
procedure TMMWaveOut.DoneThread;
begin
   if (FCallBackMode = cmThread) and (FOutEvent <> 0) and not FThreadError then
   begin
      { Force the output thread to close... }
      SetEvent(FCloseEvent);

      { ...and wait for it to die }
      WaitForSingleObject(FOutEvent, 5000);

      { close all events and remove critical section }
      CloseEvents;

      {$IFDEF _MMDEBUG}
      DebugStr(0,'Thread Terminated');
      {$ENDIF}
   end;
end;

{-- TMMWaveOut -----------------------------------------------------------}
procedure TMMWaveOut.CloseEvents;
begin
   if (FOutEvent <> 0) then
   begin
      { release events }
      CloseHandle(FOutEvent);
      CloseHandle(FCloseEvent);
      CloseHandle(FResetEvent);
      FOutEvent := 0;
      FCloseEvent := 0;
      FResetEvent := 0;

      { Free the critical section }
      DoneCritical;
   end;
end;
{$ENDIF}

{-- TMMWaveOut -----------------------------------------------------------}
procedure TMMWaveOut.InitCritical;
begin
   {$IFDEF WIN32}
   { create critical section object }
   FillChar(DataSection, SizeOf(DataSection), 0);
   InitializeCriticalSection(DataSection);
   DataSectionOK := True;
   {$ENDIF}
end;

{-- TMMWaveOut -----------------------------------------------------------}
procedure TMMWaveOut.EnterCritical;
begin
   {$IFDEF WIN32}
   if DataSectionOK then
      EnterCriticalSection(DataSection);
   {$ENDIF}
end;

{-- TMMWaveOut -----------------------------------------------------------}
procedure TMMWaveOut.LeaveCritical;
begin
   {$IFDEF WIN32}
   if DataSectionOK then
      LeaveCriticalSection(DataSection);
   {$ENDIF}
end;

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

{-- TMMWaveOut -----------------------------------------------------------}
Procedure TMMWaveOut.Open;
var
   TimeOut: integer;
   dwFlags: Longint;
begin
   if (FNumDevs = 0) then
      Error(LoadResStr(IDS_WONODEVICE));

   if (FDeviceID = InvalidId) then
      Error(LoadResStr(IDS_INVALIDDEVICEID));

   if (PWaveFormat = Nil) then
       Error('WaveOutOpen:'#10#13+LoadResStr(IDS_NOFORMAT));

   if (wosOpen in FState) then Close;

   if (Not(wosOpen in FState)) and not FClosing then
   begin
      {$IFDEF _MMDEBUG}
      //DB_Clear;
      DB_WriteStrLn(0,'-----------------');
      {$ENDIF}

      FClosing := False;
      FReseting := False;
      FStopping := False;
      FPosted   := False;
      try
         if not QueryDevice(FDeviceID, PWaveFormat) then
            Error('WaveOutOpen:'#10#13+LoadResStr(IDS_CANTPLAY));

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

         {$IFDEF _MMDEBUG}
         DebugStr(0,'Call inherited...');
         {$ENDIF}

         FHWaveOut := 0;
         FCloseIt := False;

         inherited Opened;

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

         { create critical section object }
         InitCritical;

         {$IFDEF WIN32}
         if (FCallBackMode = cmThread) then InitThread;
         {$ENDIF}

         TimeOut := 500;

         {$IFDEF WIN32}
         if FMapped and (FDeviceID >= 0) then
            dwFlags := WAVE_MAPPED
         else
         {$ENDIF}
            dwFlags := 0;

         {$IFDEF _USE_CALLBACK}
         if _Win9x_ or _WinNT4_ then
         begin
            { now open Wave output device. }
            FError := WaveOutOpen(@FHWaveOut,
                                  FDeviceId,
                                  Pointer(PWaveFormat),
                                  Longint(@WaveOutFunc),
                                  Longint(Self),
                                  CALLBACK_FUNCTION or dwFlags);
         end
         else
         {$ENDIF}
         begin
            { now open Wave output device. }
            FError := WaveOutOpen(@FHWaveOut,
                                  FDeviceId,
                                  Pointer(PWaveFormat),
                                  FHandle,
                                  0,
                                  CALLBACK_WINDOW or dwFlags);
         end;

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

         { wait until the device returns its status }
         repeat
             {$IFDEF _USE_CALLBACK}
             if _Win9x_ or _WinNT4_ then
                Delay(10,False)
             else
             {$ENDIF}
                Delay(10,True);
             dec(TimeOut);
         until (wosOpen in FState) or (TimeOut <= 0);

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

         DoOpened;

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

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

      { stop playing }
      if (wosPlay in FState) OR (wosPause in FState) then Stop;

      TimeOut := 500;

      { Close the device (finally!) }
      if FStopIt then FCloseIt := True
      else
      begin
         FCloseIt := False;
         if (FHWaveOut <> 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 := WaveOutClose(FHWaveOut);
	    if FError <> 0 then
	       Error('WaveOutClose:'#10#13+WaveOutErrorString(FError));

            { wait until the device returns its status }
            repeat
               {$IFDEF _USE_CALLBACK}
               if _Win9x_ or _WinNT4_ then
                  Delay(10,False)
               else
               {$ENDIF}
                  Delay(10,True);
               dec(TimeOut);
            until (wosClose in FState) or (TimeOut <= 0);

            FEndingPosition := 0;
            FWrapArrounds   := 0;
            FWrapSize       := 0;
         end
         else
         begin
            FState := [wosClose];
         end;

         { notify all other components }
         inherited Closed;

         {$IFDEF WIN32}
         if (FCallBackMode = cmThread) then
             { shot down the thread }
             DoneThread
         else
             { Free the critical section }
             DoneCritical;
         {$ENDIF}

         DoClosed;

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

   except
      FClosing := False;
   end;
end;

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

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

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

         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 Sleep(1);
         end;
         {$ENDIF};

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

         TimeOut := 100;
         repeat
             {$IFDEF _USE_CALLBACK}
             if _Win9x_ or _WinNT4_ then
                Delay(10,False)
             else
             {$ENDIF}
                Delay(10,True);
             dec(TimeOut);
         until not FReseting or (TimeOut <= 0);

         { this buggy drivers... :-( }
         FError := WaveOutRestart(FHWaveOut);
         if FError <> 0 then
            Error('WaveOutRestart:'#10#13+WaveOutErrorString(FError));

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

         FBufferOutIdx := 0;
         FBufferCounter := 0;
         FOldPosition := 0;
         FLastPosition := 0;
         FWrapArrounds := 0;
         FWrapSize := 0;
         FLoopPos := 0;

         { notify all other components }
         Reseting;

         FMoreBuffers := True;

         { Load the number of buffers required }
         i := 0;
         while (i < FNumBuffers) and FMoreBuffers do