home *** CD-ROM | disk | FTP | other *** search
/ io Programmo 23 / IOPROG_23.ISO / SOFT / DELPHIX.ZIP / Source / DXSounds.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1998-10-06  |  62.9 KB  |  2,536 lines
  1. unit DXSounds;
  2.  
  3. interface
  4.  
  5. {$INCLUDE DelphiXcfg.inc}
  6.  
  7. uses
  8.   Windows, Messages, SysUtils, Classes, Controls, Forms, ExtCtrls, MMSystem,
  9.   DirectX, DXClass, Wave;
  10.  
  11. type
  12.  
  13.   {  EDirectSoundError  }
  14.  
  15.   EDirectSoundError = class(EDirectXError);
  16.   EDirectSoundBufferError = class(EDirectSoundError);
  17.  
  18.   {  TDirectSound  }
  19.  
  20.   TDirectSoundBuffer = class;
  21.  
  22.   TDirectSound = class(TDirectX)
  23.   private
  24.     FBufferList: TList;
  25.     FGlobalFocus: Boolean;
  26.     FIDSound: IDirectSound;
  27.     FInRestoreBuffer: Boolean;
  28.     FStickyFocus: Boolean;
  29.     function GetBuffer(Index: Integer): TDirectSoundBuffer;
  30.     function GetBufferCount: Integer;
  31.     function GetIDSound: IDirectSound;
  32.     function GetISound: IDirectSound;
  33.   protected
  34.     procedure CheckBuffer(Buffer: TDirectSoundBuffer);
  35.     procedure DoRestoreBuffer; virtual;
  36.   public
  37.     constructor Create(GUID: PGUID);
  38.     constructor CreateFromInterface(DSound: IDirectSound);
  39.     destructor Destroy; override;
  40.     class function Drivers: TDirectXDrivers;
  41.     property BufferCount: Integer read GetBufferCount;
  42.     property Buffers[Index: Integer]: TDirectSoundBuffer read GetBuffer;
  43.     property GlobalFocus: Boolean read FGlobalFocus write FGlobalFocus;
  44.     property IDSound: IDirectSound read GetIDSound;
  45.     property ISound: IDirectSound read GetISound;
  46.     property StickyFocus: Boolean read FStickyFocus write FStickyFocus;
  47.   end;
  48.  
  49.   {  TDirectSoundBuffer  }
  50.  
  51.   TDirectSoundBuffer = class(TDirectX)
  52.   private
  53.     FDSound: TDirectSound;
  54.     FIDSBuffer: IDirectSoundBuffer;
  55.     function GetBitCount: Longint;
  56.     function GetFrequency: Integer;
  57.     function GetIDSBuffer: IDirectSoundBuffer;
  58.     function GetIBuffer: IDirectSoundBuffer;
  59.     function GetPlaying: Boolean;
  60.     function GetPan: Integer;
  61.     function GetPosition: Longint;
  62.     function GetStatus: Integer;
  63.     function GetVolume: Integer;
  64.     procedure SetFrequency(Value: Integer);
  65.     procedure SetIDSBuffer(Value: IDirectSoundBuffer);
  66.     procedure SetPan(Value: Integer);
  67.     procedure SetPosition(Value: Longint);
  68.     procedure SetVolume(Value: Integer);
  69.   protected
  70.     procedure Check; override;
  71.   public
  72.     constructor Create(ADSound: TDirectSound);
  73.     destructor Destroy; override;
  74.     procedure Assign(Source: TPersistent); override;
  75.     function CreateBuffer(const BufferDesc: DSBUFFERDESC): Boolean;
  76.     function GetFormat(var Format: TWaveFormatEx;
  77.       dwSizeAllocated: Longint; var dwSizeWritten: Longint): Boolean;
  78.     function GetFormatAlloc(var Format: PWaveFormatEx; var Size: Longint): Boolean;
  79.     function Lock(dwWriteCursor, dwWriteBytes: Longint;
  80.       var lpvAudioPtr1: Pointer; var dwAudioBytes1: Longint;
  81.       var lpvAudioPtr2: Pointer; var dwAudioBytes2: Longint;
  82.       dwFlags: Longint): Boolean;
  83.     procedure LoadFromFile(const FileName: string);
  84.     procedure LoadFromMemory(const Format: TWaveFormatEx;
  85.       Data: Pointer; Size: Integer);
  86.     procedure LoadFromStream(Stream: TStream);
  87.     procedure LoadFromWave(Wave: TWave);
  88.     function Play(Flags: Longint{$IFNDEF VER100}=0{$ENDIF}): Boolean;
  89.     function Restore: Boolean;  
  90.     function SetFormat(const Format: TWaveFormatEx): Boolean;
  91.     procedure SetSize(const Format: TWaveFormatEx; Size: Integer);
  92.     function Stop: Boolean;
  93.     function Unlock(lpvAudioPtr1: Pointer; dwAudioBytes1: Longint;
  94.       lpvAudioPtr2: Pointer; dwAudioBytes2: Longint): Boolean;
  95.     property BitCount: Longint read GetBitCount;
  96.     property DSound: TDirectSound read FDSound;
  97.     property Frequency: Integer read GetFrequency write SetFrequency;
  98.     property IBuffer: IDirectSoundBuffer read GetIBuffer;
  99.     property IDSBuffer: IDirectSoundBuffer read GetIDSBuffer write SetIDSBuffer;
  100.     property Playing: Boolean read GetPlaying;
  101.     property Pan: Integer read GetPan write SetPan;
  102.     property Position: Longint read GetPosition write SetPosition;
  103.     property Status: Integer read GetStatus;
  104.     property Volume: Integer read GetVolume write SetVolume;
  105.   end;
  106.  
  107.   {  EAudioStreamError  }
  108.  
  109.   EAudioStreamError = class(Exception);
  110.  
  111.   {  TAudioStream  }
  112.  
  113.   TAudioStream = class
  114.   private
  115.     FAutoUpdate: Boolean;
  116.     FBuffer: TDirectSoundBuffer;
  117.     FBufferLength: Integer;
  118.     FBufferPos: DWORD;
  119.     FPlayBufferPos: DWORD;
  120.     FBufferSize: DWORD;
  121.     FDSound: TDirectSound;
  122.     FLooped: Boolean;
  123.     FPlayedSize: Integer;
  124.     FPlaying: Boolean;
  125.     FPosition: Integer;
  126.     FWaveStream: TCustomWaveStream;
  127.     FWritePosition: Integer;
  128.     FNotifyEvent: THandle;
  129.     FNotifyThread: TThread;
  130.     FInThread: Boolean;
  131.     function GetFormat: PWaveFormatEX;
  132.     function GetFormatSize: Integer;
  133.     function GetFrequency: Integer;
  134.     function GetPan: Integer;
  135.     function GetPlayedSize: Integer;
  136.     function GetSize: Integer;
  137.     function GetVolume: Integer;
  138.     function GetWriteSize: Integer;
  139.     procedure SetAutoUpdate(Value: Boolean);
  140.     procedure SetBufferLength(Value: Integer);
  141.     procedure SetFrequency(Value: Integer);
  142.     procedure SetLooped(Value: Boolean);
  143.     procedure SetPan(Value: Integer);
  144.     procedure SetPlayedSize(Value: Integer);
  145.     procedure SetPosition(Value: Integer);
  146.     procedure SetVolume(Value: Integer);
  147.     procedure SetWaveStream(Value: TCustomWaveStream);
  148.     procedure UpdatePlayedSize;
  149.     function WriteWave(WriteSize: Integer): Integer;
  150.   public
  151.     constructor Create(ADSound: TDirectSound);
  152.     destructor Destroy; override;
  153.     procedure Play;
  154.     procedure RecreateBuf;
  155.     procedure Stop;
  156.     procedure Update;
  157.     property AutoUpdate: Boolean read FAutoUpdate write SetAutoUpdate;
  158.     property BufferLength: Integer read FBufferLength write SetBufferLength;
  159.     property Format: PWaveFormatEx read GetFormat;
  160.     property FormatSize: Integer read GetFormatSize;
  161.     property Frequency: Integer read GetFrequency write SetFrequency;
  162.     property Pan: Integer read GetPan write SetPan;
  163.     property PlayedSize: Integer read GetPlayedSize write SetPlayedSize;
  164.     property Playing: Boolean read FPlaying;
  165.     property Position: Integer read FPosition write SetPosition;
  166.     property Looped: Boolean read FLooped write SetLooped;
  167.     property Size: Integer read GetSize;
  168.     property Volume: Integer read GetVolume write SetVolume;
  169.     property WaveStream: TCustomWaveStream read FWaveStream write SetWaveStream;
  170.   end;
  171.    
  172.   {  TAudioFileStream  }
  173.  
  174.   TAudioFileStream = class(TAudioStream)
  175.   private
  176.     FFileName: string;
  177.     FWaveFileStream: TWaveFileStream;
  178.     procedure SetFileName(const Value: string);
  179.   public
  180.     destructor Destroy; override;
  181.     property FileName: string read FFileName write SetFileName;
  182.   end;
  183.  
  184.   {  TSoundCaptureFormat  }
  185.  
  186.   TSoundCaptureFormat = class(TCollectionItem)
  187.   private
  188.     FBitsPerSample: Integer;
  189.     FChannels: Integer;
  190.     FSamplesPerSec: Integer;
  191.   public
  192.     property BitsPerSample: Integer read FBitsPerSample;
  193.     property Channels: Integer read FChannels;
  194.     property SamplesPerSec: Integer read FSamplesPerSec;
  195.   end;
  196.  
  197.   {  TSoundCaptureFormats  }
  198.  
  199.   TSoundCaptureFormats = class(TCollection)
  200.   private
  201.     function GetItem(Index: Integer): TSoundCaptureFormat;
  202.   public
  203.     constructor Create;
  204.     function IndexOf(ASamplesPerSec, ABitsPerSample, AChannels: Integer): Integer;
  205.     property Items[Index: Integer]: TSoundCaptureFormat read GetItem; default;
  206.   end;
  207.  
  208.   {  TSoundCaptureStream  }
  209.  
  210.   ESoundCaptureStreamError = class(EWaveStreamError);
  211.  
  212.   TSoundCaptureStream = class(TCustomWaveStream2)
  213.   private
  214.     FBuffer: IDirectSoundCaptureBuffer;
  215.     FBufferLength: Integer;
  216.     FBufferPos: DWORD;
  217.     FBufferSize: DWORD;
  218.     FCapture: IDirectSoundCapture;
  219.     FCaptureFormat: Integer;
  220.     FCapturing: Boolean;
  221.     FNotifyEvent: THandle;
  222.     FNotifyThread: TThread;
  223.     FOnFilledBuffer: TNotifyEvent;
  224.     FSupportedFormats: TSoundCaptureFormats;
  225.     function GetReadSize: Integer;
  226.     procedure SetBufferLength(Value: Integer);
  227.     procedure SetOnFilledBuffer(Value: TNotifyEvent);
  228.   protected
  229.     procedure DoFilledBuffer; virtual;
  230.     function GetFilledSize: Integer; override;
  231.     function ReadWave(var Buffer; Count: Integer): Integer; override;
  232.   public
  233.     constructor Create(GUID: PGUID);
  234.     destructor Destroy; override;
  235.     class function Drivers: TDirectXDrivers;
  236.     procedure Start;
  237.     procedure Stop;
  238.     property BufferLength: Integer read FBufferLength write SetBufferLength;
  239.     property CaptureFormat: Integer read FCaptureFormat write FCaptureFormat;
  240.     property Capturing: Boolean read FCapturing;
  241.     property OnFilledBuffer: TNotifyEvent read FOnFilledBuffer write SetOnFilledBuffer;
  242.     property SupportedFormats: TSoundCaptureFormats read FSupportedFormats;
  243.   end;
  244.  
  245.   {  TSoundEngine  }
  246.  
  247.   TSoundEngine = class
  248.   private
  249.     FDSound: TDirectSound;
  250.     FEffectList: TList;
  251.     FEnabled: Boolean;
  252.     FTimer: TTimer;
  253.     function GetEffect(Index: Integer): TDirectSoundBuffer;
  254.     function GetEffectCount: Integer;
  255.     procedure SetEnabled(Value: Boolean);
  256.     procedure TimerEvent(Sender: TObject);
  257.   public
  258.     constructor Create(ADSound: TDirectSound);
  259.     destructor Destroy; override;
  260.     procedure Clear;
  261.     procedure EffectFile(const Filename: string; Loop, Wait: Boolean);
  262.     procedure EffectStream(Stream: TStream; Loop, Wait: Boolean);
  263.     procedure EffectWave(Wave: TWave; Loop, Wait: Boolean);
  264.     property EffectCount: Integer read GetEffectCount;
  265.     property Effects[Index: Integer]: TDirectSoundBuffer read GetEffect;
  266.     property Enabled: Boolean read FEnabled write SetEnabled;
  267.   end;
  268.  
  269.   {  EDXSoundError  }
  270.  
  271.   EDXSoundError = class(Exception);
  272.  
  273.   {  TCustomDXSound  }
  274.  
  275.   TCustomDXSound = class;
  276.  
  277.   TDXSoundOption = (soGlobalFocus, soStickyFocus, soExclusive, soWritePrimary);
  278.   TDXSoundOptions = set of TDXSoundOption;
  279.  
  280.   TDXSoundNotifyType = (dsntDestroying, dsntInitializing, dsntInitialize, dsntFinalize, dsntRestore);
  281.   TDXSoundNotifyEvent = procedure(Sender: TCustomDXSound; NotifyType: TDXSoundNotifyType) of object;
  282.  
  283.   TCustomDXSound = class(TComponent)
  284.   private
  285.     FAutoInitialize: Boolean;
  286.     FCalledDoInitialize: Boolean;
  287.     FDriver: PGUID;
  288.     FDriverGUID: TGUID;
  289.     FDSound: TDirectSound;
  290.     FForm: TCustomForm;
  291.     FInitialized: Boolean;
  292.     FInternalInitialized: Boolean;
  293.     FNotifyEventList: TList;
  294.     FNowOptions: TDXSoundOptions;
  295.     FOnFinalize: TNotifyEvent;
  296.     FOnInitialize: TNotifyEvent;
  297.     FOnInitializing: TNotifyEvent;
  298.     FOnRestore: TNotifyEvent;
  299.     FOptions: TDXSoundOptions;
  300.     FPrimary: TDirectSoundBuffer;
  301.     FSubClass: TControlSubClass;
  302.     procedure FormWndProc(var Message: TMessage; DefWindowProc: TWndMethod);
  303.     procedure NotifyEventList(NotifyType: TDXSoundNotifyType);
  304.     procedure SetDriver(Value: PGUID);
  305.     procedure SetForm(Value: TCustomForm);
  306.     procedure SetOptions(Value: TDXSoundOptions);
  307.   protected
  308.     procedure DoFinalize; virtual;
  309.     procedure DoInitialize; virtual;
  310.     procedure DoInitializing; virtual;
  311.     procedure DoRestore; virtual;
  312.     procedure Loaded; override;
  313.   public
  314.     constructor Create(AOwner: TComponent); override;
  315.     destructor Destroy; override;
  316.     class function Drivers: TDirectXDrivers;
  317.     procedure Finalize;
  318.     procedure Initialize;
  319.     procedure Restore;
  320.     procedure RegisterNotifyEvent(NotifyEvent: TDXSoundNotifyEvent);
  321.     procedure UnRegisterNotifyEvent(NotifyEvent: TDXSoundNotifyEvent);
  322.     property AutoInitialize: Boolean read FAutoInitialize write FAutoInitialize;
  323.     property Driver: PGUID read FDriver write SetDriver;
  324.     property DSound: TDirectSound read FDSound;
  325.     property Initialized: Boolean read FInitialized;
  326.     property NowOptions: TDXSoundOptions read FNowOptions;
  327.     property Primary: TDirectSoundBuffer read FPrimary;
  328.     property OnFinalize: TNotifyEvent read FOnFinalize write FOnFinalize;
  329.     property OnInitialize: TNotifyEvent read FOnInitialize write FOnInitialize;
  330.     property OnInitializing: TNotifyEvent read FOnInitializing write FOnInitializing;
  331.     property OnRestore: TNotifyEvent read FOnRestore write FOnRestore;
  332.     property Options: TDXSoundOptions read FOptions write SetOptions;
  333.   end;
  334.  
  335.   {  TDXSound  }
  336.  
  337.   TDXSound = class(TCustomDXSound)
  338.   published
  339.     property AutoInitialize;
  340.     property Options;
  341.     property OnFinalize;
  342.     property OnInitialize;
  343.     property OnInitializing;
  344.     property OnRestore;
  345.   end;
  346.  
  347.   {  EWaveCollectionError  }
  348.  
  349.   EWaveCollectionError = class(Exception);
  350.  
  351.   {  TWaveCollectionItem  }
  352.  
  353.   TWaveCollection = class;
  354.  
  355.   TWaveCollectionItem = class(THashCollectionItem)
  356.   private
  357.     FBuffer: TDirectSoundBuffer;
  358.     FFrequency: Integer;
  359.     FInitialized: Boolean;
  360.     FLooped: Boolean;
  361.     FPan: Integer;
  362.     FVolume: Integer;
  363.     FWave: TWave;
  364.     function CreateBuffer: TDirectSoundBuffer;
  365.     procedure Finalize;
  366.     procedure Initialize;
  367.     function GetBuffer: TDirectSoundBuffer;
  368.     function GetWaveCollection: TWaveCollection;
  369.     procedure SetFrequency(Value: Integer);
  370.     procedure SetLooped(Value: Boolean);
  371.     procedure SetPan(Value: Integer);
  372.     procedure SetVolume(Value: Integer);
  373.     procedure SetWave(Value: TWave);
  374.   public
  375.     constructor Create(Collection: TCollection); override;
  376.     destructor Destroy; override;
  377.     procedure Play(Wait: Boolean);
  378.     procedure Restore;
  379.     procedure Stop;
  380.     property Buffer: TDirectSoundBuffer read GetBuffer;
  381.     property Frequency: Integer read FFrequency write SetFrequency;
  382.     property Initialized: Boolean read FInitialized;
  383.     property Pan: Integer read FPan write SetPan;
  384.     property Volume: Integer read FVolume write SetVolume;
  385.     property WaveCollection: TWaveCollection read GetWaveCollection;
  386.   published
  387.     property Looped: Boolean read FLooped write SetLooped;
  388.     property Wave: TWave read FWave write SetWave;
  389.   end;
  390.  
  391.   {  TWaveCollection  }
  392.  
  393.   TWaveCollection = class(THashCollection)
  394.   private
  395.     FBufferList: TList;
  396.     FDXSound: TCustomDXSound;
  397.     FOwner: TPersistent;
  398.     FTimer: TTimer;
  399.     procedure AddBuffer(Buffer: TDirectSoundBuffer);
  400.     procedure ClearBuffers;
  401.     function GetBuffer(Index: Integer): TDirectSoundBuffer;
  402.     function GetBufferCount: Integer;
  403.     function GetItem(Index: Integer): TWaveCollectionItem;
  404.     function Initialized: Boolean;
  405.     procedure TimerEvent(Sender: TObject);
  406.     property BufferCount: Integer read GetBufferCount;
  407.     property Buffers[Index: Integer]: TDirectSoundBuffer read GetBuffer;
  408.   protected
  409.     function GetOwner: TPersistent; override;
  410.   public
  411.     constructor Create(AOwner: TPersistent);
  412.     destructor Destroy; override;
  413.     function Find(const Name: string): TWaveCollectionItem;
  414.     procedure Finalize;
  415.     procedure Initialize(DXSound: TCustomDXSound);
  416.     procedure Restore;
  417.     procedure LoadFromFile(const FileName: string);
  418.     procedure LoadFromStream(Stream: TStream);
  419.     procedure SaveToFile(const FileName: string);
  420.     procedure SaveToStream(Stream: TStream);
  421.     property DXSound: TCustomDXSound read FDXSound;
  422.     property Items[Index: Integer]: TWaveCollectionItem read GetItem; default;
  423.   end;
  424.  
  425.   {  TCustomDXWaveList  }
  426.  
  427.   TCustomDXWaveList = class(TComponent)
  428.   private
  429.     FDXSound: TCustomDXSound;
  430.     FItems: TWaveCollection;
  431.     procedure DXSoundNotifyEvent(Sender: TCustomDXSound; NotifyType: TDXSoundNotifyType);
  432.     procedure SetDXSound(Value: TCustomDXSound);
  433.     procedure SetItems(Value: TWaveCollection);
  434.   protected
  435.     procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  436.   public
  437.     constructor Create(AOwner: TComponent); override;
  438.     destructor Destroy; override;
  439.     property DXSound: TCustomDXSound read FDXSound write SetDXSound;
  440.     property Items: TWaveCollection read FItems write SetItems;
  441.   end;
  442.  
  443.   {  TDXWaveList  }
  444.  
  445.   TDXWaveList = class(TCustomDXWaveList)
  446.   published
  447.     property DXSound;
  448.     property Items;
  449.   end;
  450.  
  451. implementation
  452.  
  453. uses DXConsts;
  454.  
  455. function DXDirectSoundCreate(lpGUID: PGUID; out lpDS: IDirectSound;
  456.   pUnkOuter: IUnknown): HRESULT;
  457. type
  458.   TDirectSoundCreate = function(lpGUID: PGUID; out lplpDD: IDirectSound;
  459.     pUnkOuter: IUnknown): HRESULT; stdcall;
  460. begin
  461.   Result := TDirectSoundCreate(DXLoadLibrary('DSound.dll', 'DirectSoundCreate'))
  462.     (lpGUID, lpDS, pUnkOuter);
  463. end;
  464.  
  465. function DXDirectSoundEnumerate(lpCallback: LPDSENUMCALLBACKA;
  466.     lpContext: Pointer): HRESULT;
  467. type
  468.   TDirectSoundEnumerate = function(lpCallback: LPDSENUMCALLBACKA;
  469.     lpContext: Pointer): HRESULT; stdcall;
  470. begin
  471.   Result := TDirectSoundEnumerate(DXLoadLibrary('DSound.dll', 'DirectSoundEnumerateA'))
  472.     (lpCallback, lpContext);
  473. end;
  474.  
  475. function DXDirectSoundCaptureCreate(lpGUID: PGUID; out lplpDSC: IDirectSoundCapture;
  476.   pUnkOuter: IUnknown): HRESULT;
  477. type
  478.   TDirectSoundCaptureCreate = function(lpGUID: PGUID; out lplpDD: IDirectSoundCapture;
  479.     pUnkOuter: IUnknown): HRESULT; stdcall;
  480. begin
  481.   try
  482.     Result := TDirectSoundCaptureCreate(DXLoadLibrary('DSound.dll', 'DirectSoundCaptureCreate'))
  483.       (lpGUID, lplpDSC, pUnkOuter);
  484.   except
  485.     raise EDirectXError.Create(SSinceDirectX5);
  486.   end;
  487. end;
  488.  
  489. function DXDirectSoundCaptureEnumerate(lpCallback: LPDSENUMCALLBACKA;
  490.     lpContext: Pointer): HRESULT;
  491. type
  492.   TDirectSoundCaptureEnumerate = function(lpCallback: LPDSENUMCALLBACKA;
  493.     lpContext: Pointer): HRESULT; stdcall;
  494. begin
  495.   try
  496.     Result := TDirectSoundCaptureEnumerate(DXLoadLibrary('DSound.dll', 'DirectSoundCaptureEnumerateA'))
  497.       (lpCallback, lpContext);
  498.   except
  499.     raise EDirectXError.Create(SSinceDirectX5);
  500.   end;
  501. end;
  502.  
  503. var
  504.   DirectSoundDrivers: TDirectXDrivers;
  505.   DirectSoundCaptureDrivers: TDirectXDrivers;
  506.  
  507. function EnumDirectSoundDrivers_DSENUMCALLBACK(lpGuid: PGUID; lpstrDescription: LPCSTR;
  508.   lpstrModule: LPCSTR; lpContext: Pointer): BOOL; stdcall;
  509. begin
  510.   Result := True;
  511.   with TDirectXDriver.Create(TDirectXDrivers(lpContext)) do
  512.   begin
  513.     Guid := lpGuid;
  514.     Description := lpstrDescription;
  515.     DriverName := lpstrModule;
  516.   end;
  517. end;
  518.  
  519. function EnumDirectSoundDrivers: TDirectXDrivers;
  520. begin
  521.   if DirectSoundDrivers=nil then
  522.   begin
  523.     DirectSoundDrivers := TDirectXDrivers.Create;
  524.     try
  525.       DXDirectSoundEnumerate(@EnumDirectSoundDrivers_DSENUMCALLBACK, DirectSoundDrivers);
  526.     except
  527.       DirectSoundDrivers.Free;
  528.       raise;
  529.     end;
  530.   end;
  531.  
  532.   Result := DirectSoundDrivers;
  533. end;
  534.  
  535. function EnumDirectSoundCaptureDrivers: TDirectXDrivers;
  536. begin
  537.   if DirectSoundCaptureDrivers=nil then
  538.   begin
  539.     DirectSoundCaptureDrivers := TDirectXDrivers.Create;
  540.     try
  541.       DXDirectSoundCaptureEnumerate(@EnumDirectSoundDrivers_DSENUMCALLBACK, DirectSoundCaptureDrivers);
  542.     except
  543.       DirectSoundCaptureDrivers.Free;
  544.       raise;
  545.     end;
  546.   end;
  547.  
  548.   Result := DirectSoundCaptureDrivers;
  549. end;
  550.  
  551. {  TDirectSound  }
  552.  
  553. constructor TDirectSound.Create(GUID: PGUID);
  554. var
  555.   DSound: IDirectSound;
  556. begin
  557.   if DXDirectSoundCreate(GUID, DSound, nil)=DD_OK then
  558.     CreateFromInterface(DSound)
  559.   else
  560.     CreateFromInterface(nil);
  561. end;
  562.  
  563. constructor TDirectSound.CreateFromInterface(DSound: IDirectSound);
  564. begin
  565.   inherited Create;
  566.   FBufferList := TList.Create;
  567.  
  568.   FIDSound := DSound;
  569.   if FIDSound=nil then
  570.     raise EDirectSoundError.CreateFmt(SCannotInitialized, [SDirectSound]);
  571. end;
  572.  
  573. destructor TDirectSound.Destroy;
  574. begin
  575.   FBufferList.Free;           
  576.   inherited Destroy;
  577. end;
  578.  
  579. class function TDirectSound.Drivers: TDirectXDrivers;
  580. begin
  581.   Result := EnumDirectSoundDrivers;
  582. end;
  583.  
  584. procedure TDirectSound.CheckBuffer(Buffer: TDirectSoundBuffer);
  585. begin
  586.   case Buffer.DXResult of
  587.     DSERR_BUFFERLOST:
  588.       begin
  589.         if not FInRestoreBuffer then
  590.         begin
  591.           FInRestoreBuffer := True;
  592.           try
  593.             DoRestoreBuffer;
  594.           finally
  595.             FInRestoreBuffer := False;
  596.           end;
  597.         end;
  598.       end;
  599.   end;
  600. end;
  601.  
  602. procedure TDirectSound.DoRestoreBuffer;
  603. begin
  604. end;
  605.  
  606. function TDirectSound.GetBuffer(Index: Integer): TDirectSoundBuffer;
  607. begin
  608.   Result := FBufferList[Index];
  609. end;
  610.  
  611. function TDirectSound.GetBufferCount: Integer;
  612. begin
  613.   Result := FBufferList.Count;
  614. end;
  615.  
  616. function TDirectSound.GetIDSound: IDirectSound;
  617. begin
  618.   if Self<>nil then
  619.     Result := FIDSound
  620.   else
  621.     Result := nil;
  622. end;
  623.  
  624. function TDirectSound.GetISound: IDirectSound;
  625. begin
  626.   Result := IDSound;
  627.   if Result=nil then
  628.     raise EDirectSoundError.CreateFmt(SNotMade, ['IDirectSound']);
  629. end;
  630.  
  631. {  TDirectSoundBuffer  }
  632.  
  633. constructor TDirectSoundBuffer.Create(ADSound: TDirectSound);
  634. begin
  635.   inherited Create;
  636.   FDSound := ADSound;
  637.   FDSound.FBufferList.Add(Self);
  638. end;
  639.  
  640. destructor TDirectSoundBuffer.Destroy;
  641. begin
  642.   FDSound.FBufferList.Remove(Self);
  643.   inherited Destroy;
  644. end;
  645.  
  646. procedure TDirectSoundBuffer.Assign(Source: TPersistent);
  647. var
  648.   TempBuffer: IDirectSoundBuffer;
  649. begin
  650.   if Source=nil then
  651.     IDSBuffer := nil
  652.   else if Source is TWave then
  653.     LoadFromWave(TWave(Source))
  654.   else if Source is TDirectSoundBuffer then
  655.   begin
  656.     if TDirectSoundBuffer(Source).IDSBuffer=nil then
  657.       IDSBuffer := nil
  658.     else begin
  659.       FDSound.DXResult := FDSound.ISound.DuplicateSoundBuffer(TDirectSoundBuffer(Source).IDSBuffer,
  660.         TempBuffer);
  661.       if FDSound.DXResult=0 then
  662.       begin
  663.         IDSBuffer := TempBuffer;
  664.       end;
  665.     end;
  666.   end else
  667.     inherited Assign(Source);
  668. end;
  669.  
  670. procedure TDirectSoundBuffer.Check;
  671. begin
  672.   FDSound.CheckBuffer(Self);
  673. end;
  674.  
  675. function TDirectSoundBuffer.CreateBuffer(const BufferDesc: DSBUFFERDESC): Boolean;
  676. var
  677.   TempBuffer: IDirectSoundBuffer;
  678. begin
  679.   IDSBuffer := nil;
  680.  
  681.   FDSound.DXResult := FDSound.ISound.CreateSoundBuffer(BufferDesc, TempBuffer, nil);
  682.   FDXResult := FDSound.DXResult;
  683.   Result := DXResult=DS_OK;
  684.   if Result then
  685.     IDSBuffer := TempBuffer;
  686. end;
  687.  
  688. function TDirectSoundBuffer.GetBitCount: Longint;
  689. var
  690.   fmtSize: Longint;
  691.   Format: PWaveFormatEx;
  692. begin
  693.   GetFormatAlloc(Format, fmtSize);
  694.   try
  695.     Result := Format^.wBitsPerSample;
  696.   finally
  697.     FreeMem(Format);
  698.   end;
  699. end;
  700.  
  701. function TDirectSoundBuffer.GetFormat(var Format: TWaveFormatEx;
  702.   dwSizeAllocated: Longint; var dwSizeWritten: Longint): Boolean;
  703. begin
  704.   DXResult := IBuffer.GetFormat(Format, dwSizeAllocated, DWORD(dwSizeWritten));
  705.   Result := DXResult=DS_OK;
  706. end;
  707.  
  708. function TDirectSoundBuffer.GetFormatAlloc(var Format: PWaveFormatEx; var Size: Longint): Boolean;
  709. begin
  710.   Result := False;
  711.   if GetFormat(PWaveFormatEx(nil)^, 0, Size) then
  712.   begin
  713.     GetMem(Format, Size);
  714.     Result := GetFormat(Format^, Size, PLongint(nil)^);
  715.   end;
  716. end;
  717.  
  718. function TDirectSoundBuffer.GetFrequency: Integer;
  719. begin
  720.   DXResult := IBuffer.GetFrequency(DWORD(Result));
  721. end;
  722.  
  723. function TDirectSoundBuffer.GetIDSBuffer: IDirectSoundBuffer;
  724. begin
  725.   if Self<>nil then
  726.     Result := FIDSBuffer
  727.   else
  728.     Result := nil;
  729. end;
  730.  
  731. function TDirectSoundBuffer.GetIBuffer: IDirectSoundBuffer;
  732. begin
  733.   Result := IDSBuffer;
  734.   if Result=nil then
  735.     raise EDirectSoundBufferError.CreateFmt(SNotMade, ['IDirectSoundBuffer']);
  736. end;
  737.  
  738. function TDirectSoundBuffer.GetPlaying: Boolean;
  739. begin
  740.   Result := (Status and (DSBSTATUS_PLAYING or DSBSTATUS_LOOPING))<>0;
  741. end;
  742.  
  743. function TDirectSoundBuffer.GetPan: Integer;
  744. begin
  745.   DXResult := IBuffer.GetPan(Longint(Result));
  746. end;
  747.  
  748. function TDirectSoundBuffer.GetPosition: Longint;
  749. var
  750.   dwCurrentWriteCursor: Longint;
  751. begin
  752.   IBuffer.GetCurrentPosition(DWORD(Result), DWORD(dwCurrentWriteCursor));
  753. end;
  754.  
  755. function TDirectSoundBuffer.GetStatus: Integer;
  756. begin
  757.   DXResult := IBuffer.GetStatus(DWORD(Result));
  758. end;
  759.  
  760. function TDirectSoundBuffer.GetVolume: Integer;
  761. begin
  762.   DXResult := IBuffer.GetVolume(Longint(Result));
  763. end;
  764.  
  765. procedure TDirectSoundBuffer.LoadFromFile(const FileName: string);
  766. var
  767.   Stream : TFileStream;
  768. begin
  769.   Stream :=TFileStream.Create(FileName, fmOpenRead);
  770.   try
  771.     LoadFromStream(Stream);
  772.   finally
  773.     Stream.Free;
  774.   end;
  775. end;
  776.  
  777. procedure TDirectSoundBuffer.LoadFromMemory(const Format: TWaveFormatEx;
  778.   Data: Pointer; Size: Integer);
  779. var
  780.   Data1, Data2: Pointer;
  781.   Data1Size, Data2Size: Longint;
  782. begin
  783.   SetSize(Format, Size);
  784.  
  785.   if Data<>nil then
  786.   begin
  787.     if Lock(0, Size, Data1, Data1Size, Data2, Data2Size, 0) then
  788.     begin
  789.       Move(Data^, Data1^, Data1Size);
  790.       if Data2<>nil then
  791.         Move(Pointer(Longint(Data)+Data1Size)^, Data2^, Data2Size);
  792.  
  793.       UnLock(Data1, Data1Size, Data2, Data2Size);
  794.     end else
  795.     begin
  796.       FIDSBuffer := nil;
  797.       raise EDirectSoundBufferError.CreateFmt(SCannotLock, [SDirectSoundBuffer]);
  798.     end;
  799.   end;
  800. end;
  801.  
  802. procedure TDirectSoundBuffer.LoadFromStream(Stream: TStream);
  803. var
  804.   Wave: TWave;
  805. begin
  806.   Wave := TWave.Create;
  807.   try
  808.     Wave.LoadFromStream(Stream);
  809.     LoadFromWave(Wave);
  810.   finally
  811.     Wave.Free;
  812.   end;
  813. end;
  814.  
  815. procedure TDirectSoundBuffer.LoadFromWave(Wave: TWave);
  816. begin
  817.   LoadFromMemory(Wave.Format^, Wave.Data, Wave.Size);
  818. end;
  819.  
  820. function TDirectSoundBuffer.Lock(dwWriteCursor, dwWriteBytes: Longint;
  821.   var lpvAudioPtr1: Pointer; var dwAudioBytes1: Longint;
  822.   var lpvAudioPtr2: Pointer; var dwAudioBytes2: Longint;
  823.   dwFlags: Longint): Boolean;
  824. begin
  825.   DXResult := IBuffer.Lock(dwWriteCursor, dwWriteBytes,
  826.     lpvAudioPtr1, DWORD(dwAudioBytes1),
  827.     lpvAudioPtr2, DWORD(dwAudioBytes2), dwFlags);
  828.   Result := DXResult=DS_OK;
  829. end;
  830.  
  831. function TDirectSoundBuffer.Play(Flags: Longint): Boolean;
  832. begin
  833.   DXResult := IBuffer.Play(0, 0, Flags);
  834.   Result := DXResult=DS_OK;
  835. end;
  836.  
  837. function TDirectSoundBuffer.Restore: Boolean;
  838. begin
  839.   DXResult := IBuffer.Restore;
  840.   Result := DXResult=DS_OK;
  841. end;
  842.  
  843. function TDirectSoundBuffer.SetFormat(const Format: TWaveFormatEx): Boolean;
  844. begin
  845.   DXResult := IBuffer.SetFormat(Format);
  846.   Result := DXResult=DS_OK;
  847. end;
  848.  
  849. procedure TDirectSoundBuffer.SetFrequency(Value: Integer);
  850. begin
  851.   DXResult := IBuffer.SetFrequency(Value);
  852. end;
  853.  
  854. procedure TDirectSoundBuffer.SetIDSBuffer(Value: IDirectSoundBuffer);
  855. begin
  856.   FIDSBuffer := Value;
  857. end;
  858.  
  859. procedure TDirectSoundBuffer.SetPan(Value: Integer);
  860. begin
  861.   DXResult := IBuffer.SetPan(Value);
  862. end;
  863.  
  864. procedure TDirectSoundBuffer.SetPosition(Value: Longint);
  865. begin
  866.   DXResult := IBuffer.SetCurrentPosition(Value);
  867. end;
  868.  
  869. procedure TDirectSoundBuffer.SetSize(const Format: TWaveFormatEx; Size: Integer);
  870. var
  871.   BufferDesc: DSBUFFERDESC ;
  872. begin
  873.   {  IDirectSoundBuffer made.  }
  874.   FillChar(BufferDesc, SizeOf(BufferDesc), 0);
  875.  
  876.   with BufferDesc do
  877.   begin
  878.     dwSize := SizeOf(DSBUFFERDESC);
  879.     dwFlags := DSBCAPS_CTRLDEFAULT;
  880.     if DSound.FStickyFocus then
  881.       dwFlags := dwFlags or DSBCAPS_STICKYFOCUS
  882.     else if DSound.FGlobalFocus then
  883.       dwFlags := dwFlags or DSBCAPS_GLOBALFOCUS;
  884.     dwBufferBytes := Size;
  885.     lpwfxFormat := @Format;
  886.   end;
  887.  
  888.   if not CreateBuffer(BufferDesc) then
  889.     raise EDirectSoundBufferError.CreateFmt(SCannotMade, [SDirectSoundBuffer]);
  890. end;
  891.  
  892. procedure TDirectSoundBuffer.SetVolume(Value: Integer);
  893. begin
  894.   DXResult := IBuffer.SetVolume(Value);
  895. end;
  896.  
  897. function TDirectSoundBuffer.Stop: Boolean;
  898. begin
  899.   DXResult := IBuffer.Stop;
  900.   Result := DXResult=DS_OK;
  901. end;
  902.  
  903. function TDirectSoundBuffer.Unlock(lpvAudioPtr1: Pointer; dwAudioBytes1: Longint;
  904.   lpvAudioPtr2: Pointer; dwAudioBytes2: Longint): Boolean;
  905. begin
  906.   DXResult := IBuffer.Unlock(lpvAudioPtr1, dwAudioBytes1,
  907.     lpvAudioPtr2, dwAudioBytes2);
  908.   Result := DXResult=DS_OK;
  909. end;
  910.  
  911. {  TAudioStream  }
  912.  
  913. type
  914.   TAudioStreamNotify = class(TThread)
  915.   private
  916.     FAudio: TAudioStream;
  917.     FSleepTime: Integer;
  918.     FStopOnTerminate: Boolean;
  919.     constructor Create(Audio: TAudioStream);
  920.     destructor Destroy; override;
  921.     procedure Execute; override;
  922.     procedure Update;
  923.     procedure ThreadTerminate(Sender: TObject);
  924.   end;
  925.  
  926. constructor TAudioStreamNotify.Create(Audio: TAudioStream);
  927. begin
  928.   FAudio := Audio;
  929.  
  930.   OnTerminate := ThreadTerminate;
  931.  
  932.   FAudio.FNotifyEvent := CreateEvent(nil, False, False, nil);
  933.   FAudio.FNotifyThread := Self;
  934.  
  935.   FSleepTime := Min(FAudio.FBufferLength div 4, 1000 div 20);
  936.   FStopOnTerminate := True;
  937.  
  938.   FreeOnTerminate := True;
  939.   inherited Create(False);
  940. end;
  941.  
  942. destructor TAudioStreamNotify.Destroy;
  943. begin
  944.   FreeOnTerminate := False;
  945.   SetEvent(FAudio.FNotifyEvent);
  946.   inherited Destroy;
  947.   CloseHandle(FAudio.FNotifyEvent);
  948. end;
  949.  
  950. procedure TAudioStreamNotify.ThreadTerminate(Sender: TObject);
  951. begin
  952.   FAudio.FNotifyThread := nil;
  953.   if FStopOnTerminate then FAudio.Stop;
  954. end;
  955.  
  956. procedure TAudioStreamNotify.Execute;
  957. begin
  958.   while WaitForSingleObject(FAudio.FNotifyEvent, FSleepTime)=WAIT_TIMEOUT do
  959.   begin
  960.     Synchronize(Update);
  961.   end;
  962. end;
  963.  
  964. procedure TAudioStreamNotify.Update;
  965. begin
  966.   try
  967.     FAudio.FInThread := True;
  968.     try
  969.       FAudio.Update;
  970.     finally
  971.       FAudio.FInThread := False;
  972.     end;
  973.   except
  974.     on E: Exception do
  975.     begin
  976.       Application.HandleException(E);
  977.       SetEvent(FAudio.FNotifyEvent);
  978.     end;
  979.   end;
  980. end;
  981.  
  982. constructor TAudioStream.Create(ADSound: TDirectSound);
  983. begin
  984.   inherited Create;
  985.   FDSound := ADSound;
  986.   FAutoUpdate := True;
  987.   FBuffer := TDirectSoundBuffer.Create(FDSound);
  988.   FBufferLength := 1000;
  989. end;
  990.  
  991. destructor TAudioStream.Destroy;
  992. begin
  993.   Stop;
  994.   WaveStream := nil;
  995.   FBuffer.Free;
  996.   inherited Destroy;
  997. end;
  998.  
  999. function TAudioStream.GetFormat: PWaveFormatEX;
  1000. begin
  1001.   if WaveStream=nil then
  1002.     raise EAudioStreamError.Create(SWaveStreamNotSet);
  1003.   Result := WaveStream.Format;
  1004. end;
  1005.  
  1006. function TAudioStream.GetFormatSize: Integer;
  1007. begin
  1008.   if WaveStream=nil then
  1009.     raise EAudioStreamError.Create(SWaveStreamNotSet);
  1010.   Result := WaveStream.FormatSize;
  1011. end;
  1012.  
  1013. function TAudioStream.GetFrequency: Integer;
  1014. begin
  1015.   Result := FBuffer.Frequency;
  1016. end;
  1017.  
  1018. function TAudioStream.GetPan: Integer;
  1019. begin
  1020.   Result := FBuffer.Pan;
  1021. end;
  1022.  
  1023. function TAudioStream.GetPlayedSize: Integer;
  1024. begin
  1025.   if Playing then UpdatePlayedSize;
  1026.   Result := FPlayedSize;
  1027. end;
  1028.  
  1029. function TAudioStream.GetSize: Integer;
  1030. begin
  1031.   if WaveStream<>nil then
  1032.     Result := WaveStream.Size
  1033.   else
  1034.     Result := 0;
  1035. end;
  1036.  
  1037. function TAudioStream.GetVolume: Integer;
  1038. begin
  1039.   Result := FBuffer.Volume;
  1040. end;
  1041.  
  1042. procedure TAudioStream.UpdatePlayedSize;
  1043. var
  1044.   PlayPosition, PlayedSize: DWORD;
  1045. begin
  1046.   PlayPosition := FBuffer.Position;
  1047.  
  1048.   if FPlayBufferPos <= PlayPosition then
  1049.   begin
  1050.     PlayedSize := PlayPosition - FPlayBufferPos
  1051.   end else
  1052.   begin
  1053.     PlayedSize := PlayPosition + (FBufferSize - FPlayBufferPos);
  1054.   end;
  1055.  
  1056.   Inc(FPlayedSize, PlayedSize);
  1057.  
  1058.   FPlayBufferPos := PlayPosition;
  1059. end;
  1060.  
  1061. function TAudioStream.GetWriteSize: Integer;
  1062. var
  1063.   PlayPosition: DWORD;
  1064.   i: Integer;
  1065. begin
  1066.   PlayPosition := FBuffer.Position;
  1067.  
  1068.   if FBufferPos <= PlayPosition then
  1069.   begin
  1070.     Result := PlayPosition - FBufferPos
  1071.   end else
  1072.   begin
  1073.     Result := PlayPosition + (FBufferSize - FBufferPos);
  1074.   end;
  1075.  
  1076.   i := WaveStream.FilledSize;
  1077.   if i>=0 then Result := Min(Result, i);
  1078. end;
  1079.  
  1080. procedure TAudioStream.Play;
  1081. begin
  1082.   if not FPlaying then
  1083.   begin
  1084.     if WaveStream=nil then
  1085.       raise EAudioStreamError.Create(SWaveStreamNotSet);
  1086.  
  1087.     if Size=0 then Exit;
  1088.  
  1089.     FPlaying := True;
  1090.     try
  1091.       SetPosition(FPosition);
  1092.       if FAutoUpdate then
  1093.         FNotifyThread := TAudioStreamNotify.Create(Self);
  1094.     except
  1095.       Stop;
  1096.       raise;
  1097.     end;
  1098.   end;
  1099. end;
  1100.  
  1101. procedure TAudioStream.RecreateBuf;
  1102. var
  1103.   APlaying: Boolean;
  1104.   APosition: Integer;
  1105.   AFrequency: Integer;
  1106.   APan: Integer;
  1107.   AVolume: Integer;
  1108. begin
  1109.   APlaying := Playing;
  1110.  
  1111.   APosition := Position;
  1112.   AFrequency := Frequency;
  1113.   APan := Pan;
  1114.   AVolume := Volume;
  1115.  
  1116.   WaveStream := WaveStream;
  1117.  
  1118.   Position := APosition;
  1119.   Frequency := AFrequency;
  1120.   Pan := APan;
  1121.   Volume := AVolume;
  1122.                   
  1123.   if APlaying then Play;
  1124. end;
  1125.  
  1126. procedure TAudioStream.SetAutoUpdate(Value: Boolean);
  1127. begin
  1128.   if FAutoUpdate<>Value then
  1129.   begin
  1130.     FAutoUpdate := Value;
  1131.     if FPlaying then
  1132.     begin
  1133.       if FNotifyThread<>nil then
  1134.       begin
  1135.         (FNotifyThread as TAudioStreamNotify).FStopOnTerminate := False;
  1136.         FNotifyThread.Free;
  1137.       end;
  1138.  
  1139.       if FAutoUpdate then
  1140.         FNotifyThread := TAudioStreamNotify.Create(Self);
  1141.     end;
  1142.   end;
  1143. end;
  1144.  
  1145. procedure TAudioStream.SetBufferLength(Value: Integer);
  1146. begin
  1147.   if Value<10 then Value := 10;
  1148.   if FBufferLength<>Value then
  1149.   begin
  1150.     FBufferLength := Value;
  1151.     if WaveStream<>nil then RecreateBuf;
  1152.   end;
  1153. end;
  1154.  
  1155. procedure TAudioStream.SetFrequency(Value: Integer);
  1156. begin
  1157.   FBuffer.Frequency := Value;
  1158. end;
  1159.  
  1160. procedure TAudioStream.SetLooped(Value: Boolean);
  1161. begin
  1162.   if FLooped<>Value then
  1163.   begin
  1164.     FLooped := Value;
  1165.     Position := Position;
  1166.   end;
  1167. end;
  1168.  
  1169. procedure TAudioStream.SetPan(Value: Integer);
  1170. begin
  1171.   FBuffer.Pan := Value;
  1172. end;
  1173.  
  1174. procedure TAudioStream.SetPlayedSize(Value: Integer);
  1175. begin
  1176.   if Playing then UpdatePlayedSize;
  1177.   FPlayedSize := Value;
  1178. end;
  1179.  
  1180. procedure TAudioStream.SetPosition(Value: Integer);
  1181. begin
  1182.   if WaveStream=nil then
  1183.     raise EAudioStreamError.Create(SWaveStreamNotSet);
  1184.  
  1185.   Value := Max(Min(Value, Size-1), 0);
  1186.   Value := Value div Format^.nBlockAlign * Format^.nBlockAlign;
  1187.  
  1188.   FPosition := Value;
  1189.  
  1190.   if Playing then
  1191.   begin
  1192.     try
  1193.       FBuffer.Stop;
  1194.  
  1195.       FBufferPos := 0;
  1196.       FPlayBufferPos := 0;
  1197.       FWritePosition := Value;
  1198.  
  1199.       WriteWave(FBufferSize);
  1200.  
  1201.       FBuffer.Position := 0;
  1202.       FBuffer.Play(DSBPLAY_LOOPING);
  1203.     except
  1204.       Stop;
  1205.       raise;
  1206.     end;
  1207.   end;
  1208. end;
  1209.  
  1210. procedure TAudioStream.SetVolume(Value: Integer);
  1211. begin
  1212.   FBuffer.Volume := Value;
  1213. end;
  1214.  
  1215. procedure TAudioStream.SetWaveStream(Value: TCustomWaveStream);
  1216. var
  1217.   BufferDesc: DSBUFFERDESC;
  1218. begin
  1219.   Stop;
  1220.  
  1221.   FWaveStream := nil;
  1222.   FBufferPos := 0;
  1223.   FPosition := 0;
  1224.   FWritePosition := 0;
  1225.  
  1226.   if (Value<>nil) and (FBufferLength>0) then
  1227.   begin
  1228.     FBufferSize := FBufferLength * Integer(Value.Format^.nAvgBytesPerSec) div 1000;
  1229.  
  1230.     FillChar(BufferDesc, SizeOf(BufferDesc), 0);
  1231.     with BufferDesc do
  1232.     begin
  1233.       dwSize := SizeOf(DSBUFFERDESC);
  1234.       dwFlags := DSBCAPS_CTRLDEFAULT or DSBCAPS_GETCURRENTPOSITION2;
  1235.       if FDSound.FStickyFocus then
  1236.         dwFlags := dwFlags or DSBCAPS_STICKYFOCUS
  1237.       else if FDSound.FGlobalFocus then
  1238.         dwFlags := dwFlags or DSBCAPS_GLOBALFOCUS;
  1239.       dwBufferBytes := FBufferSize;
  1240.       lpwfxFormat := Value.Format;
  1241.     end;
  1242.  
  1243.     if not FBuffer.CreateBuffer(BufferDesc) then
  1244.       raise EDirectSoundBufferError.CreateFmt(SCannotMade, [SDirectSoundBuffer]);
  1245.   end else
  1246.   begin
  1247.     FBuffer.IDSBuffer := nil;
  1248.     FBufferSize := 0;
  1249.   end;
  1250.  
  1251.   FWaveStream := Value;
  1252. end;
  1253.  
  1254. procedure TAudioStream.Stop;
  1255. begin
  1256.   if FPlaying then
  1257.   begin
  1258.     if FInThread then
  1259.     begin
  1260.       SetEvent(FNotifyEvent);
  1261.     end else
  1262.     begin
  1263.       FPlaying := False;
  1264.       FBuffer.Stop;
  1265.       FNotifyThread.Free;
  1266.     end;
  1267.   end;
  1268. end;
  1269.  
  1270. procedure TAudioStream.Update;
  1271. var
  1272.   WriteSize: Integer;
  1273. begin
  1274.   if not FPlaying then Exit;
  1275.  
  1276.   try
  1277.     UpdatePlayedSize;
  1278.  
  1279.     if Size<0 then
  1280.     begin
  1281.       WriteSize := GetWriteSize;
  1282.       if WriteSize>0 then
  1283.       begin
  1284.         WriteSize := WriteWave(WriteSize);
  1285.         FPosition := FPosition + WriteSize;
  1286.       end;
  1287.     end else
  1288.     begin
  1289.       if FLooped then
  1290.       begin
  1291.         WriteSize := GetWriteSize;
  1292.         if WriteSize>0 then
  1293.         begin
  1294.           WriteWave(WriteSize);
  1295.           FPosition := (FPosition + WriteSize) mod Size;
  1296.         end;
  1297.       end else
  1298.       begin
  1299.         if FPosition<Size then
  1300.         begin
  1301.           WriteSize := GetWriteSize;
  1302.           if WriteSize>0 then
  1303.           begin
  1304.             WriteWave(WriteSize);
  1305.             FPosition := FPosition + WriteSize;
  1306.             if FPosition>Size then FPosition := Size;
  1307.           end;
  1308.         end else
  1309.           Stop;
  1310.       end;
  1311.     end;
  1312.   except
  1313.     Stop;
  1314.     raise;
  1315.   end;
  1316. end;
  1317.  
  1318. function TAudioStream.WriteWave(WriteSize: Integer): Integer;
  1319.  
  1320.   procedure WriteData(Size: Integer);
  1321.   var
  1322.     Data1, Data2: Pointer;
  1323.     Data1Size, Data2Size: Longint;
  1324.   begin
  1325.     if FBuffer.Lock(FBufferPos, Size, Data1, Data1Size, Data2, Data2Size, 0) then
  1326.     begin
  1327.       try
  1328.         FWaveStream.Position := FWritePosition;
  1329.         FWaveStream.ReadBuffer(Data1^, Data1Size);
  1330.         FWritePosition := FWritePosition + Data1Size;
  1331.  
  1332.         if Data2<>nil then
  1333.         begin
  1334.           FWaveStream.ReadBuffer(Data2^, Data2Size);
  1335.           FWritePosition := FWritePosition + Data2Size;
  1336.         end;
  1337.  
  1338.         FBufferPos := (FBufferPos + DWORD(Data1Size) + DWORD(Data2Size)) mod FBufferSize;
  1339.       finally
  1340.         FBuffer.UnLock(Data1, Data1Size, Data2, Data2Size);
  1341.       end;
  1342.     end;
  1343.   end;
  1344.  
  1345.   procedure WriteData2(Size: Integer);
  1346.   var
  1347.     Data1, Data2: Pointer;
  1348.     Data1Size, Data2Size, s1, s2: Longint;
  1349.   begin
  1350.     if FBuffer.Lock(FBufferPos, Size, Data1, Data1Size, Data2, Data2Size, 0) then
  1351.     begin
  1352.       try
  1353.         FWaveStream.Position := FWritePosition;
  1354.         s1 := FWaveStream.Read(Data1^, Data1Size);
  1355.         FWritePosition := FWritePosition + s1;
  1356.         FBufferPos := (FBufferPos + DWORD(s1)) mod FBufferSize;
  1357.         Inc(Result, s1);
  1358.  
  1359.         if (Data2<>nil) and (s1=Data1Size) then
  1360.         begin
  1361.           s2 := FWaveStream.Read(Data2^, Data2Size);
  1362.           FWritePosition := FWritePosition + s2;
  1363.           FBufferPos := (FBufferPos + DWORD(s2)) mod FBufferSize;
  1364.           Inc(Result, s2);
  1365.         end;
  1366.       finally
  1367.         FBuffer.UnLock(Data1, Data1Size, Data2, Data2Size);
  1368.       end;
  1369.     end;
  1370.   end;
  1371.  
  1372.   procedure WriteSilence(Size: Integer);
  1373.   var
  1374.     C: Byte;
  1375.     Data1, Data2: Pointer;
  1376.     Data1Size, Data2Size: Longint;
  1377.   begin
  1378.     if Format^.wBitsPerSample=8 then C := $80 else C := 0;
  1379.  
  1380.     if FBuffer.Lock(FBufferPos, Size, Data1, Data1Size, Data2, Data2Size, 0) then
  1381.     begin
  1382.       FillChar(Data1^, Data1Size, C);
  1383.  
  1384.       if Data2<>nil then
  1385.         FillChar(Data2^, Data2Size, C);
  1386.  
  1387.       FBuffer.UnLock(Data1, Data1Size, Data2, Data2Size);
  1388.  
  1389.       FBufferPos := (FBufferPos + DWORD(Data1Size) + DWORD(Data2Size)) mod FBufferSize;
  1390.       FWritePosition := FWritePosition + Data1Size + Data2Size;
  1391.     end;
  1392.   end;
  1393.  
  1394. var
  1395.   DataSize: Integer;
  1396. begin
  1397.   if Size>=0 then
  1398.   begin
  1399.     Result := WriteSize;
  1400.     if FLooped then
  1401.     begin
  1402.       while WriteSize>0 do
  1403.       begin
  1404.         DataSize := Min(Size-FWritePosition, WriteSize);
  1405.  
  1406.         WriteData(DataSize);
  1407.         FWritePosition := FWritePosition mod Size;
  1408.  
  1409.         Dec(WriteSize, DataSize);
  1410.       end;
  1411.     end else
  1412.     begin
  1413.       DataSize := Size-FWritePosition;
  1414.  
  1415.       if DataSize<=0 then
  1416.       begin
  1417.         WriteSilence(WriteSize);
  1418.       end else
  1419.       if DataSize>=WriteSize then
  1420.       begin
  1421.         WriteData(WriteSize);
  1422.       end else
  1423.       begin
  1424.         WriteData(DataSize);
  1425.         WriteSilence(WriteSize-DataSize);
  1426.       end;
  1427.     end;
  1428.   end else
  1429.   begin
  1430.     Result := 0;
  1431.     WriteData2(WriteSize);
  1432.   end;
  1433. end;
  1434.  
  1435. {  TAudioFileStream  }
  1436.  
  1437. destructor TAudioFileStream.Destroy;
  1438. begin
  1439.   inherited Destroy;
  1440.   FWaveFileStream.Free;
  1441. end;
  1442.  
  1443. procedure TAudioFileStream.SetFileName(const Value: string);
  1444. begin
  1445.   if FFileName=Value then Exit;
  1446.  
  1447.   FFileName := Value;
  1448.  
  1449.   if FWaveFileStream<>nil then
  1450.   begin
  1451.     WaveStream := nil;
  1452.     FWaveFileStream.Free;
  1453.     FWaveFileStream := nil;
  1454.   end;
  1455.  
  1456.   if Value<>'' then
  1457.   begin
  1458.     try
  1459.       FWaveFileStream := TWaveFileStream.Create(Value, fmOpenRead or fmShareDenyWrite);
  1460.       FWaveFileStream.Open(False);
  1461.       WaveStream := FWaveFileStream;
  1462.     except
  1463.       WaveStream := nil;
  1464.       FFileName := '';
  1465.       raise;
  1466.     end;
  1467.   end;
  1468. end;
  1469.  
  1470. {  TSoundCaptureFormats  }
  1471.  
  1472. constructor TSoundCaptureFormats.Create;
  1473. begin
  1474.   inherited Create(TSoundCaptureFormat);
  1475. end;
  1476.  
  1477. function TSoundCaptureFormats.GetItem(Index: Integer): TSoundCaptureFormat;
  1478. begin
  1479.   Result := TSoundCaptureFormat(inherited Items[Index]);
  1480. end;
  1481.  
  1482. function TSoundCaptureFormats.IndexOf(ASamplesPerSec, ABitsPerSample, AChannels: Integer): Integer;
  1483. var
  1484.   i: Integer;
  1485. begin
  1486.   Result := -1;
  1487.   for i:=0 to Count-1 do
  1488.     with Items[i] do
  1489.       if (FSamplesPerSec=ASamplesPerSec) and (FBitsPerSample=ABitsPerSample) and (FChannels=AChannels) then
  1490.       begin
  1491.         Result := i;
  1492.         Break;
  1493.       end;
  1494. end;
  1495.  
  1496. {  TSoundCaptureStream  }
  1497.  
  1498. type
  1499.   TSoundCaptureStreamNotify = class(TThread)
  1500.   private
  1501.     FCapture: TSoundCaptureStream;
  1502.     FSleepTime: Integer;
  1503.     constructor Create(Capture: TSoundCaptureStream);
  1504.     destructor Destroy; override;
  1505.     procedure Execute; override;
  1506.     procedure Update;
  1507.   end;
  1508.  
  1509. constructor TSoundCaptureStreamNotify.Create(Capture: TSoundCaptureStream);
  1510. begin
  1511.   FCapture := Capture;
  1512.  
  1513.   FCapture.FNotifyEvent := CreateEvent(nil, False, False, nil);
  1514.   FSleepTime := Min(FCapture.FBufferLength div 4, 1000 div 20);
  1515.  
  1516.   FreeOnTerminate := True;
  1517.   inherited Create(True);
  1518. end;
  1519.  
  1520. destructor TSoundCaptureStreamNotify.Destroy;
  1521. begin
  1522.   FreeOnTerminate := False;
  1523.   SetEvent(FCapture.FNotifyEvent);
  1524.  
  1525.   inherited Destroy;
  1526.  
  1527.   CloseHandle(FCapture.FNotifyEvent);
  1528.   FCapture.FNotifyThread := nil;
  1529.  
  1530.   if Assigned(FCapture.FOnFilledBuffer) then FCapture.Stop;
  1531. end;
  1532.  
  1533. procedure TSoundCaptureStreamNotify.Execute;
  1534. begin
  1535.   while WaitForSingleObject(FCapture.FNotifyEvent, FSleepTime)=WAIT_TIMEOUT do
  1536.   begin
  1537.     Synchronize(Update);
  1538.   end;
  1539. end;
  1540.  
  1541. procedure TSoundCaptureStreamNotify.Update;
  1542. begin
  1543.   if FCapture.FilledSize>0 then
  1544.   begin
  1545.     try
  1546.       FCapture.DoFilledBuffer;
  1547.     except
  1548.       on E: Exception do
  1549.       begin
  1550.         Application.HandleException(E);
  1551.         SetEvent(FCapture.FNotifyEvent);
  1552.       end;
  1553.     end;
  1554.   end;
  1555. end;
  1556.  
  1557. constructor TSoundCaptureStream.Create(GUID: PGUID);
  1558. const
  1559.   SamplesPerSecList: array[0..6] of Integer = (8000, 11025, 22050, 33075, 44100, 48000, 96000);
  1560.   BitsPerSampleList: array[0..3] of Integer = (8, 16, 24, 32);
  1561.   ChannelsList: array[0..1] of Integer = (1, 2);
  1562. var
  1563.   ASamplesPerSec, ABitsPerSample, AChannels: Integer;
  1564.   dscbd: DSCBUFFERDESC;
  1565.   TempBuffer: IDirectSoundCaptureBuffer;
  1566.   Format: TWaveFormatEx;
  1567. begin
  1568.   inherited Create;
  1569.   FBufferLength := 1000;
  1570.   FSupportedFormats := TSoundCaptureFormats.Create;
  1571.  
  1572.   if DXDirectSoundCaptureCreate(GUID, FCapture, nil)<>DS_OK then
  1573.     raise ESoundCaptureStreamError.CreateFmt(SCannotInitialized, [SDirectSoundCapture]);
  1574.  
  1575.   {  The supported format list is acquired.  }
  1576.   for ASamplesPerSec:=Low(SamplesPerSecList) to High(SamplesPerSecList) do
  1577.     for ABitsPerSample:=Low(BitsPerSampleList) to High(BitsPerSampleList) do
  1578.       for AChannels:=Low(ChannelsList) to High(ChannelsList) do
  1579.       begin
  1580.         {  Test  }
  1581.         MakePCMWaveFormatEx(Format, SamplesPerSecList[ASamplesPerSec], BitsPerSampleList[ABitsPerSample], ChannelsList[AChannels]);
  1582.  
  1583.         FillChar(dscbd, SizeOf(dscbd), 0);
  1584.         dscbd.dwSize := SizeOf(dscbd);
  1585.         dscbd.dwBufferBytes := Format.nAvgBytesPerSec;
  1586.         dscbd.lpwfxFormat := @Format;
  1587.  
  1588.         {  If the buffer can be made,  the format of present can be used.  }
  1589.         if FCapture.CreateCaptureBuffer(dscbd, TempBuffer, nil)=DS_OK then
  1590.         begin
  1591.           TempBuffer := nil;
  1592.           with TSoundCaptureFormat.Create(FSupportedFormats) do
  1593.           begin
  1594.             FSamplesPerSec := Format.nSamplesPerSec;
  1595.             FBitsPerSample := Format.wBitsPerSample;
  1596.             FChannels := Format.nChannels;
  1597.           end;
  1598.         end;
  1599.       end;
  1600. end;
  1601.  
  1602. destructor TSoundCaptureStream.Destroy;
  1603. begin
  1604.   Stop;
  1605.   FSupportedFormats.Free;
  1606.   inherited Destroy;
  1607. end;
  1608.  
  1609. procedure TSoundCaptureStream.DoFilledBuffer;
  1610. begin
  1611.   if Assigned(FOnFilledBuffer) then FOnFilledBuffer(Self);
  1612. end;
  1613.  
  1614. class function TSoundCaptureStream.Drivers: TDirectXDrivers;
  1615. begin
  1616.   Result := EnumDirectSoundCaptureDrivers;
  1617. end;
  1618.  
  1619. function TSoundCaptureStream.GetFilledSize: Integer;
  1620. begin
  1621.   Result := GetReadSize;
  1622. end;
  1623.  
  1624. function TSoundCaptureStream.GetReadSize: Integer;
  1625. var
  1626.   CapturePosition, ReadPosition: DWORD;
  1627. begin
  1628.   if FBuffer.GetCurrentPosition(CapturePosition, ReadPosition)=DS_OK then
  1629.   begin
  1630.     if FBufferPos<=ReadPosition then
  1631.       Result := ReadPosition - FBufferPos
  1632.     else
  1633.       Result := FBufferSize - FBufferPos + ReadPosition;
  1634.   end else
  1635.     Result := 0;
  1636. end;
  1637.  
  1638. function TSoundCaptureStream.ReadWave(var Buffer; Count: Integer): Integer;
  1639. var
  1640.   Size: Integer;
  1641.   Data1, Data2: Pointer;
  1642.   Data1Size, Data2Size: DWORD;
  1643.   C: Byte;
  1644. begin
  1645.   if not FCapturing then
  1646.     Start;
  1647.  
  1648.   Result := 0;
  1649.   while Result<Count do
  1650.   begin
  1651.     Size := Min(Count-Result, GetReadSize);
  1652.     if Size>0 then
  1653.     begin
  1654.       if FBuffer.Lock(FBufferPos, Size, Data1, Data1Size, Data2, Data2Size, 0)=DS_OK then
  1655.       begin
  1656.         Move(Data1^, Pointer(Integer(@Buffer)+Result)^, Data1Size);
  1657.         Result := Result + Integer(Data1Size);
  1658.  
  1659.         if Data2<>nil then
  1660.         begin
  1661.           Move(Data2^, Pointer(Integer(@Buffer)+Result)^, Data2Size);
  1662.           Result := Result + Integer(Data1Size);
  1663.         end;
  1664.  
  1665.         FBuffer.UnLock(Data1, Data1Size, Data2, Data2Size);
  1666.         FBufferPos := (FBufferPos + Data1Size + Data2Size) mod FBufferSize;
  1667.       end else
  1668.         Break;
  1669.     end;
  1670.     if Result<Count then Sleep(50);
  1671.   end;
  1672.  
  1673.   case Format^.wBitsPerSample of
  1674.      8: C := $80;
  1675.     16: C := $00;
  1676.   else
  1677.     C := $00;
  1678.   end;
  1679.  
  1680.   FillChar(Pointer(Integer(@Buffer)+Result)^, Count-Result, C);
  1681.   Result := Count;
  1682. end;
  1683.  
  1684. procedure TSoundCaptureStream.SetBufferLength(Value: Integer);
  1685. begin
  1686.   FBufferLength := Max(Value, 0);
  1687. end;
  1688.  
  1689. procedure TSoundCaptureStream.SetOnFilledBuffer(Value: TNotifyEvent);
  1690. begin
  1691.   if CompareMem(@TMethod(FOnFilledBuffer), @TMethod(Value), SizeOf(TMethod)) then Exit;
  1692.  
  1693.   if FCapturing then
  1694.   begin
  1695.     if Assigned(FOnFilledBuffer) then
  1696.       FNotifyThread.Free;
  1697.  
  1698.     FOnFilledBuffer := Value;
  1699.  
  1700.     if Assigned(FOnFilledBuffer) then
  1701.     begin
  1702.       FNotifyThread := TSoundCaptureStreamNotify.Create(Self);
  1703.       FNotifyThread.Resume;
  1704.     end;
  1705.   end else
  1706.     FOnFilledBuffer := Value;
  1707. end;
  1708.  
  1709. procedure TSoundCaptureStream.Start;
  1710. var
  1711.   dscbd: DSCBUFFERDESC;
  1712. begin
  1713.   Stop;
  1714.   try
  1715.     FCapturing := True;
  1716.  
  1717.     FormatSize := SizeOf(TWaveFormatEx);
  1718.     with FSupportedFormats[CaptureFormat] do
  1719.       MakePCMWaveFormatEx(Format^, SamplesPerSec, BitsPerSample, Channels);
  1720.  
  1721.     FBufferSize := Max(MulDiv(Format^.nAvgBytesPerSec, FBufferLength, 1000), 8000);
  1722.  
  1723.     FillChar(dscbd, SizeOf(dscbd), 0);
  1724.     dscbd.dwSize := SizeOf(dscbd);
  1725.     dscbd.dwBufferBytes := FBufferSize;
  1726.     dscbd.lpwfxFormat := Format;
  1727.  
  1728.     if FCapture.CreateCaptureBuffer(dscbd, FBuffer, nil)<>DS_OK then
  1729.       raise ESoundCaptureStreamError.CreateFmt(SCannotMade, [SDirectSoundCaptureBuffer]);
  1730.  
  1731.     FBufferPos := 0;
  1732.  
  1733.     FBuffer.Start(DSCBSTART_LOOPING);
  1734.  
  1735.     if Assigned(FOnFilledBuffer) then
  1736.     begin
  1737.       FNotifyThread := TSoundCaptureStreamNotify.Create(Self);
  1738.       FNotifyThread.Resume;
  1739.     end;
  1740.   except
  1741.     Stop;
  1742.     raise;
  1743.   end;
  1744. end;
  1745.  
  1746. procedure TSoundCaptureStream.Stop;
  1747. begin
  1748.   if FCapturing then
  1749.   begin
  1750.     FNotifyThread.Free;
  1751.     FCapturing := False;
  1752.     if FBuffer<>nil then
  1753.       FBuffer.Stop;
  1754.     FBuffer := nil;
  1755.   end;
  1756. end;
  1757.  
  1758. {  TSoundEngine  }
  1759.  
  1760. constructor TSoundEngine.Create(ADSound: TDirectSound);
  1761. begin
  1762.   inherited Create;
  1763.   FDSound := ADSound;
  1764.   FEnabled := True;
  1765.  
  1766.  
  1767.   FEffectList := TList.Create;
  1768.   FTimer := TTimer.Create(nil);
  1769.   FTimer.Interval := 500;
  1770.   FTimer.OnTimer := TimerEvent;
  1771. end;
  1772.  
  1773. destructor TSoundEngine.Destroy;
  1774. begin
  1775.   Clear;
  1776.   FTimer.Free;
  1777.   FEffectList.Free;
  1778.   inherited Destroy;
  1779. end;
  1780.  
  1781. procedure TSoundEngine.Clear;
  1782. var
  1783.   i: Integer;
  1784. begin
  1785.   for i:=EffectCount-1 downto 0 do
  1786.     Effects[i].Free;
  1787.   FEffectList.Clear;
  1788. end;
  1789.  
  1790. procedure TSoundEngine.EffectFile(const Filename: string; Loop, Wait: Boolean);
  1791. var
  1792.   Stream : TFileStream;
  1793. begin
  1794.   Stream :=TFileStream.Create(Filename, fmOpenRead);
  1795.   try
  1796.     EffectStream(Stream, Loop, Wait);
  1797.   finally
  1798.     Stream.Free;
  1799.   end;
  1800. end;
  1801.  
  1802. procedure TSoundEngine.EffectStream(Stream: TStream; Loop, Wait: Boolean);
  1803. var
  1804.   Wave: TWave;
  1805. begin
  1806.   Wave := TWave.Create;
  1807.   try
  1808.     Wave.LoadfromStream(Stream);
  1809.     EffectWave(Wave, Loop, Wait);
  1810.   finally
  1811.     Wave.Free;
  1812.   end;
  1813. end;
  1814.  
  1815. procedure TSoundEngine.EffectWave(Wave: TWave; Loop, Wait: Boolean);
  1816. var
  1817.   Buffer: TDirectSoundBuffer;
  1818. begin
  1819.   if not FEnabled then Exit;
  1820.  
  1821.   if Wait then
  1822.   begin
  1823.     Buffer := TDirectSoundBuffer.Create(FDSound);
  1824.     try
  1825.       Buffer.LoadFromWave(Wave);
  1826.       Buffer.Play(0);
  1827.       while Buffer.Status and DSBSTATUS_PLAYING<>0 do
  1828.         Sleep(1);
  1829.     finally
  1830.       Buffer.Free;
  1831.     end;
  1832.   end else
  1833.   begin
  1834.     Buffer := TDirectSoundBuffer.Create(FDSound);
  1835.     try
  1836.       Buffer.LoadFromWave(Wave);
  1837.       if Loop then
  1838.         Buffer.Play(DSBPLAY_LOOPING)
  1839.       else
  1840.         Buffer.Play(0);
  1841.     except
  1842.       Buffer.Free;
  1843.       raise;
  1844.     end;
  1845.     FEffectList.Add(Buffer);
  1846.   end;
  1847. end;
  1848.  
  1849. function TSoundEngine.GetEffect(Index: Integer): TDirectSoundBuffer;
  1850. begin
  1851.   Result := TDirectSoundBuffer(FEffectList[Index]);
  1852. end;
  1853.  
  1854. function TSoundEngine.GetEffectCount: Integer;
  1855. begin
  1856.   Result := FEffectList.Count;
  1857. end;
  1858.  
  1859. procedure TSoundEngine.SetEnabled(Value: Boolean);
  1860. var
  1861.   i: Integer;
  1862. begin
  1863.   for i:=EffectCount-1 downto 0 do
  1864.     Effects[i].Free;
  1865.   FEffectList.Clear;
  1866.  
  1867.   FEnabled := Value;
  1868.   FTimer.Enabled := Value;
  1869. end;
  1870.  
  1871. procedure TSoundEngine.TimerEvent(Sender: TObject);
  1872. var
  1873.   i: Integer;
  1874. begin
  1875.   for i:=EffectCount-1 downto 0 do
  1876.     if not TDirectSoundBuffer(FEffectList[i]).Playing then
  1877.     begin
  1878.       TDirectSoundBuffer(FEffectList[i]).Free;
  1879.       FEffectList.Delete(i);
  1880.     end;
  1881. end;
  1882.  
  1883. {  TCustomDXSound  }
  1884.  
  1885. type
  1886.   TDXSoundDirectSound = class(TDirectSound)
  1887.   private
  1888.     FDXSound: TCustomDXSound;
  1889.   protected
  1890.     procedure DoRestoreBuffer; override;
  1891.   end;
  1892.  
  1893. procedure TDXSoundDirectSound.DoRestoreBuffer;
  1894. begin
  1895.   inherited DoRestoreBuffer;
  1896.   FDXSound.Restore;
  1897. end;
  1898.  
  1899. constructor TCustomDXSound.Create(AOwner: TComponent);
  1900. begin
  1901.   FNotifyEventList := TList.Create;
  1902.   inherited Create(AOwner);
  1903.   FAutoInitialize := True;
  1904.   Options := [];
  1905. end;
  1906.  
  1907. destructor TCustomDXSound.Destroy;
  1908. begin
  1909.   Finalize;
  1910.   NotifyEventList(dsntDestroying);
  1911.   FNotifyEventList.Free;
  1912.   inherited Destroy;
  1913. end;
  1914.  
  1915. type
  1916.   PDXSoundNotifyEvent = ^TDXSoundNotifyEvent;
  1917.  
  1918. procedure TCustomDXSound.RegisterNotifyEvent(NotifyEvent: TDXSoundNotifyEvent);
  1919. var
  1920.   Event: PDXSoundNotifyEvent;
  1921. begin
  1922.   UnRegisterNotifyEvent(NotifyEvent);
  1923.  
  1924.   New(Event);
  1925.   Event^ := NotifyEvent;
  1926.   FNotifyEventList.Add(Event);
  1927.  
  1928.   if Initialized then
  1929.   begin
  1930.     NotifyEvent(Self, dsntInitialize);
  1931.     NotifyEvent(Self, dsntRestore);
  1932.   end;
  1933. end;
  1934.  
  1935. procedure TCustomDXSound.UnRegisterNotifyEvent(NotifyEvent: TDXSoundNotifyEvent);
  1936. var
  1937.   Event: PDXSoundNotifyEvent;
  1938.   i: Integer;
  1939. begin
  1940.   for i:=0 to FNotifyEventList.Count-1 do
  1941.   begin
  1942.     Event := FNotifyEventList[i];
  1943.     if (TMethod(Event^).Code = TMethod(NotifyEvent).Code) and
  1944.       (TMethod(Event^).Data = TMethod(NotifyEvent).Data) then
  1945.     begin
  1946.       Dispose(Event);
  1947.       FNotifyEventList.Delete(i);
  1948.  
  1949.       if Initialized then
  1950.         NotifyEvent(Self, dsntFinalize);
  1951.  
  1952.       Break;
  1953.     end;
  1954.   end;
  1955. end;
  1956.  
  1957. procedure TCustomDXSound.NotifyEventList(NotifyType: TDXSoundNotifyType);
  1958. var
  1959.   i: Integer;
  1960. begin
  1961.   for i:=FNotifyEventList.Count-1 downto 0 do
  1962.     PDXSoundNotifyEvent(FNotifyEventList[i])^(Self, NotifyType);
  1963. end;
  1964.  
  1965. procedure TCustomDXSound.FormWndProc(var Message: TMessage; DefWindowProc: TWndMethod);
  1966. begin
  1967.   case Message.Msg of
  1968.     WM_CREATE:
  1969.         begin
  1970.           DefWindowProc(Message);
  1971.           SetForm(FForm);
  1972.           Exit;
  1973.         end;
  1974.   end;
  1975.   DefWindowProc(Message);
  1976. end;
  1977.  
  1978. class function TCustomDXSound.Drivers: TDirectXDrivers;
  1979. begin
  1980.   Result := EnumDirectSoundDrivers;
  1981. end;
  1982.  
  1983. procedure TCustomDXSound.DoFinalize;
  1984. begin
  1985.   if Assigned(FOnFinalize) then FOnFinalize(Self);
  1986. end;
  1987.  
  1988. procedure TCustomDXSound.DoInitialize;
  1989. begin
  1990.   if Assigned(FOnInitialize) then FOnInitialize(Self);
  1991. end;
  1992.  
  1993. procedure TCustomDXSound.DoInitializing;
  1994. begin
  1995.   if Assigned(FOnInitializing) then FOnInitializing(Self);
  1996. end;
  1997.  
  1998. procedure TCustomDXSound.DoRestore;
  1999. begin
  2000.   if Assigned(FOnRestore) then FOnRestore(Self);
  2001. end;
  2002.  
  2003. procedure TCustomDXSound.Finalize;
  2004. begin
  2005.   if FInternalInitialized then
  2006.   begin
  2007.     try
  2008.       FSubClass.Free; FSubClass := nil;
  2009.  
  2010.       try
  2011.         if FCalledDoInitialize then
  2012.         begin
  2013.           FCalledDoInitialize := False;
  2014.           DoFinalize;
  2015.         end;
  2016.       finally
  2017.         NotifyEventList(dsntFinalize);
  2018.       end;
  2019.     finally
  2020.       FInitialized := False;
  2021.       FInternalInitialized := False;
  2022.  
  2023.       SetOptions(FOptions);
  2024.  
  2025.       FPrimary.Free; FPrimary := nil;
  2026.       FDSound.Free;  FDSound := nil;
  2027.     end;
  2028.   end;
  2029. end;
  2030.  
  2031. procedure TCustomDXSound.Initialize;
  2032. const
  2033.   PrimaryDesc: DSBUFFERDESC = (
  2034.       dwSize: SizeOf (PrimaryDesc);
  2035.       dwFlags: DSBCAPS_PRIMARYBUFFER);
  2036. var
  2037.   Component: TComponent;
  2038. begin
  2039.   Finalize;
  2040.  
  2041.   Component := Owner;
  2042.   while (Component<>nil) and (not (Component is TCustomForm)) do
  2043.     Component := Component.Owner;
  2044.   if Component=nil then
  2045.     raise EDXSoundError.Create(SNoForm);
  2046.  
  2047.   NotifyEventList(dsntInitializing);
  2048.   DoInitializing;
  2049.  
  2050.   FInternalInitialized := True;
  2051.   try
  2052.     {  DirectSound initialization.  }
  2053.     FDSound := TDXSoundDirectSound.Create(Driver);
  2054.     TDXSoundDirectSound(FDSound).FDXSound := Self;
  2055.  
  2056.     FDSound.GlobalFocus := soGlobalFocus in FNowOptions;
  2057.  
  2058.     {  Primary buffer made.  }
  2059.     FPrimary := TDirectSoundBuffer.Create(FDSound);
  2060.     if not FPrimary.CreateBuffer(PrimaryDesc) then
  2061.       raise EDXSoundError.CreateFmt(SCannotMade, [SDirectSoundPrimaryBuffer]);
  2062.  
  2063.     FInitialized := True;
  2064.  
  2065.     SetForm(TCustomForm(Component));
  2066.   except
  2067.     Finalize;
  2068.     raise;
  2069.   end;
  2070.  
  2071.   NotifyEventList(dsntInitialize);
  2072.  
  2073.   FCalledDoInitialize := True; DoInitialize;
  2074.  
  2075.   Restore;
  2076. end;
  2077.  
  2078. procedure TCustomDXSound.Loaded;
  2079. begin
  2080.   inherited Loaded;
  2081.  
  2082.   if FAutoInitialize and (not (csDesigning in ComponentState)) then
  2083.   begin
  2084.     try
  2085.       Initialize;
  2086.     except
  2087.     end;
  2088.   end;
  2089. end;
  2090.  
  2091. procedure TCustomDXSound.Restore;
  2092. begin
  2093.   if FInitialized then
  2094.   begin
  2095.     NotifyEventList(dsntRestore);
  2096.     DoRestore;
  2097.   end;
  2098. end;
  2099.  
  2100. procedure TCustomDXSound.SetDriver(Value: PGUID);
  2101. begin
  2102.   if not IsBadHugeReadPtr(Value, SizeOf(TGUID)) then
  2103.   begin
  2104.     FDriverGUID := Value^;
  2105.     FDriver := @FDriverGUID;
  2106.   end else
  2107.     FDriver := Value;
  2108. end;
  2109.  
  2110. procedure TCustomDXSound.SetForm(Value: TCustomForm);
  2111. var
  2112.   Level: Integer;
  2113. begin
  2114.   FForm := Value;
  2115.  
  2116.   FSubClass.Free;
  2117.   FSubClass := TControlSubClass.Create(FForm, FormWndProc);
  2118.  
  2119.   if FInitialized then
  2120.   begin
  2121.     if soWritePrimary in FNowOptions then
  2122.       Level := DSSCL_WRITEPRIMARY
  2123.     else if soExclusive in FNowOptions then
  2124.       Level := DSSCL_EXCLUSIVE
  2125.     else
  2126.       Level := DSSCL_NORMAL;
  2127.  
  2128.     FDSound.DXResult := FDSound.ISound.SetCooperativeLevel(FForm.Handle, Level);
  2129.   end;
  2130. end;
  2131.  
  2132. procedure TCustomDXSound.SetOptions(Value: TDXSoundOptions);
  2133. const
  2134.   DXSoundOptions = [soGlobalFocus, soStickyFocus, soExclusive, soWritePrimary];
  2135.   InitOptions: TDXSoundOptions = [soExclusive, soWritePrimary];
  2136. var
  2137.   OldOptions: TDXSoundOptions;
  2138. begin
  2139.   FOptions := Value;
  2140.  
  2141.   if Initialized then
  2142.   begin
  2143.     OldOptions := FNowOptions;
  2144.  
  2145.     FNowOptions := (FNowOptions - (DXSoundOptions - InitOptions)) +
  2146.       (Value - InitOptions);
  2147.  
  2148.     FDSound.GlobalFocus := soGlobalFocus in FNowOptions;
  2149.     FDSound.StickyFocus := soStickyFocus in FNowOptions;
  2150.   end else
  2151.     FNowOptions := FOptions;
  2152. end;
  2153.  
  2154. {  TWaveCollectionItem  }
  2155.  
  2156. constructor TWaveCollectionItem.Create(Collection: TCollection);
  2157. begin
  2158.   inherited Create(Collection);
  2159.   FWave := TWave.Create;
  2160. end;
  2161.  
  2162. destructor TWaveCollectionItem.Destroy;
  2163. begin
  2164.   Finalize;
  2165.   FWave.Free;
  2166.   inherited Destroy;
  2167. end;
  2168.  
  2169. function TWaveCollectionItem.GetBuffer: TDirectSoundBuffer;
  2170. begin
  2171.   if (WaveCollection.DXSound.Initialized) and (FBuffer=nil) then
  2172.     Restore;
  2173.   Result := FBuffer;
  2174. end;
  2175.  
  2176. function TWaveCollectionItem.GetWaveCollection: TWaveCollection;
  2177. begin
  2178.   Result := Collection as TWaveCollection;
  2179. end;
  2180.  
  2181. procedure TWaveCollectionItem.Finalize;
  2182. begin
  2183.   if FInitialized then
  2184.   begin
  2185.     FInitialized := False;
  2186.     FBuffer.Free; FBuffer := nil;
  2187.   end;
  2188. end;
  2189.  
  2190. procedure TWaveCollectionItem.Initialize;
  2191. begin
  2192.   Finalize;
  2193.   if not WaveCollection.Initialized then
  2194.     raise EWaveCollectionError.CreateFmt(SCannotInitialized, [ClassName]);
  2195.   FInitialized := True;
  2196.   FBuffer := TDirectSoundBuffer.Create(WaveCollection.DXSound.DSound);
  2197. end;
  2198.  
  2199. function TWaveCollectionItem.CreateBuffer: TDirectSoundBuffer;
  2200. begin
  2201.   if Buffer=nil then
  2202.     raise EWaveCollectionError.CreateFmt(SCannotInitialized, [ClassName]);
  2203.  
  2204.   Result := TDirectSoundBuffer.Create(WaveCollection.DXSound.DSound);
  2205.   try
  2206.     if Buffer.Status and DSBSTATUS_BUFFERLOST<>0 then
  2207.       Restore;
  2208.  
  2209.     Result.Assign(Buffer);
  2210.   except
  2211.     Result.Free;
  2212.     raise;
  2213.   end;
  2214. end;
  2215.  
  2216. procedure TWaveCollectionItem.Play(Wait: Boolean);
  2217. var
  2218.   NewBuffer: TDirectSoundBuffer;
  2219. begin
  2220.   if WaveCollection.Initialized then
  2221.   begin
  2222.     if FLooped then
  2223.     begin
  2224.       Buffer.Play(DSBPLAY_LOOPING);
  2225.     end else
  2226.     begin
  2227.       NewBuffer := CreateBuffer;
  2228.       try
  2229.         NewBuffer.Play(0);
  2230.       except
  2231.         NewBuffer.Free;
  2232.         raise;
  2233.       end;
  2234.       if Wait then
  2235.       begin
  2236.         try
  2237.           while NewBuffer.Playing do
  2238.             Sleep(10);
  2239.         finally
  2240.           NewBuffer.Free;
  2241.         end;
  2242.       end else
  2243.         WaveCollection.AddBuffer(NewBuffer);
  2244.     end;
  2245.   end;
  2246. end;
  2247.  
  2248. procedure TWaveCollectionItem.Restore;
  2249. begin
  2250.   if WaveCollection.Initialized then
  2251.   begin
  2252.     if not FInitialized then
  2253.       Initialize;
  2254.     if FInitialized then
  2255.     begin
  2256.       FBuffer.LoadFromWave(FWave);
  2257.  
  2258.       FBuffer.Frequency := FFrequency;
  2259.       FBuffer.Pan := FPan;
  2260.       FBuffer.Volume := FVolume;
  2261.     end;
  2262.   end;
  2263. end;
  2264.  
  2265. procedure TWaveCollectionItem.Stop;
  2266. begin
  2267.   if FInitialized then
  2268.     FBuffer.Stop;
  2269. end;
  2270.  
  2271. procedure TWaveCollectionItem.SetFrequency(Value: Integer);
  2272. begin
  2273.   FFrequency := Value;
  2274.   if FInitialized then
  2275.     Buffer.Frequency := Value;
  2276. end;
  2277.  
  2278. procedure TWaveCollectionItem.SetLooped(Value: Boolean);
  2279. begin
  2280.   if FLooped<>Value then
  2281.   begin
  2282.     Stop;
  2283.     FLooped := Value;
  2284.   end;
  2285. end;
  2286.  
  2287. procedure TWaveCollectionItem.SetPan(Value: Integer);
  2288. begin
  2289.   FPan := Value;
  2290.   if FInitialized then
  2291.     Buffer.Pan := Value;
  2292. end;
  2293.  
  2294. procedure TWaveCollectionItem.SetVolume(Value: Integer);
  2295. begin
  2296.   FVolume := Value;
  2297.   if FInitialized then
  2298.     Buffer.Volume := Value;
  2299. end;
  2300.  
  2301. procedure TWaveCollectionItem.SetWave(Value: TWave);
  2302. begin
  2303.   FWave.Assign(Value);
  2304. end;
  2305.  
  2306. {  TWaveCollection  }
  2307.  
  2308. constructor TWaveCollection.Create(AOwner: TPersistent);
  2309. begin
  2310.   inherited Create(TWaveCollectionItem);
  2311.   FOwner := AOwner;
  2312.   FBufferList := TList.Create;
  2313. end;
  2314.  
  2315. destructor TWaveCollection.Destroy;
  2316. begin
  2317.   ClearBuffers;
  2318.   FBufferList.Free;
  2319.   inherited Destroy;
  2320. end;
  2321.  
  2322. function TWaveCollection.GetItem(Index: Integer): TWaveCollectionItem;
  2323. begin
  2324.   Result := TWaveCollectionItem(inherited Items[Index]);
  2325. end;
  2326.  
  2327. function TWaveCollection.GetOwner: TPersistent;
  2328. begin
  2329.   Result := FOwner;
  2330. end;
  2331.  
  2332. function TWaveCollection.Find(const Name: string): TWaveCollectionItem;
  2333. var
  2334.   i: Integer;
  2335. begin
  2336.   i := IndexOf(Name);
  2337.   if i=-1 then
  2338.     raise EWaveCollectionError.CreateFmt(SWaveNotFound, [Name]);
  2339.   Result := Items[i];
  2340. end;
  2341.  
  2342. procedure TWaveCollection.Finalize;
  2343. var
  2344.   i: Integer;
  2345. begin
  2346.   FTimer.Free; FTimer := nil;
  2347.   ClearBuffers;
  2348.   for i:=0 to Count-1 do
  2349.     Items[i].Finalize;
  2350.   FDXSound := nil;
  2351. end;
  2352.  
  2353. procedure TWaveCollection.Initialize(DXSound: TCustomDXSound);
  2354. var
  2355.   i: Integer;
  2356. begin
  2357.   Finalize;
  2358.   FDXSound := DXSound;
  2359.   for i:=0 to Count-1 do
  2360.     Items[i].Initialize;
  2361.  
  2362.   FTimer := TTimer.Create(nil);
  2363.   FTimer.Enabled := True;
  2364.   FTimer.Interval := 500;
  2365.   FTimer.OnTimer := TimerEvent;
  2366. end;
  2367.  
  2368. function TWaveCollection.Initialized: Boolean;
  2369. begin
  2370.   Result := (FDXSound<>nil) and (FDXSound.Initialized);
  2371. end;
  2372.  
  2373. procedure TWaveCollection.Restore;
  2374. var
  2375.   i: Integer;
  2376. begin
  2377.   for i:=0 to Count-1 do
  2378.     Items[i].Restore;
  2379. end;
  2380.  
  2381. procedure TWaveCollection.AddBuffer(Buffer: TDirectSoundBuffer);
  2382. begin
  2383.   FBufferList.Add(Buffer);
  2384. end;
  2385.  
  2386. procedure TWaveCollection.ClearBuffers;
  2387. var
  2388.   i: Integer;
  2389. begin
  2390.   for i:=0 to BufferCount-1 do
  2391.     Buffers[i].Free;
  2392.   FBufferList.Clear;
  2393. end;
  2394.  
  2395. function TWaveCollection.GetBuffer(Index: Integer): TDirectSoundBuffer;
  2396. begin
  2397.   Result := FBufferList[Index];
  2398. end;
  2399.  
  2400. function TWaveCollection.GetBufferCount: Integer;
  2401. begin
  2402.   Result := FBufferList.Count;
  2403. end;
  2404.  
  2405. type
  2406.   TWaveCollectionComponent = class(TComponent)
  2407.   private
  2408.     FList: TWaveCollection;
  2409.   published
  2410.     property List: TWaveCollection read FList write FList;
  2411.   end;
  2412.  
  2413. procedure TWaveCollection.LoadFromFile(const FileName: string);
  2414. var
  2415.   Stream: TFileStream;
  2416. begin
  2417.   Stream := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
  2418.   try
  2419.     LoadFromStream(Stream);
  2420.   finally
  2421.     Stream.Free;
  2422.   end;
  2423. end;
  2424.  
  2425. procedure TWaveCollection.LoadFromStream(Stream: TStream);
  2426. var
  2427.   Component: TWaveCollectionComponent;
  2428. begin
  2429.   Clear;
  2430.   Component := TWaveCollectionComponent.Create(nil);
  2431.   try
  2432.     Component.FList := Self;
  2433.     Stream.ReadComponentRes(Component);
  2434.  
  2435.     if Initialized then
  2436.     begin
  2437.       Initialize(FDXSound);
  2438.       Restore;
  2439.     end;
  2440.   finally
  2441.     Component.Free;
  2442.   end;
  2443. end;
  2444.  
  2445. procedure TWaveCollection.SaveToFile(const FileName: string);
  2446. var
  2447.   Stream: TFileStream;
  2448. begin
  2449.   Stream := TFileStream.Create(FileName, fmCreate);
  2450.   try
  2451.     SaveToStream(Stream);
  2452.   finally
  2453.     Stream.Free;
  2454.   end;
  2455. end;
  2456.  
  2457. procedure TWaveCollection.SaveToStream(Stream: TStream);
  2458. var
  2459.   Component: TWaveCollectionComponent;
  2460. begin
  2461.   Component := TWaveCollectionComponent.Create(nil);
  2462.   try
  2463.     Component.FList := Self;
  2464.     Stream.WriteComponentRes('DelphiXWaveCollection', Component);
  2465.   finally
  2466.     Component.Free;
  2467.   end;
  2468. end;
  2469.  
  2470. procedure TWaveCollection.TimerEvent(Sender: TObject);
  2471. var
  2472.   i: Integer;
  2473. begin
  2474.   for i:=BufferCount-1 downto 0 do
  2475.     if not Buffers[i].Playing then
  2476.     begin
  2477.       Buffers[i].Free;
  2478.       FBufferList.Delete(i);
  2479.     end;
  2480. end;
  2481.  
  2482. {  TCustomDXWaveList  }
  2483.  
  2484. constructor TCustomDXWaveList.Create(AOwner: TComponent);
  2485. begin
  2486.   inherited Create(AOwner);
  2487.   FItems := TWaveCollection.Create(Self);
  2488. end;
  2489.  
  2490. destructor TCustomDXWaveList.Destroy;
  2491. begin
  2492.   DXSound := nil;
  2493.   FItems.Free;
  2494.   inherited Destroy;
  2495. end;
  2496.  
  2497. procedure TCustomDXWaveList.Notification(AComponent: TComponent; Operation: TOperation);
  2498. begin
  2499.   inherited Notification(AComponent, Operation);
  2500.   if (Operation=opRemove) and (DXSound=AComponent) then
  2501.     DXSound := nil;
  2502. end;
  2503.  
  2504. procedure TCustomDXWaveList.DXSoundNotifyEvent(Sender: TCustomDXSound;
  2505.   NotifyType: TDXSoundNotifyType);
  2506. begin
  2507.   case NotifyType of
  2508.     dsntDestroying: DXSound := nil;
  2509.     dsntInitialize: FItems.Initialize(Sender);
  2510.     dsntFinalize  : FItems.Finalize;
  2511.     dsntRestore   : FItems.Restore;
  2512.   end;
  2513. end;
  2514.  
  2515. procedure TCustomDXWaveList.SetDXSound(Value: TCustomDXSound);
  2516. begin
  2517.   if FDXSound<>nil then
  2518.     FDXSound.UnRegisterNotifyEvent(DXSoundNotifyEvent);
  2519.  
  2520.   FDXSound := Value;
  2521.  
  2522.   if FDXSound<>nil then
  2523.     FDXSound.RegisterNotifyEvent(DXSoundNotifyEvent);
  2524. end;
  2525.  
  2526. procedure TCustomDXWaveList.SetItems(Value: TWaveCollection);
  2527. begin
  2528.   FItems.Assign(Value);
  2529. end;
  2530.  
  2531. initialization
  2532. finalization
  2533.   DirectSoundDrivers.Free;
  2534.   DirectSoundCaptureDrivers.Free;
  2535. end.
  2536.