开通博客赚积分
发布资源赚积分
分类

源码开发语言/平台
当前位置：首页 > 源码/资料 > Delphi控件源码 > 查看源码
MMWavOut.pas
资源名称：qqdelphiprog.rar　[点击查看]
上传用户：hylc_2004
上传日期：2014-01-23
资源大小：46800k
文件大小：63k
源码类别：

Delphi控件源码

开发平台：

Delphi

MMWavOut.pas：源码内容
  1. {========================================================================}
  2. {=                (c) 1995-98 SwiftSoft Ronald Dittrich                 =}
  3. {========================================================================}
  4. {=                          All Rights Reserved                         =}
  5. {========================================================================}
  6. {=  D 01099 Dresden             = Fax.: +49(0)351-8037944               =}
  7. {=  Loewenstr.7a                = info@swiftsoft.de                     =}
  8. {========================================================================}
  9. {=  Actual versions on http://www.swiftsoft.de/index.html               =}
  10. {========================================================================}
  11. {=  This code is for reference purposes only and may not be copied or   =}
  12. {=  distributed in any format electronic or otherwise except one copy   =}
  13. {=  for backup purposes.                                                =}
  14. {=                                                                      =}
  15. {=  No Delphi Component Kit or Component individually or in a collection=}
  16. {=  subclassed or otherwise from the code in this unit, or associated   =}
  17. {=  .pas, .dfm, .dcu, .asm or .obj files may be sold or distributed     =}
  18. {=  without express permission from SwiftSoft.                          =}
  19. {=                                                                      =}
  20. {=  For more licence informations please refer to the associated        =}
  21. {=  HelpFile.                                                           =}
  22. {========================================================================}
  23. {=  $Date: 27.01.99 - 20:16:19 $                                        =}
  24. {========================================================================}
  25. unit MMWavOut;
  27. {$C FIXED PRELOAD PERMANENT}
  29. {$I COMPILER.INC}
  31. {.$DEFINE _MMDEBUG}
  33. interface
  35. uses
  36. {$IFDEF WIN32}
  37.   Windows,
  38. {$ELSE}
  39.   WinTypes,
  40.   WinProcs,
  41. {$ENDIF}
  42.   SysUtils,
  43.   Messages,
  44.   Classes,
  45.   Graphics,
  46.   Controls,
  47.   Forms,
  48.   Dialogs,
  49.   MMSystem,
  50.   MMUtils,
  51.   MMString,
  52.   MMObj,
  53.   MMDSPObj,
  54.   MMDSPMtr,
  55.   MMRegs,
  56.   MMPCMSup,
  57.   MMAlloc,
  58.   MMWaveIO
  59.   {$IFDEF _MMDEBUG}
  60.   ,MMDebug
  61.   {$ENDIF};
  63. {$IFDEF _MMDEBUG}
  64.    {$DEFINE _NUMERATE}
  65.    const
  66.         DEBUGLEVEL = 0; { 0,1,2 }
  67. {$ENDIF}
  69. const
  70.   {$IFDEF CBUILDER3} {$EXTERNALSYM MAXERRORLENGTH} {$ENDIF}
  71.   MAXERRORLENGTH   = 255;
  72.   {$IFDEF CBUILDER3} {$EXTERNALSYM MAXOUTBUFFERS} {$ENDIF}
  73.   MAXOUTBUFFERS    = 500;
  74.   {$IFDEF CBUILDER3} {$EXTERNALSYM MINBUFFERSIZE} {$ENDIF}
  75.   MINBUFFERSIZE    = 32;
  76.   {$IFDEF CBUILDER3} {$EXTERNALSYM MAXERRORLENGTH} {$ENDIF}
  78.   FIX_BUFFERS      : Boolean = True;
  80. type
  81.   EMMWaveOutError  = class(Exception);
  82.   TMMWaveOutStates = (wosClose, wosOpen, wosPlay, wosPause);
  83.   TMMWaveOutState  = set of TMMWaveOutStates;
  85.   { Pointers to waveOut headers }
  86.   TMMWaveOutHdrs   = array[0..MAXOUTBUFFERS-1] of PWaveHdr;
  88.   {$IFDEF WIN32}
  89.   {-- TMMWaveOutThread ---------------------------------------------------}
  90.   TMMWaveOutThread = class(TMMDSPThread)
  91.   private
  92.      procedure Execute; override;
  93.   end;
  94.   {$ENDIF}
  96.   {-- TMMWaveOut ---------------------------------------------------------}
  97.   TMMWaveOut = class(TMMCustomWaveOutComponent)
  98.   private
  99.     FHandle        : THandle;        { handle used for callback window    }
  100.     FDeviceID      : TMMDeviceID;    { WAVEOUT device ID                  }
  101.     FHWaveOut      : HWaveOut;       { Handle to output device            }
  102.     FState         : TMMWaveOutState;{ Current device state               }
  103.     FWaveOutHdrs   : TMMWaveOutHdrs; { WaveOut Headers and Buffers        }
  104.     FBufferOutIdx  : integer;        { the current Out Header/BufferIndex }
  105.     FCallbackMode  : TMMCBMode;      { use Window or Callback function    }
  106.     FError         : integer;        { Last WaveOut Error                 }
  107.     FNumdevs       : integer;      { Num. of output devices on system   }
  108.     FWaveOutCaps   : TWaveOutCaps;   { Stuff from WAVEOUTCAPS             }
  109.     FProductName   : String;         { the device Productname             }
  110.     FDriverVersion : integer;        { Specifies the driver version       }
  111.                                      { high-order byte is major version   }
  112.                                      { low-order byte is minor version    }
  113.     FInHandler     : integer;        { marks that we in any event handler }
  114.     FStarted       : Boolean;        { device is now started              }
  115.     FStopIt        : Boolean;        { we should stop playing if possible }
  116.     FCloseIt       : Boolean;        { we should close device if possible }
  117.     FStopping      : Boolean;        { we actually stop the device        }
  118.     FClosing       : Boolean;        { we actually close the device       }
  119.     FReseting      : Boolean;        { we actually reseting the device    }
  120.     FPosted        : Boolean;
  121.     FLooping       : Boolean;        { loop playing or not                }
  122.     FLoopCount     : Word;           { number of loops                    }
  123.     FLoopTempCount : integer;        { temp loop counter for playing      }
  124.     FLoopPos       : MM_int64;       { adjust for loop and GetPosition    }
  125.     FOldPosition   : MM_int64;       { the old play position before pause }
  126.     FLastPosition  : Cardinal;       { the last playback position         }
  127.     FWrapArrounds  : Cardinal;       { number of position wrap-arrounds   }
  128.     FWrapSize      : Cardinal;       { where has the position wrapped ?   }
  129.     FBytesPlayed   : MM_Int64;       { total bytes we have realy played   }
  130.     FMoreBuffers   : Boolean;        { more buffers to write ?            }
  131.     FNumBuffers    : integer;        { number of buffers for queue        }
  132.     FBuffersUsed   : integer;        { the real buffers we have in use    }
  133.     FBufferCounter : integer;        { buffer counter for buffers in use  }
  134.     FTimeFormat    : TMMTimeFormats; { the actual time format for Position}
  135.     FShowHourGlass : Boolean;
  136.     FEndingPosition: MM_int64;
  137.     FMapped        : Boolean;
  138.     FAllocator     : TMMAllocator;
  140.     {$IFDEF WIN32}
  141.     FPriority      : TThreadPriority;{ thread priority                    }
  142.     FThreadError   : Boolean;        { Error in Thread Handler            }
  143.     FOutThread     : TMMWaveOutThread;{ Output Thread for callback handling}
  144.     DataSection    : TRtlCriticalSection;{ CriticalSection Object         }
  145.     DataSectionOK  : Boolean;        { CriticalSection is prepared        }
  146.     FOutEvent      : THandle;        { event object for notify handling   }
  147.     FCloseEvent    : THandle;        { event object to close the device   }
  148.     FResetEvent    : THandle;        { event object to reset the device   }
  149.     {$ENDIF}
  151.     { Events }
  152.     FOnError       : TNotifyEvent;   { Error occured                      }
  153.     FOnBufferFilled: TMMBufferEvent; { Wave buffer filled event           }
  154.     FOnLooping     : TNotifyEvent;   { Wave was at end and is looped      }
  155.     FOnOpen        : TNotifyEvent;   { Wave Device succ. opened           }
  156.     FOnStart       : TNotifyEvent;   { Wave Device succ. started          }
  157.     FOnPause       : TNotifyEvent;   { Wave Device succ. paused           }
  158.     FOnRestart     : TNotifyEvent;   { Wave Device succ. restarted        }
  159.     FOnStop        : TNotifyEvent;   { Wave Device succ. stopped          }
  160.     FOnClose       : TNotifyEvent;   { Wave Device succ. closed           }
  162.     function  WaveOutErrorString(WError: integer): string;
  163.     procedure SetTimeFormat(aValue: TMMTimeFormats);
  164.     procedure SetLooping(aValue: Boolean);
  165.     procedure SetLoopCount(aValue: Word);
  166.     function  GetSamplePosition: Cardinal;
  167.     function  GetInternalPosition: int64;
  168.     function  GetPositionHigh: Cardinal;
  169.     procedure WaveOutHandler(var Msg: TMessage);
  170.     procedure AllocWaveHeader(var lpWaveHdr: PWaveHdr);
  171.     procedure FreeWaveHeaders;
  172.     procedure PrepareWaveHeader(lpWaveHdr: PWaveHdr);
  173.     procedure UnPrepareWaveHeaders;
  174.     function  LoadWaveHeader(lpWaveHdr: PWaveHdr): Longint;
  175.     procedure QueueWaveHeader(lpWaveHdr: PWaveHdr);
  176.     procedure ProcessWaveHeader(lpWaveHdr: PWaveHdr);
  178.     {$IFDEF WIN32}
  179.     procedure SetPriority(aValue: TThreadPriority);
  181.     procedure InitThread;
  182.     procedure DoneThread;
  183.     procedure CloseEvents;
  184.     {$ENDIF}
  186.     procedure InitCritical;
  187.     procedure EnterCritical;
  188.     procedure LeaveCritical;
  189.     procedure DoneCritical;
  191.     procedure DoOpened;
  192.     procedure DoClosed;
  193.     procedure DoStarted;
  194.     procedure DoPaused;
  195.     procedure DoRestarted;
  196.     procedure DoStopped;
  197.     procedure DoBufferFilled(lpwh: PWaveHdr);
  198.     procedure DoBufferReady(lpwh: PWaveHdr);
  200.   protected
  201.     procedure SetPWaveFormat(aValue: PWaveFormatEx); override;
  202.     procedure SetBufferSize(aValue: Longint); override;
  203.     function  GetBufferSize: Longint; override;
  204.     procedure SetNumBuffers(aValue: integer); override;
  205.     function  GetNumBuffers: integer; override;
  206.     procedure SetDeviceID(aValue: TMMDeviceID); override;
  207.     function  GetDeviceID: TMMDeviceID; override;
  208.     procedure SetProductName(aValue: string); override;
  209.     function  GetProductName: string; override;
  210.     procedure SetCallBackMode(aValue: TMMCBMode); override;
  211.     function  GetCallBackMode: TMMCBMode; override;
  212.     function  GetPosition: MM_int64; override;
  214.     procedure Error(Msg: string); virtual;
  216.   public
  217.     procedure Opened; override;
  218.     procedure Closed; override;
  219.     procedure Started; override;
  220.     procedure Paused; override;
  221.     procedure Restarted; override;
  222.     procedure Stopped; override;
  224.     procedure BufferReady(lpwh: PWaveHdr); override;
  225.     procedure BufferLoad(lpwh: PWaveHdr; var MoreBuffers: Boolean); override;
  227.     constructor Create(AOwner: TComponent); override;
  228.     destructor Destroy; override;
  230.     procedure Open; override;
  231.     procedure Close; override;
  232.     procedure Reset; override;
  233.     procedure Start; override;
  234.     procedure Pause; override;
  235.     procedure Restart; override;
  236.     procedure Stop; override;
  238.     function  QueryDevice(aDeviceID: TMMDeviceID; pwfx: PWaveFormatEx): Boolean;
  240.     {$IFDEF WIN32}
  241.     { maybe you must syncronize anything if UseThread = True ? }
  242.     procedure SynchronizeVCL(VCLProc: TThreadMethod);
  243.     {$ENDIF}
  245.     property Handle: HWaveOut read FHWaveOut;
  246.     property WaveOutCaps: TWaveOutCaps read FWaveOutCaps;
  247.     property Numdevs: integer read FNumdevs;
  248.     property State: TMMWaveOutState read FState;
  249.     property DriverVersion: integer read FDriverVersion;
  250.     property BytesPlayed: MM_Int64 read FBytesPlayed;
  251.     property Position: MM_int64 read GetPosition;
  252.     property PositionHigh: Cardinal read GetPositionHigh;
  253.     property EndingPosition: MM_int64 read FEndingPosition;
  254.     property BufferIndex: integer read FBufferOutIdx;
  255.     {$IFNDEF CBUILDER3}
  256.     property WaveHdrs: TMMWaveOutHdrs read FWaveOutHdrs;
  257.     {$ENDIF}
  259.   published
  260.     { Events }
  261.     property OnError: TNotifyEvent read FOnError write FOnError;
  262.     property OnOpen: TNotifyEvent read FOnOpen write FOnOpen;
  263.     property OnStart: TNotifyEvent read FOnStart write FOnStart;
  264.     property OnPause: TNotifyEvent read FOnPause write FOnPause;
  265.     property OnRestart: TNotifyEvent read FOnRestart write FOnRestart;
  266.     property OnStop: TNotifyEvent read FOnStop write FOnStop;
  267.     property OnClose: TNotifyEvent read FOnClose write FOnClose;
  268.     property OnLooping: TNotifyEvent read FOnLooping write FOnLooping;
  269.     property OnBufferFilled: TMMBufferEvent read FOnBufferFilled write FOnBufferFilled;
  270.     property OnBufferReady;
  271.     property OnBufferLoad;
  273.     property Input;
  274.     property Output;
  275.     property BufferSize;
  276.     property NumBuffers;
  277.     property DeviceID;
  278.     property ProductName;
  279.     property CallBackMode;
  280.     property TimeFormat: TMMTimeFormats read FTimeFormat write SetTimeFormat default tfByte;
  281.     property Looping: Boolean read FLooping write SetLooping default False;
  282.     property LoopCount: Word read FLoopCount write SetLoopCount default 0;
  283.     property ShowHourGlass: Boolean read FShowHourGlass write FShowHourGlass default True;
  284.     property Mapped: Boolean read FMapped write FMapped default False;
  285.     {$IFDEF WIN32}
  286.     property Priority: TThreadPriority read FPriority write SetPriority default tpHigher;
  287.     {$ENDIF}
  288.   end;
  290. function WaveOutGetDeviceName(DeviceID: TMMDeviceID): String;
  291. function WaveOutReady(DeviceID: TMMDeviceID): Boolean;
  293. implementation
  295. {$DEFINE _USE_CALLBACK}
  297. uses consts;
  299. const
  300.      MM_WOM_STOP = MM_USER+1;
  302. procedure WaveOutFunc(hWaveOut:HWaveOut;wMsg:UINT;dwInstance,dwParam1,dwParam2:Longint);
  303. export;{$IFDEF WIN32}stdcall;{$ENDIF}forward;
  305. {-------------------------------------------------------------------------}
  306. procedure DebugStr(Level: integer; s: String);
  307. begin
  308. {$IFDEF _MMDEBUG}
  309.    if (s <> ' ') then s := 'WaveOut: '+s;
  310.    DB_WriteStrLn(Level,s);
  311. {$ENDIF}
  312. end;
  314. {-------------------------------------------------------------------------}
  315. function WaveOutReady(DeviceID: TMMDeviceID): Boolean;
  316. var
  317.    OutHandle: HWAVEOUT;
  318.    Error: MMRESULT;
  319.    wfx: TWaveFormatEx;
  321. begin
  322.    Result := False;
  323.    if (DeviceID < integer(waveOutGetNumDevs)) and (DeviceID >= integer(WAVE_MAPPER)) then
  324.    try
  325.       OutHandle := 0;
  326.       pcmBuildWaveHeader(@wfx, 8, 1, 22050);
  327.       {$IFDEF WIN32}
  328.       Error := WaveOutOpen(@OutHandle, DeviceId, MMSystem.PWaveFormatEx(@wfx), 0, 0, CALLBACK_NULL);
  329.       {$ELSE}
  330.       Error := WaveOutOpen(@OutHandle, DeviceId, Pointer(@wfx), 0, 0, CALLBACK_NULL);
  331.       {$ENDIF}
  332.       if (Error = MMSYSERR_NOERROR) then
  333.       begin
  334.          Result := True;
  335.       end;
  336.    finally
  337.       if (OutHandle <> 0) then WaveOutClose(OutHandle);
  338.    end;
  339. end;
  341. {-------------------------------------------------------------------------}
  342. function WaveOutGetDeviceName(DeviceID: TMMDeviceID): String;
  343. var
  344.    Caps   : TWaveOutCaps;
  346. begin
  347.    Result := '';
  348.    if (DeviceID < integer(waveOutGetNumDevs)) and (DeviceID >= integer(WAVE_MAPPER)) then
  349.    begin
  350.       { Set the name and other WAVEOUTCAPS properties to match the ID }
  351.       if waveOutGetDevCaps(DeviceID, @Caps, sizeof(TWaveOutCaps)) = 0 then
  352.          Result := StrPas(Caps.szPname);
  353.    end;
  354. end;
  356. {== TMMWaveOut ===========================================================}
  357. constructor TMMWaveOut.Create(AOwner: TComponent);
  358. begin
  359.    inherited Create(AOwner);
  361.    { Set defaults }
  362.    FHWaveOut := 0;
  363.    FHandle   := 0;
  364.    FState := [wosClose];
  365.    FError := 0;
  366.    FNumBuffers := 10;
  367.    FProductName := '';
  368.    FDriverVersion := 0;
  369.    FBytesPlayed := 0;
  370.    FTimeFormat := tfByte;
  371.    FMoreBuffers := False;
  372.    FLooping := False;
  373.    FLoopCount := 0;
  374.    FCallBackMode := cmWindow;
  375.    FClosing := False;
  376.    FReseting := False;
  377.    FStopping := False;
  378.    FPosted := False;
  379.    FBufferOutIdx := 0;
  380.    FShowHourGlass := True;
  381.    FEndingPosition:= 0;
  382.    {$IFDEF WIN32}
  383.    FPriority := tpHigher;
  384.    {$ENDIF}
  386.    FAllocator := TMMAllocator.Create;
  387.    
  388.    {clear all pointers to Nil }
  389.    FillChar(FWaveOutHdrs, sizeOf(TMMWaveOutHdrs), 0);
  391.    FNumDevs := waveOutGetNumDevs;
  392.    SetDeviceID(0);
  394.    {$IFDEF WIN32}
  395.    DataSectionOK := False;
  396.    {$ENDIF}
  398.    ErrorCode := ComponentRegistered(InitCode, Self, ClassName);
  399.    if (ErrorCode <> 0) then RegisterFailed(InitCode, Self , ClassName);
  400. end;
  402. {-- TMMWaveOut -----------------------------------------------------------}
  403. destructor TMMWaveOut.Destroy;
  404. begin
  405.    { Close the device if it's open }
  406.    if (FHWaveOut <> 0) then Close;
  408.    { Destroy the window for callback notification }
  409.    if (FHandle <> 0) then DeallocateHwnd(FHandle);
  411.    if (FAllocator <> nil) then FAllocator.Free;
  413.    inherited Destroy;
  414. end;
  416. {-- TMMWaveOut -----------------------------------------------------------}
  417. procedure TMMWaveOut.Error(Msg: string);
  418. begin
  419.    if assigned(FOnError) then FOnError(Self);
  421.    {$IFDEF _MMDEBUG}
  422.    DebugStr(0,Msg);
  423.    {$ENDIF}
  425.    raise EMMWaveOutError.Create(Msg);
  426. end;
  428. {-- TMMWaveOut -----------------------------------------------------------}
  429. { Allocate memory for the WaveOut header and buffer }
  430. procedure TMMWaveOut.AllocWaveHeader(var lpWaveHdr: PWaveHdr);
  431. begin
  432.    if (lpWaveHdr = Nil) then
  433.    begin
  434.       { set up a wave header for playing and lock. }
  435.       lpWaveHdr := FAllocator.AllocBuffer(GPTR, SizeOf(TMMWaveHdr) + BufferSize);
  436.       if lpWaveHdr = nil then
  437.          Error(LoadResStr(IDS_HEADERMEMERROR));
  439.       { Data occurs directly after the header }
  440.       lpWaveHdr^.lpData         := PChar(lpWaveHdr) + sizeOf(TMMWaveHdr);
  441.       lpWaveHdr^.dwBufferLength := BufferSize;
  442.       lpWaveHdr^.dwBytesRecorded:= 0;
  443.       lpWaveHdr^.dwFlags        := 0;
  444.       lpWaveHdr^.dwLoops        := 0;
  445.       lpWaveHdr^.dwUser         := 0;
  446.       lpWaveHdr^.lpNext         := nil;
  447.    end;
  448. end;
  450. {-- TMMWaveOut -----------------------------------------------------------}
  451. procedure TMMWaveOut.FreeWaveHeaders;
  452. Var
  453.    i: integer;
  455. begin
  456.    for i := 0 to FNumBuffers-1 do
  457.    begin
  458.       { unlock and free memory for WaveOutHdr }
  459.       if FWaveOutHdrs[i] <> NIL then
  460.       begin
  461.          FAllocator.FreeBuffer(Pointer(FWaveOutHdrs[i]));
  462.          FWaveOutHdrs[i] := Nil;
  463.       end;
  464.    end;
  465. end;
  467. {-- TMMWaveOut -----------------------------------------------------------}
  468. procedure TMMWaveOut.SetLooping(aValue: Boolean);
  469. begin
  470.    if (aValue <> FLooping) then
  471.    begin
  472.       FLooping := aValue;
  473.       FLoopTempCount := FLoopCount;
  474.    end;
  475.    {$IFDEF WIN32}
  476.    {$IFDEF TRIAL}
  477.    {$DEFINE _HACK1}
  478.    {$I MMHACK.INC}
  479.    {$ENDIF}
  480.    {$ENDIF}
  481. end;
  483. {-- TMMWaveOut -----------------------------------------------------------}
  484. procedure TMMWaveOut.SetLoopCount(aValue: Word);
  485. begin
  486.    if (aValue <> FLoopCount) then
  487.    begin
  488.       FLoopCount := aValue;
  489.       FLoopTempCount := FLoopCount;
  490.    end;
  491. end;
  493. {-- TMMWaveOut -----------------------------------------------------------}
  494. function TMMWaveOut.WaveOutErrorString(WError: integer): String;
  495. Var
  496.    errorDesc: PChar;
  498. begin
  499.    { Convert the numeric return code from an MMSYSTEM function to a string }
  500.    errorDesc := Nil;
  501.    try
  502.       errorDesc := StrAlloc(MAXERRORLENGTH);
  503.       if waveOutGetErrorText(WError, errorDesc, MAXERRORLENGTH) = 0 then
  504.          Result := StrPas(errorDesc)
  505.       else
  506.          Result := LoadResStr(IDS_ERROROUTOFRANGE);
  508.    finally
  509.       StrDispose(errorDesc);
  510.    end;
  511. end;
  513. {-- TMMWaveOut -----------------------------------------------------------}
  514. Procedure TMMWaveOut.SetDeviceID(aValue: TMMDeviceID);
  515. begin
  516.    if (wosOpen in FState) then
  517.        Error(LoadResStr(IDS_PROPERTYOPEN));
  519.    FProductName := LoadResStr(IDS_WONODEVICE);
  520.    FDriverVersion := 0;
  522.    if (FNumDevs > 0) and (aValue >= MapperId) and (aValue < FNumDevs) then
  523.    begin
  524.       { Set the name and other WAVEOUTCAPS properties to match the ID }
  525.       FError := waveOutGetDevCaps(aValue, @FWaveOutCaps, sizeof(TWaveOutCaps));
  526.       if FError = 0 then
  527.       with FWaveOutCaps do
  528.       begin
  529.          FProductName := StrPas(szPname);
  530.          FDriverVersion := vDriverVersion;
  531.       end;
  532.    end;
  534.    { set the new device }
  535.    FDeviceID := aValue;
  536.    if (aValue < MapperId) or (aValue >= FNumDevs) then
  537.        FDeviceID := InvalidID;
  539.    {$IFDEF WIN32}
  540.    {$IFDEF TRIAL}
  541.    {$DEFINE _HACK1}
  542.    {$I MMHACK.INC}
  543.    {$ENDIF}
  544.    {$ENDIF}
  545. end;
  547. {-- TMMWaveOut -----------------------------------------------------------}
  548. function TMMWaveOut.GetDeviceID: TMMDeviceID;
  549. begin
  550.    Result := FDevicEID;
  551. end;
  553. {-- TMMWaveOut -----------------------------------------------------------}
  554. procedure TMMWaveOut.SetProductName(aValue: String);
  555. begin
  556.    ;
  557. end;
  559. {-- TMMWaveOut -----------------------------------------------------------}
  560. function TMMWaveOut.GetProductName: String;
  561. begin
  562.    Result := FProductName;
  563. end;
  565. {-- TMMWaveOut -----------------------------------------------------------}
  566. function TMMWaveOut.QueryDevice(aDeviceID: TMMDeviceID; pwfx: PWaveFormatEx): Boolean;
  567. Var
  568.    aHandle: HWaveOut;
  570. begin
  571.    if (aDeviceID < FNumDevs) and (aDeviceID >= MapperID) and (pwfx <> nil) then
  572.    begin
  573.       { query the Wave output device. }
  574.       Result := WaveOutOpen(@aHandle,
  575.                             aDeviceId,
  576.                             Pointer(pwfx),
  577.                             0, 0,
  578.                             WAVE_FORMAT_QUERY) = 0;
  579.    end
  580.    else Result := False;
  581. end;
  583. {-- TMMWaveOut ------------------------------------------------------------}
  584. procedure TMMWaveOut.SetTimeFormat(aValue: TMMTimeFormats);
  585. begin
  586.    if (aValue <> FTimeFormat) then
  587.    begin
  588.       FTimeFormat := aValue;
  589.    end;
  590. end;
  592. {-- TMMWaveOut ------------------------------------------------------------}
  593. function TMMWaveOut.GetSamplePosition: Cardinal;
  594. Var
  595.    MMTime: TMMTime;
  597. begin
  598.    Result := 0;
  599.    if (wosOpen in FState) then
  600.    begin
  601.       MMTime.wType := Time_Samples;
  602.       FError := WaveOutGetPosition(FHWaveOut, @MMTime, SizeOf(TMMTime));
  603.       if (FError <> 0) or (MMTime.wType <> Time_Samples) then
  604.       begin
  605.          MMTime.wType := Time_Bytes;
  606.          FError := WaveOutGetPosition(FHWaveOut, @MMTime, SizeOf(TMMTime));
  607.          if (FError <> 0) then
  608.              Error('WaveOutGetPosition:'#10#13+WaveOutErrorString(FError));
  610.          MMTime.Sample := wioBytesToSamples(PWaveFormat,MMTime.cb);
  611.       end;
  612.       Result := MMTime.Sample;
  613.       {asm
  614.          mov   eax, $FFFF0000
  615.          add   Result, eax
  616.       end;}
  617.    end;
  618. end;
  620. {-- TMMWaveOut ------------------------------------------------------------}
  621. function TMMWaveOut.GetInternalPosition: Int64;
  622. var
  623.    Samples,Pos: int64;
  624.    S: Cardinal;
  625.    WrapSize: int64;
  626. begin
  627.    Result := 0;
  628.    if (wosOpen in FState) and (PWaveFormat <> Nil) and not FCloseIt then
  629.    begin
  630.       { adjust if Looped or FullDuplex }
  631.       S := GetSamplePosition;
  632.       {$IFDEF WIN32}
  633.       asm
  634.          mov   eax, S
  635.          mov   dword ptr Pos[0], eax
  636.          xor   eax, eax
  637.          mov   dword ptr Pos[4], eax
  639.          mov   eax, Self
  640.          mov   eax, TMMWaveOut(eax).FWrapSize
  641.          mov   dword ptr WrapSize[0], eax
  642.          xor   eax, eax
  643.          mov   dword ptr WrapSize[4], eax
  644.       end;
  646.       Samples := (FWrapArrounds*WrapSize)+(Pos+FOldPosition)-FLoopPos;
  647.       {$ELSE}
  648.       Samples := (S+FOldPosition)-FLoopPos;
  649.       {$ENDIF}
  651.       case FTimeFormat of
  652.            tfMilliSecond: Result := wioSamplesToTime64(PWaveFormat,Samples);
  653.            tfByte       : Result := wioSamplesToBytes64(PWaveFormat,Samples);
  654.            tfSample     : Result := Samples;
  655.       end;
  656.    end;
  657. end;
  659. {-- TMMWaveOut ------------------------------------------------------------}
  660. function TMMWaveOut.GetPosition: MM_int64;
  661. {$IFNDEF DELPHI4}
  662. var
  663.    Temp: TLargeInteger;
  664. {$ENDIF}
  665. begin
  666.    {$IFDEF DELPHI4}
  667.    Result := GetInternalPosition;
  668.    {$ELSE}
  669.    Temp.QuadPart := GetInternalPosition;
  670.    Result := Temp.LowPart;
  671.    {$ENDIF}
  672. end;
  674. {-- TMMWaveOut ------------------------------------------------------------}
  675. function TMMWaveOut.GetPositionHigh: Cardinal;
  676. {$IFNDEF DELPHI4}
  677. var
  678.    Temp: TLargeInteger;
  679. {$ENDIF}
  680. begin
  681.    {$IFDEF DELPHI4}
  682.    Result := (GetInternalPosition shr 32);
  683.    {$ELSE}
  684.    Temp.QuadPart := GetInternalPosition;
  685.    Result := Temp.HighPart;
  686.    {$ENDIF}
  687. end;
  689. {-- TMMWaveOut -----------------------------------------------------------}
  690. Procedure TMMWaveOut.SetCallBackMode(aValue: TMMCBMode);
  691. begin
  692.    if (wosOpen in FState) then
  693.       Error(LoadResStr(IDS_PROPERTYOPEN));
  695.    if (aValue <> FCallBackMode) then
  696.    begin
  697.       if (aValue = cmCallBack) then
  698.       begin
  699.          {$IFDEF WIN32}
  700.          if not _Win95_ then
  701.          {$ENDIF}
  702.          begin
  703.             Application.MessageBox('"CallBacks" are called at interrupt time !'#10#13+
  704.                                    'This is currently only supported under Windows 95',
  705.                                    'TMMWaveOut', MB_OK);
  706.             exit;
  707.          end;
  708.       end;
  709.       FCallBackMode := aValue;
  710.    end;
  711.    {$IFDEF WIN32}
  712.    {$IFDEF TRIAL}
  713.    {$DEFINE _HACK3}
  714.    {$I MMHACK.INC}
  715.    {$ENDIF}
  716.    {$ENDIF}
  717. end;
  719. {-- TMMWaveOut -----------------------------------------------------------}
  720. function TMMWaveOut.GetCallBackMode: TMMCBMode;
  721. begin
  722.    Result := FCallBackMode;
  723. end;
  725. {-- TMMWaveOut -----------------------------------------------------------}
  726. Procedure TMMWaveOut.SetNumBuffers(aValue: integer);
  727. begin
  728.    if (aValue <> FNumBuffers) AND (aValue > 1) then
  729.    begin
  730.       if (wosOpen in FState) then
  731.           Error(LoadResStr(IDS_PROPERTYOPEN));
  733.       FNumBuffers := Min(aValue,MAXOUTBUFFERS);
  734.    end;
  735. end;
  737. {-- TMMWaveOut -----------------------------------------------------------}
  738. function TMMWaveOut.GetNumBuffers: integer;
  739. begin
  740.    Result := FNumBuffers;
  741. end;
  743. {-- TMMWaveOut -----------------------------------------------------------}
  744. Procedure TMMWaveOut.SetPWaveFormat(aValue: PWaveFormatEx);
  745. begin
  746.    { stop and close the device }
  747.    Close;
  748.    inherited SetPWaveFormat(aValue);
  749. end;
  751. {-- TMMWaveOut -----------------------------------------------------------}
  752. Procedure TMMWaveOut.SetBufferSize(aValue: Longint);
  753. begin
  754.    if (aValue <> inherited GetBufferSize) then
  755.    begin
  756.       if (wosOpen in FState) then
  757.           Error(LoadResStr(IDS_PROPERTYOPEN));
  759.       if assigned(FAllocator) then
  760.          FAllocator.Discard;
  762.       inherited SetBufferSize(Max(aValue,MINBUFFERSIZE));
  763.    end;
  764. end;
  766. {-- TMMWaveOut -----------------------------------------------------------}
  767. function TMMWaveOut.GetBufferSize: Longint;
  768. begin
  769.    Result := inherited GetBufferSize;
  770. end;
  772. {-- TMMWaveOut -----------------------------------------------------------}
  773. Procedure TMMWaveOut.PrepareWaveHeader(lpWaveHdr: PWaveHdr);
  774. begin
  775.    if lpWaveHdr <> Nil then
  776.    begin
  777.       { Prepare waveform header for playing }
  778.       WaveOutPrepareHeader(FHWaveOut, lpWaveHdr, sizeOf(TWaveHdr));
  779.    end;
  780. end;
  782. {-- TMMWaveOut -----------------------------------------------------------}
  783. Procedure TMMWaveOut.UnPrepareWaveHeaders;
  784. Var
  785.    i: integer;
  786.    TimeOut: Longint;
  788. begin
  789.    {$IFDEF _MMDEBUG}
  790.    DebugStr(1,' ');
  791.    {$ENDIF}
  793.    for i := 0 to FBuffersUsed-1 do
  794.    begin
  795.       if (FWaveOutHdrs[i] <> Nil) then
  796.       begin
  797.          TimeOut := 65000;
  798.          { wait until the buffer is marked as done }
  799.          repeat
  800.              dec(TimeOut);
  801.          until (FWaveOutHdrs[i]^.dwFlags and WHDR_DONE = WHDR_DONE) or (TimeOut = 0);
  803.          { mark buffer as done }
  804.          if (TimeOut = 0) then FWaveOutHdrs[i]^.dwFlags := WHDR_DONE;
  806.          { unprepare buffer }
  807.          WaveOutUnprepareHeader(FHWaveOut, FWaveOutHdrs[i], sizeOf(TWAVEHDR));
  809.          {$IFDEF _MMDEBUG}
  810.          DebugStr(1,'UnprepareHeader '+IntToStr(i));
  811.          {$ENDIF}
  812.       end;
  813.    end;
  815.    {$IFDEF _MMDEBUG}
  816.    DebugStr(1,' ');
  817.    {$ENDIF}
  818. end;
  820. {-- TMMWaveOut -----------------------------------------------------------}
  821. Function TMMWaveOut.LoadWaveHeader(lpWaveHdr: PWaveHdr): Longint;
  822. begin
  823.    Result := 0;
  824.    FMoreBuffers := False;
  826.    if (lpWaveHdr <> nil) then
  827.    begin
  828.       {$IFDEF _MMDEBUG}
  829.       DebugStr(2,'Try to load Buffer '+IntToStr(lpWaveHdr^.dwUser));
  830.       {$ENDIF}
  832.       BufferLoad(lpWaveHdr, FMoreBuffers);
  834.       Result := lpWaveHdr^.dwBytesRecorded;
  835.       if Result <= 0 then FMoreBuffers := False;
  837.       {$IFDEF _MMDEBUG}
  838.       DebugStr(2,'Buffer '+IntToStr(lpWaveHdr^.dwUser)+' loaded');
  839.       {$ENDIF}
  840.    end;
  841. end;
  843. {-- TMMWaveOut -----------------------------------------------------------}
  844. procedure TMMWaveOut.QueueWaveHeader(lpWaveHdr: PWaveHdr);
  845. begin
  846.    { this is the chance to modify the data in the buffer !!! }
  847.    DoBufferFilled(lpWaveHdr);
  849.    if not FStopping then
  850.    begin
  851.       if not FIX_BUFFERS then
  852.          WaveOutPrepareHeader(FHWaveOut, lpWaveHdr, sizeOf(TWaveHdr))
  853.       else
  854.          { reset flags field (remove WHDR_DONE attribute) }
  855.          lpWaveHdr^.dwFlags := lpWaveHdr^.dwFlags and not WHDR_DONE or WHDR_PREPARED;
  857.       {$IFDEF _MMDEBUG}
  858.       DebugStr(2,'Try to send Wave-Header '+IntToStr(lpWaveHdr^.dwUser)+' to driver');
  859.       {$ENDIF}
  861.       PMMWaveHdr(lpWaveHdr)^.dwUser2 := lpWaveHdr^.dwBytesRecorded;
  863.       { now queue the buffer for output }
  864.       FError := WaveOutWrite(FHWaveOut,
  865.                              lpWaveHdr,
  866.                              SizeOf(TWAVEHDR));
  868.       if FError <> 0 then
  869.          Error('WaveOutWrite:'#10#13+WaveOutErrorString(FError));
  871.       { BUG-FIX for NT 4.0 SP4, it does set dwBytesRecorded to zero }
  872.       lpWaveHdr^.dwBytesRecorded := PMMWaveHdr(lpWaveHdr)^.dwUser2;
  874.       EnterCritical;
  875.       inc(FBufferCounter);
  876.       LeaveCritical;
  878.       {$IFDEF _MMDEBUG}
  879.       DebugStr(2,'Wave-Header '+IntToStr(lpWaveHdr^.dwUser)+' queued');
  880.       {$ENDIF}
  881.    end;
  882. end;
  884. {$IFDEF WIN32}
  885. {-- TMMWaveOut -----------------------------------------------------------}
  886. procedure TMMWaveOut.SynchronizeVCL(VCLProc: TThreadMethod);
  887. begin
  888.    if (FCallBackMode = cmThread) and (FOutEvent <> 0) then
  889.    begin
  890.       FOutThread.Synchronize(VCLProc);
  891.    end
  892.    else VCLProc;
  893. end;
  895. {-- TMMWaveOut -----------------------------------------------------------}
  896. procedure TMMWaveOut.SetPriority(aValue: TThreadPriority);
  897. begin
  898.    FPriority := aValue;
  899.    if (FOutThread <> nil) then
  900.        FOutThread.Priority := FPriority;
  901. end;
  903. {-- TMMWaveOut -----------------------------------------------------------}
  904. procedure TMMWaveOut.InitThread;
  905. begin
  906.    if (FCallBackMode = cmThread) then
  907.    begin
  908.       EnterCritical;
  909.       try
  910.          FThreadError := False;
  912.          { create event objects }
  913.          FOutEvent    := CreateEvent(nil, False, False, nil);
  914.          FCloseEvent  := CreateEvent(nil, False, False, nil);
  915.          FResetEvent  := CreateEvent(nil, True, False, nil);
  917.          { create the output thread }
  918.          FOutThread := TMMWaveOutThread.CreateSuspended(Self);
  919.          if (FOutThread = nil) then
  920.              Error('WaveOut:'#10#13+LoadResStr(IDS_THREADERROR));
  922.          FOutThread.FreeOnTerminate := True;
  923.          FOutThread.Resume;
  925.          {$IFDEF _MMDEBUG}
  926.          DebugStr(0,'Wait for Thread start...');
  927.          {$ENDIF}
  929.          { Wait for it to start... }
  930.          if WaitForSingleObject(FOutEvent, 5000) <> WAIT_OBJECT_0 then
  931.             Error('WaveOut:'#10#13+LoadResStr(IDS_THREADERROR));
  933.          {$IFDEF _MMDEBUG}
  934.          DebugStr(0,'Thread Started');
  935.          {$ENDIF}
  937.       finally
  938.         LeaveCritical;
  939.       end;
  940.    end;
  941. end;
  943. {-- TMMWaveOut -----------------------------------------------------------}
  944. procedure TMMWaveOut.DoneThread;
  945. begin
  946.    if (FCallBackMode = cmThread) and (FOutEvent <> 0) and not FThreadError then
  947.    begin
  948.       { Force the output thread to close... }
  949.       SetEvent(FCloseEvent);
  951.       { ...and wait for it to die }
  952.       WaitForSingleObject(FOutEvent, 5000);
  954.       { close all events and remove critical section }
  955.       CloseEvents;
  957.       {$IFDEF _MMDEBUG}
  958.       DebugStr(0,'Thread Terminated');
  959.       {$ENDIF}
  960.    end;
  961. end;
  963. {-- TMMWaveOut -----------------------------------------------------------}
  964. procedure TMMWaveOut.CloseEvents;
  965. begin
  966.    if (FOutEvent <> 0) then
  967.    begin
  968.       { release events }
  969.       CloseHandle(FOutEvent);
  970.       CloseHandle(FCloseEvent);
  971.       CloseHandle(FResetEvent);
  972.       FOutEvent := 0;
  973.       FCloseEvent := 0;
  974.       FResetEvent := 0;
  976.       { Free the critical section }
  977.       DoneCritical;
  978.    end;
  979. end;
  980. {$ENDIF}
  982. {-- TMMWaveOut -----------------------------------------------------------}
  983. procedure TMMWaveOut.InitCritical;
  984. begin
  985.    {$IFDEF WIN32}
  986.    { create critical section object }
  987.    FillChar(DataSection, SizeOf(DataSection), 0);
  988.    InitializeCriticalSection(DataSection);
  989.    DataSectionOK := True;
  990.    {$ENDIF}
  991. end;
  993. {-- TMMWaveOut -----------------------------------------------------------}
  994. procedure TMMWaveOut.EnterCritical;
  995. begin
  996.    {$IFDEF WIN32}
  997.    if DataSectionOK then
  998.       EnterCriticalSection(DataSection);
  999.    {$ENDIF}
  1000. end;
  1002. {-- TMMWaveOut -----------------------------------------------------------}
  1003. procedure TMMWaveOut.LeaveCritical;
  1004. begin
  1005.    {$IFDEF WIN32}
  1006.    if DataSectionOK then
  1007.       LeaveCriticalSection(DataSection);
  1008.    {$ENDIF}
  1009. end;
  1011. {-- TMMWaveOut -----------------------------------------------------------}
  1012. procedure TMMWaveOut.DoneCritical;
  1013. begin
  1014.    {$IFDEF WIN32}
  1015.    if DataSectionOK then
  1016.    begin
  1017.       DataSectionOK := False;
  1018.       DeleteCriticalSection(DataSection);
  1019.    end;
  1020.    {$ENDIF}
  1021. end;
  1023. {-- TMMWaveOut -----------------------------------------------------------}
  1024. Procedure TMMWaveOut.Open;
  1025. var
  1026.    TimeOut: integer;
  1027.    dwFlags: Longint;
  1028. begin
  1029.    if (FNumDevs = 0) then
  1030.       Error(LoadResStr(IDS_WONODEVICE));
  1032.    if (FDeviceID = InvalidId) then
  1033.       Error(LoadResStr(IDS_INVALIDDEVICEID));
  1035.    if (PWaveFormat = Nil) then
  1036.        Error('WaveOutOpen:'#10#13+LoadResStr(IDS_NOFORMAT));
  1038.    if (wosOpen in FState) then Close;
  1040.    if (Not(wosOpen in FState)) and not FClosing then
  1041.    begin
  1042.       {$IFDEF _MMDEBUG}
  1043.       //DB_Clear;
  1044.       DB_WriteStrLn(0,'-----------------');
  1045.       {$ENDIF}
  1047.       FClosing := False;
  1048.       FReseting := False;
  1049.       FStopping := False;
  1050.       FPosted   := False;
  1051.       try
  1052.          if not QueryDevice(FDeviceID, PWaveFormat) then
  1053.             Error('WaveOutOpen:'#10#13+LoadResStr(IDS_CANTPLAY));
  1055.          { Create the window for callback notification }
  1056.          if (FHandle = 0) then FHandle := AllocateHwnd(WaveOutHandler);
  1058.          {$IFDEF _MMDEBUG}
  1059.          DebugStr(0,'Call inherited...');
  1060.          {$ENDIF}
  1062.          FHWaveOut := 0;
  1063.          FCloseIt := False;
  1065.          inherited Opened;
  1067.          {$IFDEF _MMDEBUG}
  1068.          DebugSTr(0,'Try to open device...');
  1069.          {$ENDIF}
  1071.          { create critical section object }
  1072.          InitCritical;
  1074.          {$IFDEF WIN32}
  1075.          if (FCallBackMode = cmThread) then InitThread;
  1076.          {$ENDIF}
  1078.          TimeOut := 500;
  1080.          {$IFDEF WIN32}
  1081.          if FMapped and (FDeviceID >= 0) then
  1082.             dwFlags := WAVE_MAPPED
  1083.          else
  1084.          {$ENDIF}
  1085.             dwFlags := 0;
  1087.          {$IFDEF _USE_CALLBACK}
  1088.          if _Win9x_ or _WinNT4_ then
  1089.          begin
  1090.             { now open Wave output device. }
  1091.             FError := WaveOutOpen(@FHWaveOut,
  1092.                                   FDeviceId,
  1093.                                   Pointer(PWaveFormat),
  1094.                                   Longint(@WaveOutFunc),
  1095.                                   Longint(Self),
  1096.                                   CALLBACK_FUNCTION or dwFlags);
  1097.          end
  1098.          else
  1099.          {$ENDIF}
  1100.          begin
  1101.             { now open Wave output device. }
  1102.             FError := WaveOutOpen(@FHWaveOut,
  1103.                                   FDeviceId,
  1104.                                   Pointer(PWaveFormat),
  1105.                                   FHandle,
  1106.                                   0,
  1107.                                   CALLBACK_WINDOW or dwFlags);
  1108.          end;
  1110.          if (FError <> 0) then
  1111.              Error('WaveOutOpen:'#10#13+WaveOutErrorString(FError));
  1113.          { wait until the device returns its status }
  1114.          repeat
  1115.              {$IFDEF _USE_CALLBACK}
  1116.              if _Win9x_ or _WinNT4_ then
  1117.                 Delay(10,False)
  1118.              else
  1119.              {$ENDIF}
  1120.                 Delay(10,True);
  1121.              dec(TimeOut);
  1122.          until (wosOpen in FState) or (TimeOut <= 0);
  1124.          if (TimeOut <= 0) then
  1125.      Error('WaveOutOpen:'#10#13+LoadResStr(IDS_CANTOPENDEVICE));
  1127.          DoOpened;
  1129.       except
  1130.          if assigned(FOnError) then FOnError(Self);
  1131.          FState := [wosOpen];
  1132.          Close;
  1133.          FState := [wosClose];
  1134.          raise;
  1135.       end;
  1136.    end;
  1137. end;
  1139. {-- TMMWaveOut -----------------------------------------------------------}
  1140. Procedure TMMWaveOut.Close;
  1141. var
  1142.    TimeOut: integer;
  1143. begin
  1144.    if (wosOpen in FState) and (not FClosing or FCloseIt) then
  1145.    try
  1146.       FClosing := True;
  1148.       { stop playing }
  1149.       if (wosPlay in FState) OR (wosPause in FState) then Stop;
  1151.       TimeOut := 500;
  1153.       { Close the device (finally!) }
  1154.       if FStopIt then FCloseIt := True
  1155.       else
  1156.       begin
  1157.          FCloseIt := False;
  1158.          if (FHWaveOut <> 0) then
  1159.          begin
  1160.             {$IFDEF _MMDEBUG}
  1161.             if (FInHandler > 0) then
  1162.                DebugStr(0,'Try to close device (while in Handler)...')
  1163.             else
  1164.                DebugStr(0,'Try to close device...');
  1165.             {$ENDIF}
  1167.     FError := WaveOutClose(FHWaveOut);
  1168.     if FError <> 0 then
  1169.        Error('WaveOutClose:'#10#13+WaveOutErrorString(FError));
  1171.             { wait until the device returns its status }
  1172.             repeat
  1173.                {$IFDEF _USE_CALLBACK}
  1174.                if _Win9x_ or _WinNT4_ then
  1175.                   Delay(10,False)
  1176.                else
  1177.                {$ENDIF}
  1178.                   Delay(10,True);
  1179.                dec(TimeOut);
  1180.             until (wosClose in FState) or (TimeOut <= 0);
  1182.             FEndingPosition := 0;
  1183.             FWrapArrounds   := 0;
  1184.             FWrapSize       := 0;
  1185.          end
  1186.          else
  1187.          begin
  1188.             FState := [wosClose];
  1189.          end;
  1191.          { notify all other components }
  1192.          inherited Closed;
  1194.          {$IFDEF WIN32}
  1195.          if (FCallBackMode = cmThread) then
  1196.              { shot down the thread }
  1197.              DoneThread
  1198.          else
  1199.              { Free the critical section }
  1200.              DoneCritical;
  1201.          {$ENDIF}
  1203.          DoClosed;
  1205.          if (TimeOut <= 0) then
  1206.           Error('WaveOutClose:'#10#13+LoadResStr(IDS_CANTCLOSEDEVICE));
  1207.       end;
  1209.    except
  1210.       FClosing := False;
  1211.    end;
  1212. end;
  1214. {-- TMMWaveOut ------------------------------------------------------------}
  1215. Procedure TMMWaveOut.Reset;
  1216. var
  1217.    i: integer;
  1218.    TimeOut: Longint;
  1219.    Msg: TMsg;
  1221. begin
  1222.    if ((wosPlay in FState) or (wosPause in FState)) and not FReseting then
  1223.    begin
  1224.       try
  1225.          FReseting := True;
  1227.          FError := WaveOutPause(FHWaveOut);
  1228.          if FError <> 0 then
  1229.             Error('WaveOutPause:'#10#13+WaveOutErrorString(FError));
  1231.          if (FCallBackMode = cmWindow) then
  1232.             { remove all pending Messages from the queue }
  1233.             while PeekMessage(Msg, FHandle, MM_WOM_DONE, MM_WOM_DONE, PM_REMOVE) do
  1234.          {$IFDEF WIN32}
  1235.          else if (FCallBackMode = cmThread) then
  1236.          begin
  1237.             { remove all pending messages from threads queue }
  1238.             SetEvent(FResetEvent);
  1239.             { Wait for it to reset... }
  1240.             while WaitForSingleObject(FResetEvent, 0) = WAIT_OBJECT_0 do Sleep(1);
  1241.          end;
  1242.          {$ENDIF};
  1244.          FError := WaveOutReset(FHWaveOut);
  1245.          if FError > 0 then
  1246.             Error('WaveOutReset:'#10#13+WaveOutErrorString(FError));
  1248.          TimeOut := 100;
  1249.          repeat
  1250.              {$IFDEF _USE_CALLBACK}
  1251.              if _Win9x_ or _WinNT4_ then
  1252.                 Delay(10,False)
  1253.              else
  1254.              {$ENDIF}
  1255.                 Delay(10,True);
  1256.              dec(TimeOut);
  1257.          until not FReseting or (TimeOut <= 0);
  1259.          { this buggy drivers... :-( }
  1260.          FError := WaveOutRestart(FHWaveOut);
  1261.          if FError <> 0 then
  1262.             Error('WaveOutRestart:'#10#13+WaveOutErrorString(FError));
  1264.          { pause the output so the buffers won't play until we tell it }
  1265.          FError := WaveOutPause(FHWaveOut);
  1266.          if FError <> 0 then
  1267.             Error('WaveOutPause:'#10#13+WaveOutErrorString(FError));
  1269.          FBufferOutIdx := 0;
  1270.          FBufferCounter := 0;
  1271.          FOldPosition := 0;
  1272.          FLastPosition := 0;
  1273.          FWrapArrounds := 0;
  1274.          FWrapSize := 0;
  1275.          FLoopPos := 0;
  1277.          { notify all other components }
  1278.          Reseting;
  1280.          FMoreBuffers := True;
  1282.          { Load the number of buffers required }
  1283.          i := 0;
  1284.          while (i < FNumBuffers) and FMoreBuffers do
  1285.          begin
  1286.             { fill the buffer and send to driver }
  1287.             if LoadWaveHeader(FWaveOutHdrs[i]) > 0 then
  1288.                QueueWaveHeader(FWaveOutHdrs[i])
  1289.             else break;
  1290.             inc(i);
  1291.          end;
  1292.          FBuffersUsed := i;
  1294.          { start the buffers playing (unpause) }
  1295.          if not (wosPause in FState) then
  1296.          begin
  1297.             FError := WaveOutRestart(FHWaveOut);
  1298.             if FError <> 0 then
  1299.                Error('WaveOutRestart:'#10#13+WaveOutErrorString(FError));
  1300.          end;
  1302.          if FBuffersUsed = 0 then Stop;
  1304.       except
  1305.         if assigned(FOnError) then FOnError(Self);
  1306.         Close;
  1307.         raise;
  1308.       end;
  1309.    end;
  1310. end;
  1312. {-- TMMWaveOut ------------------------------------------------------------}
  1313. Procedure TMMWaveOut.Start;
  1314. Var
  1315.    oldCursor: TCursor;
  1316.    i: integer;
  1318. begin
  1319.    try
  1320.       if not (wosOpen in FState) then Open;
  1322.       if (wosOpen in FState) and not (wosPlay in FState) then
  1323.       begin
  1324.          { setup for playing }
  1326.          { reset the total bytes played counter }
  1327.          FBytesPlayed := 0;
  1328.          FOldPosition := 0;
  1329.          FLastPosition := 0;
  1330.          FWrapArrounds := 0;
  1331.          FWrapSize := 0;
  1332.          FLoopPos := 0;
  1333.          FLoopTempCount := FLoopCount;
  1334.          FInHandler := 0;
  1335.          FStarted := False;
  1336.          FStopIt := False;
  1337.          FReseting := False;
  1338.          FStopping := False;
  1339.          FPosted := False;
  1340.          FBufferOutIdx := 0;
  1341.          FBufferCounter := 0;
  1343.          { change the cursor to HourGlass }
  1344.          oldCursor := Screen.Cursor;
  1345.          if FShowHourGlass and (BufferSize * NumBuffers > 100000) then
  1346.             Screen.Cursor := crHourGlass;
  1347.          try
  1348.             {$IFDEF _MMDEBUG}
  1349.             DebugStr(0,'Try to start device...');
  1350.             {$ENDIF}
  1352.             { pause the output so the buffers won't play until we tell it to }
  1353.             FError := WaveOutPause(FHWaveOut);
  1354.             if FError <> 0 then
  1355.                Error('WaveOutPause:'#10#13+WaveOutErrorString(FError));
  1357.             { now notify all other components }
  1358.             inherited Started;
  1360.             FMoreBuffers := True;
  1362.             i := 0; { Load the number of buffers required }
  1363.             while (i < FNumBuffers) and FMoreBuffers do
  1364.             begin
  1365.                { create the waveOut header and buffer }
  1366.                AllocWaveHeader(FWaveOutHdrs[i]);
  1368.                {$IFDEF _NUMERATE}
  1369.                FWaveOutHdrs[i]^.dwUser := i;
  1370.                {$ENDIF}
  1372.                { prepare the waveform header for playing }
  1373.                PrepareWaveHeader(FWaveOutHdrs[i]);
  1375.                { fill the buffer and send to driver }
  1376.                if LoadWaveHeader(FWaveOutHdrs[i]) > 0 then
  1377.                   QueueWaveHeader(FWaveOutHdrs[i])
  1378.                else break;
  1379.                inc(i);
  1380.             end;
  1381.             FBuffersUsed := i;
  1383.             FState := FState + [wosPlay];
  1385.          finally
  1386.             Screen.Cursor := oldCursor;
  1387.          end;
  1389.          DoStarted;
  1390.       end;
  1392.    except
  1393.       if assigned(FOnError) then FOnError(Self);
  1394.       FState := FState + [wosPlay];
  1395.       Close;
  1396.       FState := [wosClose];
  1397.       raise;
  1398.    end;
  1399. end;
  1401. {-- TMMWaveOut ------------------------------------------------------------}
  1402. procedure TMMWaveOut.Pause;
  1403. begin
  1404.    try
  1405.       if not (wosOpen in FState) then Open;
  1407.       if (wosOpen in FState) and (not (wosPause in FState)) then
  1408.       begin
  1409.          if (wosPlay in FState) then
  1410.          try
  1411.             EnterCritical;
  1413.             {$IFDEF _MMDEBUG}
  1414.             DebugStr(0,'Try to pause device...');
  1415.             {$ENDIF}
  1417.             FError := WaveOutPause(FHWaveOut);
  1418.             if FError <> 0 then
  1419.                Error('WaveOutPause:'#10#13+WaveOutErrorString(FError));
  1421.             FState := FState + [wosPause];
  1423.             if FFullDuplex then
  1424.             begin
  1425.                inc(FOldPosition, GetSamplePosition);
  1427.                FReseting := True;
  1428.                FError := WaveOutReset(FHWaveOut);
  1429.                if FError > 0 then
  1430.                   Error('WaveOutReset:'#10#13+WaveOutErrorString(FError));
  1432.                FBufferOutIdx := 0;
  1433.                FBufferCounter := 0;
  1434.             end;
  1436.          finally
  1437.             LeaveCritical;
  1438.          end;
  1440.          DoPaused;
  1441.       end;
  1443.    except
  1444.       if assigned(FOnError) then FOnError(Self);
  1445.       Close;
  1446.       raise;
  1447.    end;
  1448. end;
  1450. {-- TMMWaveOut ------------------------------------------------------------}
  1451. procedure TMMWaveOut.Restart;
  1452. begin
  1453.    try
  1454.       if (wosPlay in FState) and (wosPause in FState) then
  1455.       begin
  1456.          FReseting := False;
  1458.          {$IFDEF _MMDEBUG}
  1459.          DebugStr(0,'Try to restart device...');
  1460.          {$ENDIF}
  1462.          inherited Restarted;
  1464.          FError := WaveOutRestart(FHWaveOut);
  1465.          if FError <> 0 then
  1466.             Error('WaveOutRestart:'#10#13+WaveOutErrorString(FError));
  1468.          DoRestarted;
  1469.       end;
  1471.    except
  1472.       if assigned(FOnError) then FOnError(Self);
  1473.       Close;
  1474.       raise;
  1475.    end;
  1476. end;
  1478. {-- TMMWaveOut ------------------------------------------------------------}
  1479. procedure TMMWaveOut.Stop;
  1480. begin
  1481.    if (wosPlay in FState) or (wosPause in FState) then
  1482.    begin
  1483.       try
  1484.          EnterCritical;
  1485.          try
  1486.             FStopping := True;
  1487.             FReseting := True;
  1489.             {$IFDEF _MMDEBUG}
  1490.             if (FInHandler > 0) then
  1491.                DebugStr(0,'Try to stop device (while in Handler)...')
  1492.             else
  1493.                DebugStr(0,'Try to stop device...');
  1494.             {$ENDIF}
  1496.          finally
  1497.             LeaveCritical;
  1498.          end;
  1500.          { save the stop position }
  1501.          FEndingPosition := Position;
  1502.          FWrapArrounds   := 0;
  1503.          FWrapSize       := 0;
  1505.          FError := WaveOutReset(FHWaveOut);
  1506.          if FError > 0 then
  1507.             Error('WaveOutReset:'#10#13+WaveOutErrorString(FError));
  1509.          DoStopped;
  1511.       except
  1512.         if assigned(FOnError) then FOnError(Self);
  1513.         Close;
  1514.         raise;
  1515.       end;
  1516.    end;
  1517. end;
  1519. {-- TMMWaveOut -----------------------------------------------------------}
  1520. procedure TMMWaveOut.Opened;
  1521. begin
  1522.    Open;
  1523. end;
  1525. {-- TMMWaveOut -----------------------------------------------------------}
  1526. procedure TMMWaveOut.Closed;
  1527. begin
  1528.    Close;
  1529. end;
  1531. {-- TMMWaveOut -----------------------------------------------------------}
  1532. procedure TMMWaveOut.Started;
  1533. begin
  1534.    Start;
  1535. end;
  1537. {-- TMMWaveOut -----------------------------------------------------------}
  1538. procedure TMMWaveOut.Paused;
  1539. begin
  1540.    Pause;
  1541. end;
  1543. {-- TMMWaveOut -----------------------------------------------------------}
  1544. procedure TMMWaveOut.Restarted;
  1545. begin
  1546.    Restart;
  1547. end;
  1549. {-- TMMWaveOut -----------------------------------------------------------}
  1550. procedure TMMWaveOut.Stopped;
  1551. begin
  1552.    Stop;
  1553. end;
  1555. {-- TMMWaveOut -----------------------------------------------------------}
  1556. procedure TMMWaveOut.DoOpened;
  1557. begin
  1558.    {$IFDEF _MMDEBUG}
  1559.    DebugStr(0,'Device is now open...');
  1560.    {$ENDIF}
  1562.    if Assigned(FOnOpen) then FOnOpen(Self);
  1563. end;
  1565. {-- TMMWaveOut -----------------------------------------------------------}
  1566. procedure TMMWaveOut.DoClosed;
  1567. begin
  1568.    FHWaveOut := 0;
  1570.    {$IFDEF _MMDEBUG}
  1571.    DebugStr(0,'Device is now closed...');
  1572.    {$ENDIF}
  1574.    FClosing := False;
  1576.    if not (csDestroying in ComponentState) then
  1577.       if Assigned(FOnClose) then FOnClose(Self);
  1578. end;
  1580. {-- TMMWaveOut -----------------------------------------------------------}
  1581. procedure TMMWaveOut.DoStarted;
  1582. begin
  1583.    if (FBuffersUsed > 0) then
  1584.    begin
  1585.       if not (wosPause in FState) then
  1586.       begin
  1587.          { start the buffers playing (unpause) }
  1588.          FError := WaveOutRestart(FHWaveOut);
  1589.          if FError <> 0 then
  1590.             Error('WaveOutRestart:'#10#13+WaveOutErrorString(FError));
  1591.       end;
  1593.       {$IFDEF _MMDEBUG}
  1594.       DebugStr(0,'Device is now started...');
  1595.       {$ENDIF}
  1597.       InitDSPMeter;
  1599.       if assigned(FOnStart) then FOnStart(Self);
  1600.    end
  1601.    else
  1602.    try
  1603.       inherited Stopped;
  1604.       Error('WaveOutStart:'#10#13+LoadResStr(IDS_STARTERROR));
  1605.    finally
  1606.       Close;
  1607.    end;
  1608. end;
  1610. {-- TMMWaveOut -----------------------------------------------------------}
  1611. procedure TMMWaveOut.DoPaused;
  1612. begin
  1613.    FState := FState + [wosPause];
  1615.    inherited Paused;
  1617.    {$IFDEF _MMDEBUG}
  1618.    DebugStr(0,'Device is now paused...');
  1619.    {$ENDIF}
  1621.    if assigned(FOnPause) then FOnPause(Self);
  1622. end;
  1624. {-- TMMWaveOut -----------------------------------------------------------}
  1625. procedure TMMWaveOut.DoRestarted;
  1626. begin
  1627.    FState := FState - [wosPause];
  1629.    {$IFDEF _MMDEBUG}
  1630.    DebugStr(0,'Device is now restarted...');
  1631.    {$ENDIF}
  1633.    if assigned(FOnRestart) then FOnRestart(Self);
  1634. end;
  1636. {-- TMMWaveOut -----------------------------------------------------------}
  1637. procedure TMMWaveOut.DoStopped;
  1638. var
  1639.    TimeOut: integer;
  1641. begin
  1642.    if (wosPlay in FState) or (wosPause in FState) then
  1643.    begin
  1644.       if (FInHandler > 0) then FStopIt := True
  1645.       else
  1646.       begin
  1647.          FState := FState - [wosPlay,wosPause];
  1649.          DoneDSPMeter;
  1651.          TimeOut := 500;
  1652.          { wait until all buffers returned }
  1653.          repeat
  1654.              {$IFDEF _USE_CALLBACK}
  1655.              if _Win9x_ or _WinNT4_ then
  1656.                 Delay(10,False)
  1657.              else
  1658.              {$ENDIF}
  1659.                 Delay(10,True);
  1660.             dec(TimeOut);
  1661.          until (FBufferCounter = 0) or (TimeOut <= 0);
  1663.          {$IFDEF _MMDEBUG}
  1664.          if (FBufferCounter > 0) then
  1665.              DebugStr(0,'TimeOut while waiting for returned headers!');
  1666.          {$ENDIF}
  1668.          { notify all other components }
  1669.          inherited Stopped;
  1671.          { unprepare wave headers }
  1672.          UnPrepareWaveHeaders;
  1674.          { free header memory and remove }
  1675.          FreeWaveHeaders;
  1677.          FBuffersUsed := 0;
  1678.          FBufferCounter := 0;
  1679.          FBufferOutIdx := 0;
  1681.          FStopIt := False;
  1683.          {$IFDEF _MMDEBUG}
  1684.          DebugStr(0,'Device is now stopped...');
  1685.          {$ENDIF}
  1687.          if not (csDestroying in ComponentState) then
  1688.             if assigned(FOnStop) then FOnStop(Self);
  1690.          if FCloseIt then Close;
  1691.       end;
  1692.    end;
  1693. end;
  1695. {-- TMMWaveOut -----------------------------------------------------------}
  1696. procedure TMMWaveOut.DoBufferFilled(lpwh: PWaveHdr);
  1697. begin
  1698.    if assigned(FOnBufferFilled) then FOnBufferFilled(Self, lpwh);
  1699. end;
  1701. {-- TMMWaveOut -----------------------------------------------------------}
  1702. procedure TMMWaveOut.BufferLoad(lpwh: PWaveHdr; var MoreBuffers: Boolean);
  1703. begin
  1704.    StartDSPMeter;
  1705.    try
  1706.       with PMMWaveHdr(lpwh)^ do
  1707.       begin
  1708.          wh.dwBufferLength := BufferSize;
  1709.          wh.dwBytesRecorded := 0;
  1710.          LoopRec.dwLoop := FLooping;
  1711.          if FLooping then
  1712.          begin
  1713.             LoopRec.dwLoopCnt    := FLoopCount;
  1714.             LoopRec.dwLoopTmpCnt := FLoopTempCount;
  1715.             LoopRec.dwLooping    := False;
  1716.          end;
  1718.          inherited BufferLoad(lpwh, MoreBuffers);
  1720.          wh.dwBufferLength := wh.dwBytesRecorded;
  1722.          if FLooping then FLoopTempCount := LoopRec.dwLoopTmpCnt;
  1723.       end;
  1725.    finally
  1726.       StopDSPMeter;
  1727.    end;
  1728. end;
  1730. {-- TMMWaveOut -----------------------------------------------------------}
  1731. procedure TMMWaveOut.BufferReady(lpwh: PWaveHdr);
  1732. begin
  1733. end;
  1735. {-- TMMWaveOut -----------------------------------------------------------}
  1736. procedure TMMWaveOut.DoBufferReady(lpwh: PWaveHdr);
  1737. begin
  1738.    { buffer has returned from driver, notify the other components }
  1739.    StartDSPMeter;
  1740.    try
  1741.       inc(FBufferOutIdx);
  1742.       if FBufferOutIdx >= FBuffersUsed then FBufferOutIdx := 0;
  1744.       { BUG-FIX for NT 4.0 SP4, it does set dwBytesRecorded to zero }
  1745.       lpwh^.dwBytesRecorded := PMMWaveHdr(lpwh)^.dwUser2;
  1747.       { we use a trick here and point to the current header which is playing }
  1748.       PMMWaveHdr(lpwh)^.lpNext := FWaveOutHdrs[FBufferOutIdx];
  1750.       { BUG-FIX for NT 4.0 SP4, it does set dwBytesRecorded to zero }
  1751.       PMMWaveHdr(PMMWaveHdr(lpwh)^.lpNext)^.wh.dwBytesRecorded := PMMWaveHdr(PMMWaveHdr(lpwh)^.lpNext)^.dwUser2;
  1753.       inherited BufferReady(lpwh);
  1755.    finally
  1756.       StopDSPMeter;
  1757.    end;
  1758. end;
  1760. {-- TMMWaveOut -----------------------------------------------------------}
  1761. procedure TMMWaveOut.ProcessWaveHeader(lpWaveHdr: PWaveHdr);
  1762. var
  1763.    CurPos,LastPos: Cardinal;
  1764.    Wrapped: integer;
  1765.    TimeOut: Longint;
  1766. begin
  1767.    if (wosPlay in FState) and not FReseting and not FStopping then
  1768.    begin
  1769.       inc(FInHandler);
  1770.       try
  1771.          { some drivers, for example the SB return the buffers }
  1772.          { in bad order, so wee can try to fix this            }
  1773.          if FIX_BUFFERS then
  1774.             lpWaveHdr := FWaveOutHdrs[FBufferOutIdx]
  1775.          else
  1776.             WaveOutUnPrepareHeader(FHWaveOut, lpWaveHdr, sizeOf(TWaveHdr));
  1778.          {$IFDEF _MMDEBUG}
  1779.          DebugStr(2,'Buffer '+IntToStr(lpWaveHdr^.dwUser)+' returned');
  1780.          {$ENDIF}
  1782.          EnterCritical;
  1783.          FBytesPlayed := FBytesPlayed + lpWaveHdr^.dwBufferLength;
  1784.          LeaveCritical;
  1786.          try
  1787.             DoBufferReady(lpWaveHdr);
  1789.             {$IFDEF _MMDEBUG}
  1790.             DebugStr(2,'Buffer '+IntToStr(lpWaveHdr^.dwUser)+' ready for loading');
  1791.             {$ENDIF}
  1793.             {$IFDEF WIN32}
  1794.             { wrap arround handling }
  1795.             CurPos := GetSamplePosition;
  1796.             LastPos:= FLastPosition;
  1797.             asm
  1798.                mov  Wrapped, False
  1799.                mov  eax, CurPos
  1800.                cmp  eax, LastPos
  1801.                jnb  @@exit
  1803.                mov  eax, LastPos
  1804.                sub  eax, CurPos
  1805.                cmp  eax, $FFFF
  1806.                jb   @@exit
  1808.                mov  Wrapped, True
  1809.             @@exit:
  1810.             end;
  1812.             if (Wrapped = 1) then
  1813.             begin
  1814.                { every driver wraps at a different position           }
  1815.                { here we try to detect where the position has wrapped }
  1816.                { hey, this looks realy cool                           }
  1817.                FWrapSize := (FLastPosition and $FFF00000) or $FFFFF;
  1818.                inc(FWrapArrounds);
  1819.             end;
  1821.             {$IFDEF _MMDEBUG}
  1822.             if Wrapped <> 0 then
  1823.             begin
  1824.                DB_WriteStr(0,'Wrapped, LastPos: '+IntToStr(FLastPosition)+' (');
  1825.                DB_WriteHex(0,FLastPosition);
  1826.                DB_WriteStr(0,'), CurPos: '+IntToStr(CurPos)+' (');
  1827.                DB_WriteHex(0,CurPos);
  1828.                DB_WriteStr(0,'), WrapSize: '+IntToStr(FWrapSize)+' (');
  1829.                DB_WriteHex(0,FWrapSize);
  1830.                DB_WriteStr(0,'), Position: '+TimeToString64Ex(Position,True));
  1831.                DB_WriteStrLn(0,')');
  1832.             end;
  1833.             {$ENDIF}
  1835.             FLastPosition := CurPos;
  1836.             {$ENDIF}
  1838.             if FMoreBuffers and not FStopIt then
  1839.             begin
  1840.                { file restarted ? }
  1841.                if FLooping and PMMWaveHdr(lpWaveHdr)^.LoopRec.dwLooping then
  1842.                begin
  1843.                   EnterCritical;
  1844.                   { adjust GetPosition }
  1845.                   FLoopPos := CurPos;
  1846.                   PMMWaveHdr(lpWaveHdr)^.LoopRec.dwLooping := False;
  1847.                   LeaveCritical;
  1848.                   
  1849.                   { notify other components that we have looped }
  1850.                   Looped;
  1851.                   if assigned(FOnLooping) then FOnLooping(Self);
  1852.                end;
  1854.                { wait until the buffer is marked as done, or we get trouble ! }
  1855.                TimeOut := 65000;
  1856.                { wait until the buffer is marked as done }
  1857.                while (lpWaveHdr^.dwFlags and WHDR_DONE <> WHDR_DONE) and (TimeOut > 0) do
  1858.                begin
  1859.                   dec(TimeOut);
  1860.                   {$IFDEF WIN32}
  1861.                   Sleep(2);
  1862.                   {$ENDIF}
  1863.                end;
  1865.                { load the next buffer }
  1866.                if (LoadWaveHeader(lpWaveHdr) <= 0) and not FStopIt then
  1867.                    Error(LoadResStr(IDS_FILLERROR));
  1869.                { send the next buffer to the driver }
  1870.                if not FStopIt then QueueWaveHeader(lpWaveHdr);
  1871.             end;
  1873.          except
  1874.             if assigned(FOnError) then FOnError(Self);
  1875.             raise;
  1876.          end;
  1878.       finally
  1879.          dec(FInHandler);
  1880.          { can we stop it ? }
  1881.          if (FInHandler = 0) then  { no more buffers, stop }
  1882.              if (FStopIt or (FBufferCounter = 0)) and not FPosted then
  1883.              begin
  1884.                 FPosted := True;
  1885.                 FStopping := True;
  1886.                 {$IFDEF _MMDEBUG}
  1887.                 DebugStr(0,'Stop Message posted...');
  1888.                 {$ENDIF}
  1890.                 { pause the device first so it stops playing }
  1891.                 { some cards play the last buffer looped ! }
  1892.                 FError := WaveOutPause(FHWaveOut);
  1893.                 if FError <> 0 then
  1894.                    Error('WaveOutPause:'#10#13+WaveOutErrorString(FError));
  1896.                 PostMessage(FHandle,MM_WOM_STOP,FHWaveOut,0);
  1897.              end;
  1898.       end;
  1899.    end;
  1900. end;
  1902. {-- TMMWaveOut -----------------------------------------------------------}
  1903. procedure TMMWaveOut.WaveOutHandler(Var Msg: TMessage);
  1904. begin
  1905.   with Msg do
  1906.   try
  1907.       if (wParam = FHWaveOut) then
  1908.       case msg of
  1909.         MM_WOM_OPEN :
  1910.         begin
  1911.            { device is now open }
  1912.            FState := [wosOpen];
  1913.         end;
  1914.         MM_WOM_CLOSE:
  1915.         begin
  1916.            { device is now closed }
  1917.            FState := [wosClose];
  1918.         end;
  1919.         MM_WOM_DONE : begin
  1920.                          {$IFDEF _USE_CALLBACK}
  1921.                          if not _Win9x_ and not _WinNT4_ then
  1922.                          {$ENDIF}
  1923.                          begin
  1924.                             dec(FBufferCounter);
  1925.                             if FReseting then
  1926.                             begin
  1927.                                if FBufferCounter = 0 then FReseting := False;
  1928.                                exit;
  1929.                             end;
  1930.                          end;
  1931.                          if not FStopping then ProcessWaveHeader(PWaveHdr(lparam));
  1932.                          exit;
  1933.                       end;
  1934.          MM_WOM_STOP: begin
  1935.                          {$IFDEF _MMDEBUG}
  1936.                          DebugStr(0,'Stop message received...');
  1937.                          {$ENDIF}
  1939.                          { should stop the device }
  1940.                          Stop;
  1941.                          exit;
  1942.                       end;
  1943.       end;
  1944.       Result := DefWindowProc(FHandle, Msg, wParam, lParam);
  1946.   except
  1947.      if assigned(FOnError) then FOnError(Self);
  1948.      Close;
  1949.      Application.HandleException(Self);
  1950.   end;
  1951. end;
  1953. {-- WaveOutFunc ----------------------------------------------------------}
  1954. procedure WaveOutFunc(hWaveOut:HWaveOut;wMsg:UINT;dwInstance,dwParam1,dwParam2:Longint);
  1955. begin
  1956.    if (dwInstance <> 0) then
  1957.    with TMMWaveOut(dwInstance) do
  1958.    {$IFDEF WIN32}
  1959.    try
  1960.    {$ELSE}
  1961.    begin
  1962.    {$ENDIF}
  1963.       case wMsg of
  1964.          WOM_OPEN :
  1965.          begin
  1966.             { device is now open }
  1967.             FState := [wosOpen];
  1968.          end;
  1969.          WOM_CLOSE:
  1970.          begin
  1971.             { device is now closed }
  1972.             FState := [wosClose];
  1973.          end;
  1974.          WOM_DONE :
  1975.          begin
  1976.             { device has returnded a buffer }
  1977.             dec(FBufferCounter);
  1978.             if FReseting then
  1979.             begin
  1980.                if FBufferCounter = 0 then FReseting := False;
  1981.             end
  1982.             else
  1983.             begin
  1984.                if not FStopping then
  1985.                case FCallBackMode of
  1986.                     cmWindow: PostMessage(FHandle,MM_WOM_DONE,hWaveOut,dwParam1);
  1987.                     {$IFDEF WIN32}
  1988.                     cmCallBack: ProcessWaveHeader(PWaveHdr(dwparam1));
  1989.                     cmThread: PostThreadMessage(FOutThread.ThreadID,MM_WOM_DONE,hWaveOut,dwParam1);
  1990.                     {$ENDIF}
  1991.                end;
  1992.             end;
  1993.          end;
  1994.       end;
  1995.    {$IFDEF WIN32}
  1996.    except
  1997.       Close;
  1998.       Application.HandleException(TMMWaveOut(dwInstance));
  1999.    {$ENDIF}
  2000.    end;
  2001. end;
  2003. {$IFDEF WIN32}
  2004. {-------------------------------------------------------------------------}
  2005. procedure TMMWaveOutThread.Execute;
  2006. {- Wait for and process output messages }
  2007. var
  2008.    Res  : DWORD;
  2009.    Msg  : TMsg;
  2010.    {$IFDEF _MMDEBUG}
  2011.    Err  : DWORD;
  2012.    {$ENDIF}
  2013.    Handles: array[0..1] of THandle;
  2015. begin
  2016.    with TMMWaveOut(Owner) do
  2017.    try
  2018.       {$IFDEF _MMDEBUG}
  2019.       DebugStr(0,'Setting Thread Priority');
  2020.       {$ENDIF}
  2022.       SetPriority(FPriority);
  2024.       Handles[0] := FCloseEvent;
  2025.       Handles[1] := FResetEvent;
  2027.       { make sure we have a message queue... }
  2028.       PeekMessage(Msg, 0, 0, 0, PM_NOREMOVE);
  2030.       {$IFDEF _MMDEBUG}
  2031.       DebugStr(0,'Setting OutEvent,ready to go !');
  2032.       {$ENDIF}
  2034.       { Ready to go, set the output event }
  2035.       SetEvent(FOutEvent);
  2037.       { Repeat until device is closed }
  2038.       while not Terminated do
  2039.       try
  2040.          if not PeekMessage(Msg, 0, 0, 0, PM_REMOVE) then
  2041.          begin
  2042.             Res := MsgWaitForMultipleObjects(2, Handles, False, INFINITE, QS_ALLEVENTS);
  2043.             case Res of
  2044.                 WAIT_FAILED:       { Wait failed.  Shouldn't happen. }
  2045.                 begin
  2046.                    {$IFDEF _MMDEBUG}
  2047.                    Err := GetLastError;
  2048.                    DebugStr(0,'Wait Failed... Error: '+SysErrorMessage(Err));
  2049.                    {$ENDIF}
  2051.                    Continue;
  2052.                 end;
  2053.                 WAIT_OBJECT_0:     { CloseEvent signaled!            }
  2054.                 begin
  2055.                    {$IFDEF _MMDEBUG}
  2056.                    DebugStr(0,'CloseEvent signaled...');
  2057.                    {$ENDIF}
  2059.                    { Finished here, okay to close device }
  2060.                    exit;
  2061.                 end;
  2062.                 WAIT_OBJECT_0+1:   { ResetEvent signaled!            }
  2063.                 begin
  2064.                    {$IFDEF _MMDEBUG}
  2065.                    DebugStr(0,'ResetEvent signaled...');
  2066.                    {$ENDIF}
  2068.                    { remove all pending Messages from the queue }
  2069.                    while PeekMessage(Msg, 0, MM_WOM_DONE, MM_WOM_DONE, PM_REMOVE) do;
  2070.                    ResetEvent(FResetEvent);
  2072.                    Continue;
  2073.                 end;
  2074.                 WAIT_OBJECT_0+2:    { New message was received.      }
  2075.                 begin
  2076.                    {$IFDEF _MMDEBUG}
  2077.                    DebugStr(2,'WaveOut message reveived...');
  2078.                    {$ENDIF}
  2080.                    { Get the message that woke us up by looping again.}
  2081.                    Continue;
  2082.                 end;
  2083.             end;
  2084.          end;
  2086.          { Process the message. }
  2087.          with msg do
  2088.          begin
  2089.             if (wParam = FHWaveOut) and (message = MM_WOM_DONE) then
  2090.             begin
  2091.                if not FStopping then ProcessWaveHeader(PWaveHdr(lparam));
  2092.             end
  2093.             else
  2094.             begin
  2095.                {$IFDEF _MMDEBUG}
  2096.                DebugStr(0,'Unknown message received...');
  2097.                {$ENDIF}
  2099.                TranslateMessage(Msg);
  2100.                DispatchMessage(msg);
  2101.             end;
  2102.          end;
  2104.       except
  2105.          FThreadError := True;
  2106.          if (FHWaveOut <> 0) then
  2107.          begin
  2108.             FClosing := True;
  2109.             Stop;
  2110.             WaveOutClose(FHWaveOut);
  2111.             DoClosed;
  2112.             CloseEvents;
  2113.          end;
  2114.          Application.HandleException(nil);
  2115.          exit;
  2116.       end;
  2118.    finally
  2119.      {$IFDEF _MMDEBUG}
  2120.      DebugStr(0,'Exit Thread-Proc');
  2121.      {$ENDIF}
  2123.      if not FThreadError then SetEvent(FOutEvent);
  2124.    end;
  2125. end;
  2126. {$ENDIF}
  2128. initialization
  2129. {$IFDEF _MMDEBUG}
  2130.    DB_Level(DEBUGLEVEl);
  2131.    DB_Clear;
  2132. {$ENDIF}
  2133. end.