mmdsystm.pas

一套及时通讯的原码

   lphWaveOut^ := 0;
end;

{------------------------------------------------------------------------}
{ Used internally by DSWaveOutWrite, DSWaveOutRestart, DSWaveOutClose    }
function Timer_Addref(lpft: PMMft): HResult;
begin
   Result := S_OK;
   inc(TimerInit);
   if (TimerInit = 1) then
   begin
      TimeBeginPeriod(1);
      TimerID := TimeSetEvent(1000 div TIMERRATE, 0, @TimerFunc, 0, TIME_PERIODIC);
      if TimerID = 0 then
      begin
        lpft^.lpDSB.Stop;
        dec(TimerInit);
        LeaveCritical;
        Result := E_FAIL;
      end;
   end;
end;

{------------------------------------------------------------------------}
procedure Timer_Release;
begin
   if (TimerInit > 0) then
   begin
      dec(TimerInit);
      if (TimerInit = 0) then
      begin
        TimeKillEvent(TimerID);
        TimeEndPeriod(1);
      end;
   end;
end;

{------------------------------------------------------------------------}
function DSWaveOutClose(hWaveOut: HWAVEOUT): MMRESULT;
Label cont,cont2;
var
   lpft,lpft2: PMMFt;
   m: integer;

begin
   EnterCritical;
   Result := 1;
   lpft := lpMMft;
   if (integer(lpft) = hWaveOut) then lpMMft := lpMMft^.NextMMft
   else
   begin
      while (lpft^.NextMMft <> Nil) do
      begin
         if (integer(lpft^.NextMMft) = hWaveOut) then
         begin
            lpft^.NextMMft := lpft^.NextMMft^.NextMMft;
            goto cont;
         end;
         lpft := lpft^.NextMMft;
      end;
      LeaveCritical;
      exit;
   end;

cont:
   DSWaveOutReset(hWaveOut);

   lpft := PMMft(hWaveOut);
   m := -10000;
   lpft^.lpDSB.SetVolume(m);
   lpft^.lpDSB.SetCurrentPosition(0);
   lpft^.lpDSB.Stop;

   if (lpft^.Started) and (lpft^.NtfResources <> AllNtfResources) then
       Timer_Release;

   DoneNotifications(lpft);
   lpft^.lpDSB.Release;

   NotifyMessage(lpft, MM_WOM_CLOSE, Longint(lpft), 0);

   if (lpMMft = Nil) then
   begin
      if (lpft^.lpDSP <> nil) then lpft^.lpDSP.Release;
      if (lpft^.lpDS <> nil) then lpft^.lpDS.Release;
   end
   else
   begin
      lpft2 := lpMMft;
      while lpft2 <> nil do
      begin
         if lpft2^.lpGUID = lpft^.lpGUID then goto cont2;
         lpft2 := lpft2^.NextMMft;
      end;
      if (lpft^.lpDSP <> nil) then lpft^.lpDSP.Release;
      if (lpft^.lpDS <> nil) then lpft^.lpDS.Release;
   end;

cont2:

   LeaveCritical;
   DoneCritical;
   GlobalFreePtr(lpft);
   DSoundHW := 0;
   Result := 0;
end;

{------------------------------------------------------------------------}
function DSWaveOutPrepareHeader(hWaveOut: HWAVEOUT; lpWaveHdr: PWaveHdr;
                                uSize: UINT): MMRESULT;
begin
   lpWaveHdr^.dwFlags := WHDR_PREPARED;
   Result := 0;
end;

{------------------------------------------------------------------------}
function DSWaveOutUnprepareHeader(hWaveOut: HWAVEOUT; lpWaveHdr: PWaveHdr;
                                  uSize: UINT): MMRESULT;
begin
   if (PMMWaveHdr(lpWaveHdr)^.dwUser2 <> 0) then
      TimeKillEvent(PMMWaveHdr(lpWaveHdr)^.dwUser2);
   PMMWaveHdr(lpWaveHdr)^.dwUser2 := 0;
   lpWaveHdr^.dwFlags := WHDR_DONE;
   Result := 0;
end;

{------------------------------------------------------------------------}
function DSWaveOutWrite(hWaveOut: HWAVEOUT; lpWaveHdr: PWaveHdr;
                        uSize: UINT): MMRESULT;
var
   i,m: integer;
   lpft: PMMft;
   lpwh: PWaveHdr;

