mmdswout.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: 05.11.98 - 17:23:30 $                                        =}
{========================================================================}
unit MMDSWOut;

{$C FIXED PRELOAD PERMANENT}

{$I COMPILER.INC}

{.$DEFINE _MMDEBUG}

interface

uses
  Windows,
  SysUtils,
  Messages,
  Classes,
  Controls,
  Forms,
  Dialogs,
  MMSystem,
  MMObj,
  MMUtils,
  MMDSPObj,
  MMDSPMtr,
  MMRegs,
  MMWaveIO,
  MMDSound,
  MMDSystm
  {$IFDEF _MMDEBUG}
  ,MMDebug
  {$ENDIF};

{$IFDEF _MMDEBUG}
   {$DEFINE NUMERATE}
   const
        DEBUGLEVEL = 0; { 0,1,2 }
{$ENDIF}

const
  {$IFDEF CBUILDER3} {$EXTERNALSYM MAXERRORLENGTH} {$ENDIF}
  MAXERRORLENGTH     = 255;
  {$IFDEF CBUILDER3} {$EXTERNALSYM MAXOUTBUFFERS} {$ENDIF}
  MAXOUTBUFFERS      = 500;
  {$IFDEF CBUILDER3} {$EXTERNALSYM MINBUFFERSIZE} {$ENDIF}
  MINBUFFERSIZE      = 256;
  FIX_BUFFERS        : Boolean = True;
  DSWAVEOUT_PRIORITY : TThreadPriority = tpHigher;

