mmdsystm.pas

一套及时通讯的原码

{========================================================================}
{=                (c) 1995-98 SwiftSoft Ronald Dittrich                 =}
{========================================================================}
{=                          All Rights Reserved                         =}
{========================================================================}
{=  D 01099 Dresden             = Fax.: [phone]               =}
{=  Loewenstr.7a                = [e-mail]                     =}
{========================================================================}
{=  Actual versions on http://www.swiftsoft.de/index.html               =}
{========================================================================}
{=  This code is for reference purposes only and may not be copied or   =}
{=  distributed in any format electronic or otherwise except one copy   =}
{=  for backup purposes.                                                =}
{=                                                                      =}
{=  No Delphi Component Kit or Component individually or in a collection=}
{=  subclassed or otherwise from the code in this unit, or associated   =}
{=  .pas, .dfm, .dcu, .asm or .obj files may be sold or distributed     =}
{=  without express permission from SwiftSoft.                          =}
{=                                                                      =}
{=  For more licence informations please refer to the associated        =}
{=  HelpFile.                                                           =}
{========================================================================}
{=  $Date: 13.11.98 - 03:44:47 $                                        =}
{========================================================================}
unit MMDSystm;

{$C FIXED PRELOAD PERMANENT}

{$I COMPILER.INC}

{.$DEFINE USE_NOTIFICATION}

interface

uses
    Windows,
    SysUtils,
    Classes,
    MMOLE2,
    MMSystem,
    MMObj,
    MMUtils,
    MMRegs,
    MMWaveIO,
    MMPCMSup,
    MMDSound;

{ Emulated devices are very, very slow:
  change this value to adjust the buffer return time for emulated drivers
}
const
    {$IFDEF CBUILDER3} {$EXTERNALSYM TIMEADJUST} {$ENDIF}
    TIMEADJUST    : integer = 60;
    EXACTRETURN   : Boolean = True;

const
    {$IFDEF CBUILDER3} {$EXTERNALSYM DS_NEEDVOLUME} {$ENDIF}
    DS_NEEDVOLUME = $10000000;
    {$IFDEF CBUILDER3} {$EXTERNALSYM DS_NEEDPAN} {$ENDIF}
    DS_NEEDPAN    = $20000000;
    {$IFDEF CBUILDER3} {$EXTERNALSYM DS_NEEDFREQ} {$ENDIF}
    DS_NEEDFREQ   = $40000000;

procedure DSSetHWND(hWaveOut: HWAVEOUT; hw: HWND);
function  DSCreatePrimaryBuffer(hWaveOut: HWAVEOUT; lpFormat: PWaveFormatEx): HRESULT;
function  DSWaveOutOpen(lphWaveOut: PHWAVEOUT; uDeviceID: UINT; lpFormat: PWaveFormatEx;
                        dwCallback, dwInstance, dwFlags: DWORD): MMRESULT; stdcall;
function  DSWaveOutClose(hWaveOut: HWAVEOUT): MMRESULT;
function  DSWaveOutPrepareHeader(hWaveOut: HWAVEOUT; lpWaveHdr: PWaveHdr;
                                 uSize: UINT): MMRESULT;
function  DSWaveOutUnprepareHeader(hWaveOut: HWAVEOUT; lpWaveHdr: PWaveHdr;
                                   uSize: UINT): MMRESULT;
function  DSWaveOutWrite(hWaveOut: HWAVEOUT; lpWaveHdr: PWaveHdr;
                         uSize: UINT): MMRESULT;
function  DSWaveOutPause(hWaveOut: HWAVEOUT): MMRESULT;
function  DSWaveOutRestart(hWaveOut: HWAVEOUT): MMRESULT;
function  DSWaveOutReset(hWaveOut: HWAVEOUT): MMRESULT;
function  DSWaveOutGetPosition(hWaveOut: HWAVEOUT; lpInfo: PMMTime;
                               uSize: UINT): MMRESULT;
function  DSWaveOutSetVolume(hWaveOut: HWAVEOUT; dwVolume: DWORD): MMRESULT;
function  DSWaveOutGetVolume(hWaveOut: HWAVEOUT; lpdwVolume: PDWORD): MMRESULT;
function  DSWaveOutSetPan(hWaveOut: HWAVEOUT; dwPan: DWORD): MMRESULT;
function  DSWaveOutGetPan(hWaveOut: HWAVEOUT; lpdwPan: PDWORD): MMRESULT;
function  DSWaveOutSetPlaybackRate(hWaveOut: HWAVEOUT; dwRate: DWORD): MMRESULT;
function  DSWaveOutGetPlaybackRate(hWaveOut: HWAVEOUT; lpdwRate: PDWORD): MMRESULT;

implementation

uses MMMulDiv,MMDSPObj;

const
   TIMERRATE            = 32;               { times per second              }
   BUFFER_PARTS         = 4;                { Divisions of secondary buffer }
   BUFFER_PRELOAD       = BUFFER_PARTS;     { Number of prefill buffers     }

type
    TMMThreadNotificationResources = set of (tnInterface, tnEvents, tnThread);

    PMMft = ^TMMft;
    TMMft = record
       First       : PWaveHdr;
       lpDS        : IDIRECTSOUND;
       lpDSP       : IDIRECTSOUNDBUFFER;
       lpDSB       : IDIRECTSOUNDBUFFER;
       lpGUID      : PGUID;
       NextMMFt    : PMMFt;
       CallBackMode: DWORD;
       CallBack    : DWORD;
       CBInstance  : DWORD;
       EachTick    : DWORD;
       Buffersize  : DWORD;
       NextPos     : DWORD;
       TotalWritten: DWORD;
       TotalPlayed : DWORD;
       LastPlayPos : DWORD;
       SilenceBytes: DWORD;
       EndTime     : DWORD;
       Volume      : DWORD;
       UpdateVolume: Boolean;
       Started     : Boolean;
       Paused      : Boolean;
       DataRate    : DWORD;
       SilenceVal  : Byte;
       Emulated    : Boolean;
        { Playback notification via thread }
       NtfResources: TMMThreadNotificationResources;
       lpDSBN      : IDirectSoundNotify;
       NotifyPts   : array[0..BUFFER_PARTS-1] of TDSBPOSITIONNOTIFY;
    end;

const
   lpMMFt       : PMMFt = Nil;
   DSoundHW     : HWND  = 0;
   TimerInit    : DWORD = 0;
   TimerID      : DWORD = 0;
   AllNtfResources = [tnInterface, tnEvents, tnThread];

var
   DataSection  : TRtlCriticalSection;
   DataSectionOK: Boolean = False;

{------------------------------------------------------------------------}
procedure InitCritical;
begin
   if (lpMMFt = nil) then
   begin
      { create critical section object }
      FillChar(DataSection, SizeOf(DataSection), 0);
      InitializeCriticalSection(DataSection);
      DataSectionOK := True;
   end;
end;

{------------------------------------------------------------------------}
procedure DoneCritical;
begin
   if (lpMMFt = nil) and DataSectionOK then
   begin
      DataSectionOK := False;
      DeleteCriticalSection(DataSection);
   end;
end;

{------------------------------------------------------------------------}
procedure EnterCritical;
begin
   if DataSectionOK then EnterCriticalSection(DataSection);
end;

{------------------------------------------------------------------------}
procedure LeaveCritical;
begin
   if DataSectionOK then LeaveCriticalSection(DataSection);
end;

{------------------------------------------------------------------------}
procedure NotifyMessage(lpft: PMMft; Msg: UINT; wParam: WPARAM; lParam: LPARAM);stdcall;
type
    TWaveOutFunc = procedure(hWaveOut: HWaveOut;wMsg:UINT;dwInstance,dwParam1,dwParam2:Longint);stdcall;
begin
   if (lpft <> nil) then
   with lpft^ do
   begin
      case CallBackMode of
         CALLBACK_WINDOW: PostMessage(CallBack,Msg,wParam,lParam);
         CALLBACK_THREAD: PostThreadMessage(CallBack,Msg,wParam,lParam);
       CALLBACK_FUNCTION: TWaveOutFunc(CallBack)(integer(lpft),Msg,CBInstance,wParam,lParam);
      end;
   end;
end;

{------------------------------------------------------------------------}
procedure DoneMarker(uTimerID, uMessage: UINT; user, dw1, dw2: DWORD);stdcall;
begin
   if (user <> 0) then
   with PMMWaveHdr(user)^ do
   begin
      wh.dwFlags := wh.dwFlags or WHDR_DONE; { Header is done }
      NotifyMessage(PMMft(dwUser1), MM_WOM_DONE, dwUser1, user);
      TimeKillEvent(uTimerID);      { kill the timer }
      dwUser2 := 0;                 { reset the timerID for this buffer }
   end;
end;

{------------------------------------------------------------------------}
procedure CopySnd(pDest: PChar; len, rest, cDiff: DWORD; lpft: PMMft);
Label loop;
Var
  bytes: DWORD;
  lpwh : PWaveHdr;
  ms   : Longint;

begin
   with lpft^ do
   begin
loop:
     lpwh := First;
     if (lpwh <> nil) then
     begin
        with lpwh^ do
        begin
           bytes := dwBufferLength - reserved;
           if (bytes > len) then bytes := len;

           Move((lpData+reserved)^, pDest^, bytes);
           inc(reserved, bytes);
           inc(pDest, bytes);
           dec(len, bytes);
           if (reserved >= dwBufferLength) then
           begin
              First := lpNext;
              if EXACTRETURN or (First = nil) then
              begin
                 ms := MulDiv32(cDiff-(rest+len),1000,DataRate);
                 if Emulated then inc(ms,TIMEADJUST);
                 if (ms > 0) then
                 begin
                    PMMWaveHdr(lpwh)^.dwUser1 := DWORD(lpft);
                    PMMWaveHdr(lpwh)^.dwUser2 := TimeSetEvent(ms, 0, @DoneMarker, DWORD(lpwh),TIME_ONESHOT);
                 end;
              end
              else ms := 0;

              if (PMMWaveHdr(lpwh)^.dwUser2 = 0) or (ms <= 0) then
              begin
                 lpwh^.dwFlags := lpwh^.dwFlags or WHDR_DONE;
                 NotifyMessage(lpft, MM_WOM_DONE, DWORD(lpft), DWORD(lpwh));
              end;

              if (len > 0) then goto loop;
           end;
        end;
     end;

     if (len > 0) then
     begin
        FillChar(pDest^, len, SilenceVal);
     end;
   end;
end;

{------------------------------------------------------------------------}
procedure ProcessData(lpft: PMMft);
Var
   cPlay, cWrite, cDiff: DWORD;
   p1, p2: PChar;
   l1, l2: DWORD;
   dwNumToWrite: DWORD;

begin
   EnterCritical;

   with lpft^ do
   if Started and not Paused then
   begin
      if UpdateVolume then
      begin
         lpDSB.SetVolume(Volume);
         UpdateVolume := False;
      end;
      lpDSB.GetCurrentPosition(cPlay, cWrite);

      if (cPlay < LastPlayPos) then
      begin
         if (LastPlayPos-cPlay > 16) then
             cDiff := BufferSize - LastPlayPos + cPlay
         else
         begin
            TotalPlayed := LastPlayPos-cPlay;
            cDiff := 0;
         end;
      end
      else
          cDiff := cPlay - LastPlayPos;

      inc(TotalPlayed,cDiff);
      LastPlayPos := cPlay;

      dwNumToWrite := Min(((BufferSize-(TotalWritten-TotalPlayed))div EachTick)*EachTick,EachTick);

      if (dwNumToWrite >= EachTick) then
      begin
         if lpDSB.Lock(NextPos,EachTick,p1,l1,p2,l2,0) = DS_OK then
         begin
            inc(NextPos, EachTick);
            inc(TotalWritten, EachTick);

            { calc the difference between play and write }
            if (NextPos >= cPlay) then
                cDiff := NextPos-cPlay
            else
                cDiff := (BufferSize-cPlay)+NextPos;

            if (p1 <> Nil) then CopySnd(p1,l1,l2,cDiff,lpft);
            if (p2 <> Nil) then CopySnd(p2,l2,0,cDiff,lpft);

            if (NextPos >= BufferSize) then
                dec(NextPos, BufferSize);
            lpDSB.Unlock(p1,l1,p2,l2);
         end;
      end;
   end;
   LeaveCritical;
end;

const
   NoReEnter : DWORD = 0;

{------------------------------------------------------------------------}
procedure TimerFunc(uTimerID, uMessage: UINT; user, dw1, dw2: DWORD); stdcall;
var
   lpft: PMMft;

begin
   inc(NoReEnter);
   if (NoReEnter = 1) then
   begin
      lpft := lpMMft;
      while (lpft <> Nil) do
      begin
         ProcessData(lpft);
         lpft := lpft^.NextMMft;
      end;
   end;
   dec(NoReEnter);
end;

{--- Notifications with a thread ----------------------------------------------}
procedure OleCheck(Result: HResult);
const
  strOleError = 'Ole Error, code = $%s';
{$IFDEF DELPHI3} resourcestring {$ENDIF}
  SOleError = strOleError;
begin
  if Result <> S_OK then
    raise Exception.CreateFmt(SOleError, [IntToHex(Result, 8)]);
end;

const
  NOTIFICATIONTHREAD_TIMEOUT = 10000;

type
  TDSNotificationThread = class(TMMThreadEx)
  protected
    FSystemEvent: THandle;
    procedure Execute; override;
  public
    constructor Create;
    destructor Destroy; override;
  end;

var
  DSNotificationThread: TDSNotificationThread;
  DSNotificationThread_RefCount: Integer;

{------------------------------------------------------------------------}
constructor TDSNotificationThread.Create;
begin
   inherited Create(False);
   FSystemEvent := CreateEvent(nil, False, False, nil);
end;

{------------------------------------------------------------------------}
destructor TDSNotificationThread.Destroy;
begin
   CloseHandle(FSystemEvent);
   inherited;
end;

{------------------------------------------------------------------------}
procedure TDSNotificationThread.Execute;
type
    TFtArray = array[0..0] of PMMFt;
    PFtArray = ^TFtArray;
var
   HandleCount: Integer;