begin
   EnterCritical;
   Result := 1;
   lpft := PMMFt(hWaveOut);
   lpWaveHdr^.reserved := 0;
   lpWaveHdr^.lpNext := Nil;
   lpWaveHdr^.dwFlags := lpWaveHdr^.dwFlags and not WHDR_DONE;

   if (lpft^.First = Nil) then
   begin
      lpft^.First := lpWaveHdr;
   end
   else
   begin
      lpwh := lpft^.First;
      while (lpwh^.lpNext <> Nil) do lpwh := lpwh^.lpNext;
      lpwh^.lpNext := lpWaveHdr;
   end;

   if (not lpft^.Started) and (not lpft^.Paused) then
   begin
      if (lpft^.NtfResources <> AllNtfResources) and
         (Timer_Addref(lpft) <> S_OK) then exit;

      lpft^.UpdateVolume := True;
      m := -10000;
      lpft^.lpDSB.SetVolume(m);
      lpft^.lpDSB.SetCurrentPosition(0);
      lpft^.Started := True;
      LeaveCritical;

      { pre-fill the SoundBuffer }
      for i := 0 to BUFFER_PRELOAD-1 do ProcessData(lpft);
      lpft^.lpDSB.Play(0,0,DSBPLAY_LOOPING);
      Result := 0;
      exit;
   end;
   LeaveCritical;
   Result := 0;
end;

{------------------------------------------------------------------------}
function DSWaveOutPause(hWaveOut: HWAVEOUT): MMRESULT;
var
   lpft: PMMft;
   m: integer;

begin
   EnterCritical;
   lpft := PMMFt(hWaveOut);

   lpft^.Paused := True;
   lpft^.lpDSB.Stop;
   m :=-10000;
   lpft^.lpDSB.SetVolume(m);
   LeaveCritical;
   Result := 0;
end;

{------------------------------------------------------------------------}
function DSWaveOutRestart(hWaveOut: HWAVEOUT): MMRESULT;
var
   i: integer;
   lpft: PMMft;

begin
   Result := 1;
   lpft := PMMFt(hWaveOut);

   if (lpft = nil) or not lpft^.Paused then exit;

   EnterCritical;

   if (not lpft^.Started) then
       if (lpft^.NtfResources <> AllNtfResources) and
          (Timer_Addref(lpft) <> S_OK) then
           exit;

   lpft^.Paused := False;
   lpft^.lpDSB.SetVolume(lpft^.Volume);
   lpft^.lpDSB.SetCurrentPosition(0);
   lpft^.Started := True;
   LeaveCritical;

   { pre-fill the SoundBuffer }
   for i := 0 to BUFFER_PRELOAD-1 do ProcessData(lpft);
   lpft^.lpDSB.Play(0,0,DSBPLAY_LOOPING);

   Result := 0;
end;

{------------------------------------------------------------------------}
function DSWaveOutReset(hWaveOut: HWAVEOUT): MMRESULT;
Label ResetExit;
var
   p1, p2: PChar;
   l1, l2: DWORD;
   lpft: PMMft;
   lpwh: PWAVEHDR;
   m: integer;

begin
   EnterCritical;
   Result := 0;
   lpft := PMMFt(hWaveOut);

   if (lpft^.Started) and (lpft^.NtfResources <> AllNtfResources) then
       Timer_Release;
   lpft^.Started := False;

   m := -10000;
   lpft^.lpDSB.SetVolume(m);
   lpft^.lpDSB.Stop;
   lpft^.lpDSB.SetCurrentPosition(0);
   lpwh := lpft^.First;
   while (lpwh <> nil) do
   begin
      lpwh^.dwFlags := lpwh^.dwFlags or WHDR_DONE;
       if (PMMWaveHdr(lpwh)^.dwUser2 <> 0) then
          TimeKillEvent(PMMWaveHdr(lpwh)^.dwUser2);
      PMMWaveHdr(lpwh)^.dwUser2 := 0;
      NotifyMessage(lpft, MM_WOM_DONE, Longint(lpft), Longint(lpwh));
      lpwh := lpwh^.lpNext;
   end;

   lpft^.First       := nil;
   lpft^.TotalWritten:= 0;
   lpft^.TotalPlayed := 0;
   lpft^.LastPlayPos := 0;
   lpft^.NextPos     := 0;

   if lpft^.lpDSB.Lock(0, lpft^.BufferSize,p1,l1,p2,l2,0) <> DS_OK then
      goto ResetExit;
   if (p1 <> Nil) then FillChar(p1^,l1, lpft^.SilenceVal);
   if (p2 <> Nil) then FillChar(p2^,l2, lpft^.SilenceVal);
   if lpft^.lpDSB.Unlock(p1,l1,p2,l2) <> DS_OK then
      goto ResetExit;