type
  EMMDSWaveOutError    = class(Exception);
  TMMDSWaveOutStates   = (dssClose, dssOpen, dssPlay, dssPause);
  TMMDSWaveOutState    = set of TMMDSWaveOutStates;
  { Pointers to waveOut headers }
  TMMDSWaveOutHdrs     = array[0..MAXOUTBUFFERS-1] of PWaveHdr;

  TMMDSWaveOut = class;
  {-- TMMDSWaveOutThread ------------------------------------------------}
  TMMDSWaveOutThread = class(TMMDSPThread)
  private
     procedure Execute; override;
  end;

  {-- TMMDSWAVEOUT ------------------------------------------------------}
  TMMDSWaveOut = class(TMMCustomWaveOutComponent)
  private
    FHandle        : THandle;          { handle used for callback window    }
    FDevices       : TList;            { device list for all devices        }
    FDeviceID      : TMMDeviceID;      { DSWAVEOUT device ID                }
    FHDSWaveOut    : HWaveOut;         { Handle to output device            }
    FState         : TMMDSWaveOutState;{ Current device state               }
    FDSWaveOutHdrs : TMMDSWaveOutHdrs; { WaveOut Headers and Buffers        }
    FBufferOutIdx  : integer;          { the current Out Header/BufferIndex }
    FBufferInIdx   : integer;          { the current In Header/BufferIndex  }
    FCallbackMode  : TMMCBMode;        { use Window or Callback function    }
    FError         : integer;          { Last DSWaveOut Error               }
    FProductName   : String;
    FInHandler     : integer;          { marks that we in any event handler }
    FStarted       : Boolean;          { device is now started              }
    FStopIt        : Boolean;          { we should stop playing if possible }
    FCloseIt       : Boolean;          { we should close device if possible }
    FStopping      : Boolean;          { we actually stop the device        }
    FClosing       : Boolean;          { we actually close the device       }
    FReseting      : Boolean;          { we actually reseting the device    }
    FMoreBuffers   : Boolean;          { more buffers to write ?            }
    FLooping       : Boolean;          { loop playing or not                }
    FLoopCount     : Word;             { number of loops                    }
    FLoopTempCount : integer;          { temp loop counter for playing      }
    FLoopPos       : Longint;          { adjust for loop ang GetPosition    }
    FOldPosition   : Longint;          { the old play position before pause }
    FBytesPlayed   : Longint;          { total bytes we have realy played   }
    FNumBuffers    : integer;          { number of buffers for queue        }
    FBuffersUsed   : integer;          { the real buffers we have in use    }
    FBufferCounter : integer;          { buffer counter for buffers in use  }

    FTimeFormat    : TMMTimeFormats;   { the actual time format for Position}
    FVolume        : Longint;          { the actual volume                  }
    FPan           : Longint;          { the actual pan                     }
    FRate          : Longint;          { the actual playbackrate            }

    FThreadError   : Boolean;          { Error in Thread Handler            }
    FOutThread     : TMMDSWaveOutThread;{ Output Thread for callback handling}
    DataSection    : TRtlCriticalSection;{ CriticalSection Object           }
    DataSectionOK  : Boolean;          { CriticalSection is prepared        }
    FOutEvent      : THandle;          { event object for notify handling   }
    FCloseEvent    : THandle;          { event object to close the device   }
    FResetEvent    : THandle;          { event object to reset the device   }

    { Events }
    FOnError       : TNotifyEvent;     { Error occured                      }
    FOnBufferFilled: TMMBufferEvent;   { Wave buffer filled event           }
    FOnLooping     : TNotifyEvent;     { Wave was at end and is looped      }
    FOnOpen        : TNotifyEvent;     { Wave Device succ. opened           }
    FOnStart       : TNotifyEvent;     { Wave Device succ. started          }
    FOnPause       : TNotifyEvent;     { Wave Device succ. paused           }
    FOnRestart     : TNotifyEvent;     { Wave Device succ. restarted        }
    FOnStop        : TNotifyEvent;     { Wave Device succ. stopped          }
    FOnClose       : TNotifyEvent;     { Wave Device succ. closed           }

    function  GetNumDevs: integer;
    function  GetDevices(Index: integer): PDSDRIVERDESC;
    procedure SetTimeFormat(aValue: TMMTimeFormats);
    procedure SetLooping(aValue: Boolean);
    procedure SetLoopCount(aValue: Word);
    function  GetSamplePosition: Longint;
    procedure SetVolume(aValue: Longint);
    function  GetVolume: Longint;
    procedure SetPan(aValue: Longint);
    function  GetPan: Longint;
    procedure SetRate(aValue: Longint);
    function  GetRate: Longint;
    procedure DSWaveOutHandler(VAR Msg: TMessage);
    procedure AllocWaveHeader(VAR lpWaveHdr: PWaveHdr);
    procedure FreeWaveHeaders;
    procedure PrepareWaveHeader(lpWaveHdr: PWaveHdr);
    procedure UnPrepareWaveHeaders;
    function  LoadWaveHeader(lpWaveHdr: PWaveHdr): Longint;
    procedure QueueWaveHeader(lpWaveHdr: PWaveHdr);
    procedure ProcessWaveHeader(lpWaveHdr: PWaveHdr);

    procedure InitThread;
    procedure DoneThread;
    procedure CloseEvents;

    procedure InitCritical;
    procedure EnterCritical;
    procedure LeaveCritical;
    procedure DoneCritical;

    procedure DoOpened;
    procedure DoClosed;
    procedure DoStarted;
    procedure DoPaused;
    procedure DoRestarted;
    procedure DoStopped;
    procedure DoBufferFilled(lpwh: PWaveHdr);
    procedure DoBufferReady(lpwh: PWaveHdr);

  protected
    procedure SetPWaveFormat(aValue: PWaveFormatEx); override;
    procedure SetBufferSize(aValue: Longint); override;
    function  GetBufferSize: Longint; override;
    procedure SetNumBuffers(aValue: integer); override;
    function  GetNumBuffers: integer; override;
    procedure SetDeviceID(aValue: TMMDeviceID); override;
    function  GetDeviceID: TMMDeviceID; override;
    procedure SetProductName(aValue: string); override;
    function  GetProductName: string; override;
    procedure SetCallBackMode(aValue: TMMCBMode); override;
    function  GetCallBackMode: TMMCBMode; override;
    function  GetPosition: MM_int64; override;

    procedure Error(Msg: string); virtual;

    procedure Opened; override;
    procedure Started; override;
    procedure Paused; override;
    procedure Restarted; override;
    procedure Stopped; override;
    procedure Closed; override;
    procedure BufferReady(lpwh: PWaveHdr); override;
    procedure BufferLoad(lpwh: PWaveHdr; var MoreBuffers: Boolean); override;

  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    
    procedure Open; override;
    procedure Close; override;
    procedure Reset; override;
    procedure Start; override;
    procedure Pause; override;
    procedure Restart; override;
    procedure Stop; override;

    function  QueryDevice(DeviceID: TMMDeviceID; pwfx: PWaveFormatEx): Boolean;

    { maybe you must syncronize anything if UseThread = True ? }
    procedure SynchronizeVCL(VCLProc: TThreadMethod);

    property Handle: HWaveOut read FHDSWaveOut;
    property Numdevs: integer read GetNumdevs;
    property Devices[Index: integer]: PDSDRIVERDESC read GetDevices;
    property State: TMMDSWaveOutState read FState;
    property BytesPlayed: Longint read FBytesPlayed;
    property Position: MM_int64 read GetPosition;
    property Volume: Longint read GetVolume write SetVolume;
    property Panning: Longint read GetPan write SetPan;
    property Frequency: Longint read GetRate write SetRate;
    property BufferIndex: integer read FBufferOutIdx;
    {$IFNDEF CBUILDER3}
    property WaveHdrs: TMMDSWaveOutHdrs read FDSWaveOutHdrs;
    {$ENDIf}

  published
    { Events }
    property OnError: TNotifyEvent read FOnError write FOnError;
    property OnOpen: TNotifyEvent read FOnOpen write FOnOpen;
    property OnStart: TNotifyEvent read FOnStart write FOnStart;
    property OnPause: TNotifyEvent read FOnPause write FOnPause;
    property OnRestart: TNotifyEvent read FOnRestart write FOnRestart;
    property OnStop: TNotifyEvent read FOnStop write FOnStop;
    property OnClose: TNotifyEvent read FOnClose write FOnClose;
    property OnLooping: TNotifyEvent read FOnLooping write FOnLooping;
    property OnBufferFilled: TMMBufferEvent read FOnBufferFilled write FOnBufferFilled;
    property OnBufferLoad;
    property OnBufferReady;

    property Input;
    property Output;
    property BufferSize;
    property NumBuffers;
    property DeviceID;
    property ProductName;
    property CallBackMode;
    property TimeFormat: TMMTimeFormats read FTimeFormat write SetTimeFormat default tfByte;
    property Looping: Boolean read FLooping write SetLooping default False;
    property LoopCount: Word read FLoopCount write SetLoopCount default 0;
  end;

