mmwavout.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: 27.01.99 - 20:16:19 $                                        =}
{========================================================================}
unit MMWavOut;

{$C FIXED PRELOAD PERMANENT}

{$I COMPILER.INC}

{.$DEFINE _MMDEBUG}

interface

uses
{$IFDEF WIN32}
  Windows,
{$ELSE}
  WinTypes,
  WinProcs,
{$ENDIF}
  SysUtils,
  Messages,
  Classes,
  Graphics,
  Controls,
  Forms,
  Dialogs,
  MMSystem,
  MMUtils,
  MMString,
  MMObj,
  MMDSPObj,
  MMDSPMtr,
  MMRegs,
  MMPCMSup,
  MMAlloc,
  MMWaveIO
  {$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    = 32;
  {$IFDEF CBUILDER3} {$EXTERNALSYM MAXERRORLENGTH} {$ENDIF}

  FIX_BUFFERS      : Boolean = True;

type
  EMMWaveOutError  = class(Exception);
  TMMWaveOutStates = (wosClose, wosOpen, wosPlay, wosPause);
  TMMWaveOutState  = set of TMMWaveOutStates;

  { Pointers to waveOut headers }
  TMMWaveOutHdrs   = array[0..MAXOUTBUFFERS-1] of PWaveHdr;

  {$IFDEF WIN32}
  {-- TMMWaveOutThread ---------------------------------------------------}
  TMMWaveOutThread = class(TMMDSPThread)
  private
     procedure Execute; override;
  end;
  {$ENDIF}

  {-- TMMWaveOut ---------------------------------------------------------}
  TMMWaveOut = class(TMMCustomWaveOutComponent)
  private
    FHandle        : THandle;        { handle used for callback window    }
    FDeviceID      : TMMDeviceID;    { WAVEOUT device ID                  }
    FHWaveOut      : HWaveOut;       { Handle to output device            }
    FState         : TMMWaveOutState;{ Current device state               }
    FWaveOutHdrs   : TMMWaveOutHdrs; { WaveOut Headers and Buffers        }
    FBufferOutIdx  : integer;        { the current Out Header/BufferIndex }
    FCallbackMode  : TMMCBMode;      { use Window or Callback function    }
    FError         : integer;        { Last WaveOut Error                 }
    FNumdevs       : integer;	     { Num. of output devices on system   }
    FWaveOutCaps   : TWaveOutCaps;   { Stuff from WAVEOUTCAPS             }
    FProductName   : String;         { the device Productname             }
    FDriverVersion : integer;        { Specifies the driver version       }
                                     { high-order byte is major version   }
                                     { low-order byte is minor version    }
    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    }
    FPosted        : Boolean;
    FLooping       : Boolean;        { loop playing or not                }
    FLoopCount     : Word;           { number of loops                    }
    FLoopTempCount : integer;        { temp loop counter for playing      }
    FLoopPos       : MM_int64;       { adjust for loop and GetPosition    }
    FOldPosition   : MM_int64;       { the old play position before pause }
    FLastPosition  : Cardinal;       { the last playback position         }
    FWrapArrounds  : Cardinal;       { number of position wrap-arrounds   }
    FWrapSize      : Cardinal;       { where has the position wrapped ?   }
    FBytesPlayed   : MM_Int64;       { total bytes we have realy played   }
    FMoreBuffers   : Boolean;        { more buffers to write ?            }
    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}
    FShowHourGlass : Boolean;
    FEndingPosition: MM_int64;
    FMapped        : Boolean;
    FAllocator     : TMMAllocator;

    {$IFDEF WIN32}
    FPriority      : TThreadPriority;{ thread priority                    }
    FThreadError   : Boolean;        { Error in Thread Handler            }
    FOutThread     : TMMWaveOutThread;{ 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   }
    {$ENDIF}

    { 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  WaveOutErrorString(WError: integer): string;
    procedure SetTimeFormat(aValue: TMMTimeFormats);
    procedure SetLooping(aValue: Boolean);
    procedure SetLoopCount(aValue: Word);
    function  GetSamplePosition: Cardinal;
    function  GetInternalPosition: int64;
    function  GetPositionHigh: Cardinal;
    procedure WaveOutHandler(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);

    {$IFDEF WIN32}
    procedure SetPriority(aValue: TThreadPriority);

    procedure InitThread;
    procedure DoneThread;
    procedure CloseEvents;
    {$ENDIF}

    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;

  public
    procedure Opened; override;
    procedure Closed; override;
    procedure Started; override;
    procedure Paused; override;
    procedure Restarted; override;
    procedure Stopped; override;

    procedure BufferReady(lpwh: PWaveHdr); override;
    procedure BufferLoad(lpwh: PWaveHdr; var MoreBuffers: Boolean); override;

    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(aDeviceID: TMMDeviceID; pwfx: PWaveFormatEx): Boolean;

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

    property Handle: HWaveOut read FHWaveOut;
    property WaveOutCaps: TWaveOutCaps read FWaveOutCaps;
    property Numdevs: integer read FNumdevs;
    property State: TMMWaveOutState read FState;
    property DriverVersion: integer read FDriverVersion;
    property BytesPlayed: MM_Int64 read FBytesPlayed;
    property Position: MM_int64 read GetPosition;
    property PositionHigh: Cardinal read GetPositionHigh;
    property EndingPosition: MM_int64 read FEndingPosition;
    property BufferIndex: integer read FBufferOutIdx;
    {$IFNDEF CBUILDER3}
    property WaveHdrs: TMMWaveOutHdrs read FWaveOutHdrs;
    {$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 OnBufferReady;
    property OnBufferLoad;

    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;
    property ShowHourGlass: Boolean read FShowHourGlass write FShowHourGlass default True;
    property Mapped: Boolean read FMapped write FMapped default False;
    {$IFDEF WIN32}
    property Priority: TThreadPriority read FPriority write SetPriority default tpHigher;
    {$ENDIF}
  end;

function WaveOutGetDeviceName(DeviceID: TMMDeviceID): String;
function WaveOutReady(DeviceID: TMMDeviceID): Boolean;

implementation

{$DEFINE _USE_CALLBACK}

uses consts;

const
     MM_WOM_STOP = MM_USER+1;

procedure WaveOutFunc(hWaveOut:HWaveOut;wMsg:UINT;dwInstance,dwParam1,dwParam2:Longint);
export;{$IFDEF WIN32}stdcall;{$ENDIF}forward;

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

{-------------------------------------------------------------------------}
function WaveOutReady(DeviceID: TMMDeviceID): Boolean;
var
   OutHandle: HWAVEOUT;
   Error: MMRESULT;
   wfx: TWaveFormatEx;

begin
   Result := False;
   if (DeviceID < integer(waveOutGetNumDevs)) and (DeviceID >= integer(WAVE_MAPPER)) then
   try
      OutHandle := 0;
      pcmBuildWaveHeader(@wfx, 8, 1, 22050);
      {$IFDEF WIN32}
      Error := WaveOutOpen(@OutHandle, DeviceId, MMSystem.PWaveFormatEx(@wfx), 0, 0, CALLBACK_NULL);
      {$ELSE}
      Error := WaveOutOpen(@OutHandle, DeviceId, Pointer(@wfx), 0, 0, CALLBACK_NULL);
      {$ENDIF}
      if (Error = MMSYSERR_NOERROR) then
      begin
         Result := True;
      end;
   finally
      if (OutHandle <> 0) then WaveOutClose(OutHandle);
   end;
end;

{-------------------------------------------------------------------------}
function WaveOutGetDeviceName(DeviceID: TMMDeviceID): String;
var
   Caps   : TWaveOutCaps;

begin
   Result := '';
   if (DeviceID < integer(waveOutGetNumDevs)) and (DeviceID >= integer(WAVE_MAPPER)) then
   begin
      { Set the name and other WAVEOUTCAPS properties to match the ID }
      if waveOutGetDevCaps(DeviceID, @Caps, sizeof(TWaveOutCaps)) = 0 then
         Result := StrPas(Caps.szPname);
   end;
end;

{== TMMWaveOut ===========================================================}
constructor TMMWaveOut.Create(AOwner: TComponent);
begin
   inherited Create(AOwner);

   { Set defaults }
   FHWaveOut := 0;
   FHandle   := 0;
   FState := [wosClose];
   FError := 0;
   FNumBuffers := 10;
   FProductName := '';
   FDriverVersion := 0;
   FBytesPlayed := 0;
   FTimeFormat := tfByte;
   FMoreBuffers := False;
   FLooping := False;
   FLoopCount := 0;
   FCallBackMode := cmWindow;
   FClosing := False;
   FReseting := False;
   FStopping := False;
   FPosted := False;
   FBufferOutIdx := 0;
   FShowHourGlass := True;
   FEndingPosition:= 0;
   {$IFDEF WIN32}
   FPriority := tpHigher;
   {$ENDIF}

   FAllocator := TMMAllocator.Create;
   
   {clear all pointers to Nil }
   FillChar(FWaveOutHdrs, sizeOf(TMMWaveOutHdrs), 0);

   FNumDevs := waveOutGetNumDevs;
   SetDeviceID(0);

   {$IFDEF WIN32}
   DataSectionOK := False;
   {$ENDIF}

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

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

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

   if (FAllocator <> nil) then FAllocator.Free;

   inherited Destroy;
end;

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

   {$IFDEF _MMDEBUG}
   DebugStr(0,Msg);
   {$ENDIF}

   raise EMMWaveOutError.Create(Msg);
end;

{-- TMMWaveOut -----------------------------------------------------------}