ResetExit:
   LeaveCritical;
end;

{------------------------------------------------------------------------}
function DSWaveOutGetPosition(hWaveOut: HWAVEOUT; lpInfo: PMMTime;
                              uSize: UINT): MMRESULT;
var
   wfx: TWaveFormatEx;
   lpft: PMMft;
   dwPlay,dwWrite: DWORD;

begin
   EnterCritical;
   Result := 1;
   lpft := PMMFt(hWaveOut);

   if (lpft <> nil) and (lpInfo^.wType = Time_Samples) then
   begin
      if lpft^.lpDSB.GetFormat(@wfx, sizeOf(wfx), nil) = DS_OK then
      begin
         lpft^.lpDSB.GetCurrentPosition(dwPlay,dwWrite);
         if (dwPlay < lpft^.LastPlayPos) then
             dwPlay := lpft^.TotalPlayed+(lpft^.BufferSize-lpft^.LastPlayPos+dwPlay)
         else
             dwPlay := lpft^.TotalPlayed+(dwPlay-lpft^.LastPlayPos);

         lpInfo^.Sample := wioBytesToSamples(@wfx,dwPlay);

         Result := 0;
      end;
   end
   else lpInfo^.wType := Time_Samples;
   LeaveCritical;
end;

{------------------------------------------------------------------------}
function DSWaveOutSetVolume(hWaveOut: HWAVEOUT; dwVolume: DWORD): MMRESULT;
var
   lpft: PMMft;

begin
   EnterCritical;
   Result := 1;
   lpft := PMMFt(hWaveOut);
   if lpft^.lpDSB.SetVolume(dwVolume) = DS_OK then
   begin
     lpft^.Volume := dwVolume;
     Result := 0;
   end;
   LeaveCritical;
end;

{------------------------------------------------------------------------}
function DSWaveOutGetVolume(hWaveOut: HWAVEOUT; lpdwVolume: PDWORD): MMRESULT;
var
   lpft: PMMft;

begin
   EnterCritical;
   Result := 1;
   lpft := PMMFt(hWaveOut);
   if lpft^.lpDSB.GetVolume(lpdwVolume^) = DS_OK then Result := 0;
   LeaveCritical;
end;

{------------------------------------------------------------------------}
function DSWaveOutSetPan(hWaveOut: HWAVEOUT; dwPan: DWORD): MMRESULT;
var
   lpft: PMMft;

begin
   EnterCritical;
   Result := 1;
   lpft := PMMFt(hWaveOut);
   if lpft^.lpDSB.SetPan(dwPan) = DS_OK then Result := 0;
   LeaveCritical;
end;

{------------------------------------------------------------------------}
function DSWaveOutGetPan(hWaveOut: HWAVEOUT; lpdwPan: PDWORD): MMRESULT;
var
   lpft: PMMft;

begin
   EnterCritical;
   Result := 1;
   lpft := PMMFt(hWaveOut);
   if lpft^.lpDSB.GetPan(lpdwPan^) = DS_OK then Result := 0;
   LeaveCritical;
end;

{------------------------------------------------------------------------}
function DSWaveOutSetPlaybackRate(hWaveOut: HWAVEOUT; dwRate: DWORD): MMRESULT;
var
   lpft: PMMft;

begin
   EnterCritical;
   Result := 1;
   lpft := PMMFt(hWaveOut);
   if lpft^.lpDSB.SetFrequency(dwRate) = DS_OK then Result := 0;
   LeaveCritical;
end;

{------------------------------------------------------------------------}
function DSWaveOutGetPlaybackRate(hWaveOut: HWAVEOUT; lpdwRate: PDWORD): MMRESULT;
var
   lpft: PMMft;

begin
   EnterCritical;
   Result := 1;
   lpft := PMMFt(hWaveOut);
   if lpft^.lpDSB.GetFrequency(lpdwRate^) = DS_OK then Result := 0;
   LeaveCritical;
end;

end.