implementation

const
     MM_WOM_STOP  = MM_USER+1;

procedure DSWaveOutFunc(hWaveOut:HWaveOut;wMsg:UINT;dwInstance,dwParam1,dwParam2:Longint);
stdcall;forward;

{$IFDEF _MMDEBUG}
{-------------------------------------------------------------------------}
procedure DebugStr(Level: integer; s: String);
begin
   if (s <> ' ') then s := 'DSWaveOut: '+s;
   DB_WriteStrLn(Level,s);
end;
{$ENDIF}

{-- TMMDSWaveOut --------------------------------------------------------}
constructor TMMDSWaveOut.Create(AOwner: TComponent);
begin
   inherited Create(AOwner);

   { Set defaults }
   FHDSWaveOut := 0;
   FState := [dssClose];
   FError := 0;
   FNumBuffers := 10;
   FProductName := '';
   FTimeFormat := tfByte;
   FBytesPlayed := 0;
   FMoreBuffers := False;
   FVolume := 0;
   FPan := 0;
   FRate := 0;
   FLooping := False;
   FLoopCount := 0;
   FCallBackMode := cmWindow;
   FClosing := False;
   FReseting := False;
   FStopping := False;

   FBufferOutIdx := 0;
   FBufferInIdx := 0;
   {clear all pointers to Nil }
   FillChar(FDSWaveOutHdrs, sizeOf(TMMDSWaveOutHdrs), 0);

   DataSectionOK := False;
   
   if _WinNT3_ then
      raise EMMDSWaveOutError.Create(LoadResStr(IDS_DSNOTSUPPORTED));

   if not LoadDSoundDLL then
      raise EMMDSWaveOutError.Create(LoadResStr(IDS_DLLERROR));

   FDevices := TList.Create;

   DirectSoundEnumerate(DriverEnumerate, FDevices);

   SetDeviceID(0);

   ErrorCode := ComponentRegistered(InitCode, Self, ClassName);
   if (ErrorCode <> 0) then RegisterFailed(InitCode, Self , ClassName);
end;

{-- TMMDSWaveOut --------------------------------------------------------}
destructor TMMDSWaveOut.Destroy;
begin
   { Close the device if it's open }
   if (FHDSWaveOut <> 0) then Close;

   { Destroy the window for callback notification }
   if (FHandle <> 0) then DeallocateHwnd(FHandle);

   { free the device list }
   if (FDevices <> nil) then
   begin
      FreeDriverList(FDevices);
      FDevices.Free;
   end;
   
   inherited Destroy;
end;

{-- TMMDSWaveOut --------------------------------------------------------}
procedure TMMDSWaveOut.Error(Msg: String);
begin
   if assigned(FOnError) then FOnError(Self);

   raise EMMDSWaveOutError.Create(Msg);
end;

{-- TMMDSWaveOut --------------------------------------------------------}
{ Allocate memory for the WaveOut header and buffer }
procedure TMMDSWaveOut.AllocWaveHeader(VAR lpWaveHdr: PWaveHdr);
begin
   if (lpWaveHdr = Nil) then
   begin
      { set up a wave header for playing and lock. }
      lpWaveHdr := GlobalAllocPtr(GPTR OR GMEM_SHARE, SizeOf(TMMWAVEHDR) + BufferSize);
      if lpWaveHdr = NIL then
         Error(LoadResStr(IDS_HEADERMEMERROR));

      { Data occurs directly after the header }
      lpWaveHdr^.lpData         := PChar(lpWaveHdr) + sizeOf(TMMWaveHdr);
      lpWaveHdr^.dwBufferLength := BufferSize;
      lpWaveHdr^.dwBytesRecorded:= 0;
      lpWaveHdr^.dwFlags        := 0;
      lpWaveHdr^.dwLoops        := 0;
      lpWaveHdr^.dwUser         := 0;
      lpWaveHdr^.lpNext         := nil;
    end;
end;

{-- TMMDSWaveOut --------------------------------------------------------}
procedure TMMDSWaveOut.FreeWaveHeaders;
Var
   i: integer;

begin
   for i := 0 to FNumBuffers-1 do
   begin
      { unlock and free memory for WaveOutHdr }
      if FDSWaveOutHdrs[i] <> NIL then
      begin
         if GlobalFreePtr(FDSWaveOutHdrs[i]) <> 0 then
            Error(LoadResStr(IDS_HEADERFREEERROR));

         FDSWaveOutHdrs[i] := Nil;
      end;
   end;
end;

{-- TMMDSWaveOut --------------------------------------------------------}
procedure TMMDSWaveOut.SetLooping(aValue: Boolean);
begin
   if (aValue <> FLooping) then
   begin
      FLooping := aValue;
      FLoopTempCount := FLoopCount;
   end;
end;

{-- TMMDSWaveOut --------------------------------------------------------}
procedure TMMDSWaveOut.SetLoopCount(aValue: Word);
begin
   if (aValue <> FLoopCount) then
   begin
      FLoopCount := aValue;
      FLoopTempCount := FLoopCount;
   end;
end;

{-- TMMDSWaveOut --------------------------------------------------------}
function TMMDSWaveOut.GetDevices(Index: integer): PDSDRIVERDESC;
begin
   if Index < NumDevs then
      Result := PDSDRIVERDESC(FDevices.Items[Index])
   else Result := nil;
end;

{-- TMMDSWaveOut --------------------------------------------------------}
function TMMDSWaveOut.GetNumDevs: integer;
begin
   Result := FDevices.Count;
end;

{-- TMMDSWaveOut --------------------------------------------------------}
Procedure TMMDSWaveOut.SetDeviceID(aValue: TMMDeviceID);
begin
   if (dssOpen in FState) then
      Error(LoadResStr(IDS_PROPERTYOPEN));

   FProductName := LoadResStr(IDS_DSNODEVICE);

   if (NumDevs > 0) and (aValue >= 0) and (aValue < NumDevs) then
   begin
      FProductName := Devices[aValue]^.Description;
   end;

   { set the new device }
   FDeviceID := aValue;
   if (FDeviceID >= NumDevs) or (FDeviceID < 0) then
      FDeviceID := InvalidID;
end;

{-- TMMDSWaveOut --------------------------------------------------------}
function TMMDSWaveOut.GetDeviceID: TMMDeviceID;
begin
   Result := FDeviceID;
end;

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