Subversion Repositories spacemission

Rev

Rev 1 | Blame | Compare with Previous | Last modification | View Log | RSS feed

  1. unit DXSounds;
  2.  
  3. interface
  4.  
  5. {$INCLUDE DelphiXcfg.inc}
  6.  
  7. uses
  8.   Windows, Messages, SysUtils, Classes, Controls, Forms, ExtCtrls, MMSystem, ActiveX,
  9.   DXClass, DXWave, D3DUtils, {$IFDEF VER17UP} Types, {$ENDIF}
  10. {$IFDEF StandardDX}
  11.   DirectSound, DirectMusic;
  12. {$ELSE}
  13.   DirectX;
  14. {$ENDIF}
  15.  
  16. type
  17.  
  18.   {  EDirectSoundError  }
  19.  
  20.   EDirectSoundError = class(EDirectXError);
  21.   EDirectSoundBufferError = class(EDirectSoundError);
  22.  
  23.   {  TDirectSound  }
  24.  
  25.   TDirectSoundBuffer = class;
  26.  
  27.   TDirectSound = class(TDirectX)
  28.   private
  29.     FBufferList: TList;
  30.     FGlobalFocus: Boolean;
  31.     FIDSound: IDirectSound;
  32.     FInRestoreBuffer: Boolean;
  33.     FStickyFocus: Boolean;
  34.     function GetBuffer(Index: Integer): TDirectSoundBuffer;
  35.     function GetBufferCount: Integer;
  36.     function GetIDSound: IDirectSound;
  37.     function GetISound: IDirectSound;
  38.   protected
  39.     procedure CheckBuffer(Buffer: TDirectSoundBuffer);
  40.     procedure DoRestoreBuffer; virtual;
  41.   public
  42.     constructor Create(GUID: PGUID);
  43.     destructor Destroy; override;
  44.     class function Drivers: TDirectXDrivers;
  45.     property BufferCount: Integer read GetBufferCount;
  46.     property Buffers[Index: Integer]: TDirectSoundBuffer read GetBuffer;
  47.     property IDSound: IDirectSound read GetIDSound;
  48.     property ISound: IDirectSound read GetISound;
  49.   end;
  50.  
  51.   {  TD3DSParams  }
  52.  
  53.   TConeAngle = record
  54.     Inside,Outside:DWord;
  55.   end;
  56.   TD3DSParams = class
  57.   private
  58.     FOwner: TDirectSoundBuffer;
  59.  
  60.     FDsb: TDS3DBUFFER;
  61.  
  62.     function GetPosition: TD3DVector;
  63.     function GetVelocity: TD3DVector;
  64.     function GetConeOrientation: TD3DVector;
  65.     function GetConeAngle: TConeAngle;
  66.     function GetConeOutsideVolume: Integer;
  67.     function GetMinDistance: TD3DValue;
  68.     function GetMaxDistance: TD3DValue;
  69.     function GetRaw: TDS3DBuffer;
  70.  
  71.     procedure SetPosition(const v: TD3DVector);
  72.     procedure SetVelocity(const v: TD3DVector);
  73.     procedure SetConeOrientation(const v: TD3DVector);
  74.     procedure SetConeAngle(const v: TConeAngle);
  75.     procedure SetConeOutsideVolume(const v: Integer);
  76.     procedure SetMinDistance(const v: TD3DValue);
  77.     procedure SetMaxDistance(const v: TD3DValue);
  78.     procedure SetRaw(const v: TDS3DBuffer);
  79.  
  80.     function CheckValidity: Boolean;
  81.   public
  82.     constructor Create(Owner: TDirectSoundBuffer);
  83.     destructor Destroy; override;
  84.     property Position: TD3DVector read getPosition write setPosition;
  85.     property Velocity: TD3DVector read getVelocity write setVelocity;
  86.     property ConeOrientation: TD3DVector read getConeOrientation write setConeOrientation;
  87.     property ConeAngle: TConeAngle read getConeAngle write setConeAngle;
  88.     property ConeOutsideVolume: Integer read getConeOutsideVolume write setConeOutsideVolume;
  89.     property MinDistance: TD3DValue read getMinDistance write setMinDistance;
  90.     property MaxDistance: TD3DValue read getMaxDistance write setMaxDistance;
  91.     property RawParams: TDS3DBuffer read getRaw write setRaw;
  92.     procedure Assign(Prms: TD3DSParams);
  93.   end;
  94.  
  95.   {  TDirectSoundBuffer  }
  96.  
  97.   TDirectSoundBuffer = class(TDirectX)
  98.   private
  99.     FDSound: TDirectSound;
  100.     FIDSBuffer: IDirectSoundBuffer;
  101.     FIDS3DBuffer:IDirectSound3DBuffer;
  102.     FD3DSParams: TD3DSParams;
  103.     FCaps: TDSBCaps;
  104.     FFormat: PWaveFormatEx;
  105.     FFormatSize: Integer;
  106.     FLockAudioPtr1, FLockAudioPtr2: array[0..0] of Pointer;
  107.     FLockAudioSize1, FLockAudioSize2: array[0..0] of DWORD;
  108.     FLockCount: Integer;
  109.     FIsD3D: Boolean;
  110.     function GetBitCount: Longint;
  111.     function GetFormat: PWaveFormatEx;
  112.     function GetFrequency: Integer;
  113.     function GetIDSBuffer: IDirectSoundBuffer;
  114.     function GetIBuffer: IDirectSoundBuffer;
  115.     function GetPlaying: Boolean;
  116.     function GetPan: Integer;
  117.     function GetPosition: Longint;
  118.     function GetSize: Integer;
  119.     function GetStatus: Integer;
  120.     function GetVolume: Integer;
  121.     procedure SetFrequency(Value: Integer);
  122.     procedure SetIDSBuffer(Value: IDirectSoundBuffer);
  123.     procedure SetPan(Value: Integer);
  124.     procedure SetPosition(Value: Longint);
  125.     procedure SetVolume(Value: Integer);
  126.     function GetIDS3DBuffer: IDirectSound3DBuffer;
  127.     procedure SetIDS3DBuffer(const Value: IDirectSound3DBuffer);
  128.     procedure SetD3DSParams(const Value: TD3DSParams);
  129.   protected
  130.     procedure Check; override;
  131.   public
  132.     constructor Create(ADirectSound: TDirectSound);
  133.     destructor Destroy; override;
  134.     procedure Assign(Source: TPersistent); override;
  135.     function CreateBuffer(const BufferDesc: TDSBufferDesc): Boolean;
  136.     procedure LoadFromFile(const FileName: string);
  137.     procedure LoadFromMemory(const Format: TWaveFormatEx;
  138.       Data: Pointer; Size: Integer);
  139.     procedure LoadFromStream(Stream: TStream);
  140.     procedure LoadFromWave(Wave: TWave);
  141.     function Lock(LockPosition, LockSize: Longint;
  142.       var AudioPtr1: Pointer; var AudioSize1: Longint;
  143.       var AudioPtr2: Pointer; var AudioSize2: Longint): Boolean;
  144.     function Play(Loop: Boolean{$IFNDEF VER100} = False{$ENDIF}): Boolean;
  145.     function Restore: Boolean;
  146.     function SetFormat(const Format: TWaveFormatEx): Boolean;
  147.     procedure SetSize(const Format: TWaveFormatEx; Size: Integer; D3D: Boolean {$IFNDEF VER100}= False{$ENDIF});
  148.     procedure Stop;
  149.     procedure UnLock;
  150.     property BitCount: Longint read GetBitCount;
  151.     property DSound: TDirectSound read FDSound;
  152.     property Format: PWaveFormatEx read GetFormat;
  153.     property FormatSize: Integer read FFormatSize;
  154.     property Frequency: Integer read GetFrequency write SetFrequency;
  155.     property IBuffer: IDirectSoundBuffer read GetIBuffer;
  156.     property IDSBuffer: IDirectSoundBuffer read GetIDSBuffer write SetIDSBuffer;
  157.     property IDS3DBuffer: IDirectSound3DBuffer read GetIDS3DBuffer write SetIDS3DBuffer;
  158.     property Playing: Boolean read GetPlaying;
  159.     property Pan: Integer read GetPan write SetPan;
  160.     property D3DSParams: TD3DSParams read FD3DSParams write SetD3DSParams;
  161.     property IsD3D: Boolean read FIsD3D write FIsD3D default False;
  162.     property Position: Longint read GetPosition write SetPosition;
  163.     property Size: Integer read GetSize;
  164.     property Volume: Integer read GetVolume write SetVolume;
  165.   end;
  166.  
  167.   {  EAudioStreamError  }
  168.  
  169.   EAudioStreamError = class(Exception);
  170.  
  171.   {  TAudioStream  }
  172.  
  173.   TAudioStream = class
  174.   private
  175.     FAutoUpdate: Boolean;
  176.     FBuffer: TDirectSoundBuffer;
  177.     FBufferLength: Integer;
  178.     FBufferPos: DWORD;
  179.     FPlayBufferPos: DWORD;
  180.     FBufferSize: DWORD;
  181.     FDSound: TDirectSound;
  182.     FLooped: Boolean;
  183.     FPlayedSize: Integer;
  184.     FPlaying: Boolean;
  185.     FPosition: Integer;
  186.     FWaveStream: TCustomWaveStream;
  187.     FWritePosition: Integer;
  188.     FNotifyEvent: THandle;
  189.     FNotifyThread: TThread;
  190.     function GetFormat: PWaveFormatEX;
  191.     function GetFormatSize: Integer;
  192.     function GetFrequency: Integer;
  193.     function GetPan: Integer;
  194.     function GetPlayedSize: Integer;
  195.     function GetSize: Integer;
  196.     function GetVolume: Integer;
  197.     function GetWriteSize: Integer;
  198.     procedure SetAutoUpdate(Value: Boolean);
  199.     procedure SetBufferLength(Value: Integer);
  200.     procedure SetFrequency(Value: Integer);
  201.     procedure SetLooped(Value: Boolean);
  202.     procedure SetPan(Value: Integer);
  203.     procedure SetPlayedSize(Value: Integer);
  204.     procedure SetPosition(Value: Integer);
  205.     procedure SetVolume(Value: Integer);
  206.     procedure SetWaveStream(Value: TCustomWaveStream);
  207.     procedure Update2(InThread: Boolean);
  208.     procedure UpdatePlayedSize;
  209.     function WriteWave(WriteSize: Integer): Integer;
  210.   public
  211.     constructor Create(ADirectSound: TDirectSound);
  212.     destructor Destroy; override;
  213.     procedure Play;
  214.     procedure RecreateBuf;
  215.     procedure Stop;
  216.     procedure Update;
  217.     property AutoUpdate: Boolean read FAutoUpdate write SetAutoUpdate;
  218.     property BufferLength: Integer read FBufferLength write SetBufferLength;
  219.     property Format: PWaveFormatEx read GetFormat;
  220.     property FormatSize: Integer read GetFormatSize;
  221.     property Frequency: Integer read GetFrequency write SetFrequency;
  222.     property Pan: Integer read GetPan write SetPan;
  223.     property PlayedSize: Integer read GetPlayedSize write SetPlayedSize;
  224.     property Playing: Boolean read FPlaying;
  225.     property Position: Integer read FPosition write SetPosition;
  226.     property Looped: Boolean read FLooped write SetLooped;
  227.     property Size: Integer read GetSize;
  228.     property Volume: Integer read GetVolume write SetVolume;
  229.     property WaveStream: TCustomWaveStream read FWaveStream write SetWaveStream;
  230.   end;
  231.  
  232.   {  TAudioFileStream  }
  233.  
  234.   TAudioFileStream = class(TAudioStream)
  235.   private
  236.     FFileName: string;
  237.     FWaveFileStream: TWaveFileStream;
  238.     procedure SetFileName(const Value: string);
  239.   public
  240.     destructor Destroy; override;
  241.     property FileName: string read FFileName write SetFileName;
  242.   end;
  243.  
  244.   {  TSoundCaptureFormat  }
  245.  
  246.   TSoundCaptureFormat = class(TCollectionItem)
  247.   private
  248.     FBitsPerSample: Integer;
  249.     FChannels: Integer;
  250.     FSamplesPerSec: Integer;
  251.   public
  252.     property BitsPerSample: Integer read FBitsPerSample;
  253.     property Channels: Integer read FChannels;
  254.     property SamplesPerSec: Integer read FSamplesPerSec;
  255.   end;
  256.  
  257.   {  TSoundCaptureFormats  }
  258.  
  259.   TSoundCaptureFormats = class(TCollection)
  260.   private
  261.     function GetItem(Index: Integer): TSoundCaptureFormat;
  262.   public
  263.     constructor Create;
  264.     function IndexOf(ASamplesPerSec, ABitsPerSample, AChannels: Integer): Integer;
  265.     property Items[Index: Integer]: TSoundCaptureFormat read GetItem; default;
  266.   end;
  267.  
  268.   {  TSoundCaptureStream  }
  269.  
  270.   ESoundCaptureStreamError = class(EWaveStreamError);
  271.  
  272.   TSoundCaptureStream = class(TCustomWaveStream2)
  273.   private
  274.     FBuffer: IDirectSoundCaptureBuffer;
  275.     FBufferLength: Integer;
  276.     FBufferPos: DWORD;
  277.     FBufferSize: DWORD;
  278.     FCapture: IDirectSoundCapture;
  279.     FCaptureFormat: Integer;
  280.     FCapturing: Boolean;
  281.     FNotifyEvent: THandle;
  282.     FNotifyThread: TThread;
  283.     FOnFilledBuffer: TNotifyEvent;
  284.     FSupportedFormats: TSoundCaptureFormats;
  285.     function GetReadSize: Integer;
  286.     procedure SetBufferLength(Value: Integer);
  287.     procedure SetOnFilledBuffer(Value: TNotifyEvent);
  288.   protected
  289.     procedure DoFilledBuffer; virtual;
  290.     function GetFilledSize: Integer; override;
  291.     function ReadWave(var Buffer; Count: Integer): Integer; override;
  292.   public
  293.     constructor Create(GUID: PGUID);
  294.     destructor Destroy; override;
  295.     class function Drivers: TDirectXDrivers;
  296.     procedure Start;
  297.     procedure Stop;
  298.     property BufferLength: Integer read FBufferLength write SetBufferLength;
  299.     property CaptureFormat: Integer read FCaptureFormat write FCaptureFormat;
  300.     property Capturing: Boolean read FCapturing;
  301.     property OnFilledBuffer: TNotifyEvent read FOnFilledBuffer write SetOnFilledBuffer;
  302.     property SupportedFormats: TSoundCaptureFormats read FSupportedFormats;
  303.   end;
  304.  
  305.   {  TSoundEngine  }
  306.  
  307.   TSoundEngine = class
  308.   private
  309.     FDSound: TDirectSound;
  310.     FEffectList: TList;
  311.     FEnabled: Boolean;
  312.     FTimer: TTimer;
  313.     function GetEffect(Index: Integer): TDirectSoundBuffer;
  314.     function GetEffectCount: Integer;
  315.     procedure SetEnabled(Value: Boolean);
  316.     procedure TimerEvent(Sender: TObject);
  317.   public
  318.     constructor Create(ADSound: TDirectSound);
  319.     destructor Destroy; override;
  320.     procedure Clear;
  321.     procedure EffectFile(const Filename: string; Loop, Wait: Boolean);
  322.     procedure EffectStream(Stream: TStream; Loop, Wait: Boolean);
  323.     procedure EffectWave(Wave: TWave; Loop, Wait: Boolean);
  324.     property EffectCount: Integer read GetEffectCount;
  325.     property Effects[Index: Integer]: TDirectSoundBuffer read GetEffect;
  326.     property Enabled: Boolean read FEnabled write SetEnabled;
  327.   end;
  328.  
  329.   {  EDXSoundError  }
  330.  
  331.   EDXSoundError = class(Exception);
  332.  
  333.   {  TCustomDXSound  }
  334.  
  335.   TCustomDXSound = class;
  336.  
  337.   TDXSoundOption = (soGlobalFocus, soStickyFocus, soExclusive);
  338.   TDXSoundOptions = set of TDXSoundOption;
  339.  
  340.   TDXSoundNotifyType = (dsntDestroying, dsntInitializing, dsntInitialize, dsntFinalize, dsntRestore);
  341.   TDXSoundNotifyEvent = procedure(Sender: TCustomDXSound; NotifyType: TDXSoundNotifyType) of object;
  342.  
  343.   TCustomDXSound = class(TComponent)
  344.   private
  345.     FAutoInitialize: Boolean;
  346.     FCalledDoInitialize: Boolean;
  347.     FDriver: PGUID;
  348.     FDriverGUID: TGUID;
  349.     FDSound: TDirectSound;
  350.     FForm: TCustomForm;
  351.     FInitialized: Boolean;
  352.     FInternalInitialized: Boolean;
  353.     FNotifyEventList: TList;
  354.     FNowOptions: TDXSoundOptions;
  355.     FOnFinalize: TNotifyEvent;
  356.     FOnInitialize: TNotifyEvent;
  357.     FOnInitializing: TNotifyEvent;
  358.     FOnRestore: TNotifyEvent;
  359.     FOptions: TDXSoundOptions;
  360.     FPrimary: TDirectSoundBuffer;
  361.     FSubClass: TControlSubClass;
  362.     procedure FormWndProc(var Message: TMessage; DefWindowProc: TWndMethod);
  363.     procedure NotifyEventList(NotifyType: TDXSoundNotifyType);
  364.     procedure SetDriver(Value: PGUID);
  365.     procedure SetForm(Value: TCustomForm);
  366.     procedure SetOptions(Value: TDXSoundOptions);
  367.   protected
  368.     procedure DoFinalize; virtual;
  369.     procedure DoInitialize; virtual;
  370.     procedure DoInitializing; virtual;
  371.     procedure DoRestore; virtual;
  372.     procedure Loaded; override;
  373.   public
  374.     constructor Create(AOwner: TComponent); override;
  375.     destructor Destroy; override;
  376.     class function Drivers: TDirectXDrivers;
  377.     procedure Finalize;
  378.     procedure Initialize;
  379.     procedure Restore;
  380.     procedure RegisterNotifyEvent(NotifyEvent: TDXSoundNotifyEvent);
  381.     procedure UnRegisterNotifyEvent(NotifyEvent: TDXSoundNotifyEvent);
  382.  
  383.     property AutoInitialize: Boolean read FAutoInitialize write FAutoInitialize;
  384.     property Driver: PGUID read FDriver write SetDriver;
  385.     property DSound: TDirectSound read FDSound;
  386.     property Initialized: Boolean read FInitialized;
  387.     property NowOptions: TDXSoundOptions read FNowOptions;
  388.     property Primary: TDirectSoundBuffer read FPrimary;
  389.     property OnFinalize: TNotifyEvent read FOnFinalize write FOnFinalize;
  390.     property OnInitialize: TNotifyEvent read FOnInitialize write FOnInitialize;
  391.     property OnInitializing: TNotifyEvent read FOnInitializing write FOnInitializing;
  392.     property OnRestore: TNotifyEvent read FOnRestore write FOnRestore;
  393.     property Options: TDXSoundOptions read FOptions write SetOptions;
  394.   end;
  395.  
  396.   {  TDXSound  }
  397.  
  398.   TDXSound = class(TCustomDXSound)
  399.   published
  400.     property AutoInitialize;
  401.     property Options;
  402.     property OnFinalize;
  403.     property OnInitialize;
  404.     property OnInitializing;
  405.     property OnRestore;
  406.   end;
  407.  
  408.   {  EWaveCollectionError  }
  409.  
  410.   EWaveCollectionError = class(Exception);
  411.  
  412.   {  TWaveCollectionItem  }
  413.  
  414.   TWaveCollection = class;
  415.  
  416.   TWaveCollectionItem = class(THashCollectionItem)
  417.   private
  418.     FBuffer: TDirectSoundBuffer;
  419.     FBufferList: TList;
  420.     FFrequency: Integer;
  421.     FInitialized: Boolean;
  422.     FLooped: Boolean;
  423.     FMaxPlayingCount: Integer;
  424.     FPan: Integer;
  425.     FVolume: Integer;
  426.     FWave: TWave;
  427.     function CreateBuffer: TDirectSoundBuffer;
  428.     procedure Finalize;
  429.     procedure Initialize;
  430.     function GetBuffer: TDirectSoundBuffer;
  431.     function GetWaveCollection: TWaveCollection;
  432.     procedure SetFrequency(Value: Integer);
  433.     procedure SetLooped(Value: Boolean);
  434.     procedure SetMaxPlayingCount(Value: Integer);
  435.     procedure SetPan(Value: Integer);
  436.     procedure SetVolume(Value: Integer);
  437.     procedure SetWave(Value: TWave);
  438.   protected
  439.     function GetPlaying: boolean;
  440.   public
  441.     constructor Create(Collection: TCollection); override;
  442.     destructor Destroy; override;
  443.     procedure Assign(Source: TPersistent); override;
  444.     procedure Play(Wait: Boolean);
  445.     procedure Restore;
  446.     procedure Stop;
  447.     property Frequency: Integer read FFrequency write SetFrequency;
  448.     property Initialized: Boolean read FInitialized;
  449.     property Pan: Integer read FPan write SetPan;
  450.     property Volume: Integer read FVolume write SetVolume;
  451.     property WaveCollection: TWaveCollection read GetWaveCollection;
  452.  
  453.     property Playing: boolean read GetPlaying;
  454.   published
  455.     property Looped: Boolean read FLooped write SetLooped;
  456.     property MaxPlayingCount: Integer read FMaxPlayingCount write SetMaxPlayingCount;
  457.     property Wave: TWave read FWave write SetWave;
  458.   end;
  459.  
  460.   {  TWaveCollection  }
  461.  
  462.   TWaveCollection = class(THashCollection)
  463.   private
  464.     FDXSound: TCustomDXSound;
  465.     FOwner: TPersistent;
  466.     function GetItem(Index: Integer): TWaveCollectionItem;
  467.     function Initialized: Boolean;
  468.   protected
  469.     function GetOwner: TPersistent; override;
  470.   public
  471.     constructor Create(AOwner: TPersistent);
  472.     function Find(const Name: string): TWaveCollectionItem;
  473.     procedure Finalize;
  474.     procedure Initialize(DXSound: TCustomDXSound);
  475.     procedure Restore;
  476.     procedure LoadFromFile(const FileName: string);
  477.     procedure LoadFromStream(Stream: TStream);
  478.     procedure SaveToFile(const FileName: string);
  479.     procedure SaveToStream(Stream: TStream);
  480.     property DXSound: TCustomDXSound read FDXSound;
  481.     property Items[Index: Integer]: TWaveCollectionItem read GetItem; default;
  482.   end;
  483.  
  484.   {  TCustomDXWaveList  }
  485.  
  486.   TCustomDXWaveList = class(TComponent)
  487.   private
  488.     FDXSound: TCustomDXSound;
  489.     FItems: TWaveCollection;
  490.     procedure DXSoundNotifyEvent(Sender: TCustomDXSound; NotifyType: TDXSoundNotifyType);
  491.     procedure SetDXSound(Value: TCustomDXSound);
  492.     procedure SetItems(Value: TWaveCollection);
  493.   protected
  494.     procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  495.   public
  496.     constructor Create(AOwner: TComponent); override;
  497.     destructor Destroy; override;
  498.     property DXSound: TCustomDXSound read FDXSound write SetDXSound;
  499.     property Items: TWaveCollection read FItems write SetItems;
  500.   end;
  501.  
  502.   {  TDXWaveList  }
  503.  
  504.   TDXWaveList = class(TCustomDXWaveList)
  505.   published
  506.     property DXSound;
  507.     property Items;
  508.   end;
  509.  
  510.   {  EDXMusicError  }
  511.  
  512.   EDXMusicError = class(Exception);
  513.  
  514.   TMusicListCollection = class;
  515.  
  516.   {  TMusicListCollectionItem  }
  517.  
  518.   TMusicDataProp = class(TPersistent)
  519.   private
  520.     FMusicData: string;
  521.     FMidiname: string;
  522.     function GetMusicData: string;
  523.     procedure SetMusicData(const Value: string);
  524.   protected
  525.     procedure DefineProperties(Filer: TFiler); override;
  526.     procedure ReadMidiData(Stream: TStream);
  527.     procedure WriteMidiData(Stream: TStream);
  528.   public
  529.     property MusicData: string read GetMusicData write SetMusicData;
  530.   published
  531.     property MidiName: string read FMidiname write FMidiname;
  532.   end;
  533.  
  534.   TMusicListCollectionItem = class(THashCollectionItem)
  535.   private
  536.     { Private declarations }
  537.     FDirectMusicPerformance: IDirectMusicPerformance;
  538.     FDirectSound: IDirectSound;
  539.     FDirectMusic: IDirectMusic;
  540.     FDirectMusicLoader: IDirectMusicLoader;
  541.     FDirectMusicSegment: IDirectMusicSegment;
  542.     FMusicObjDesc: TDMus_ObjectDesc;
  543.     FDirectMusicSegmentState: IDirectMusicSegmentState;
  544.     FRepeats: Cardinal;
  545.     FStartpoint: Integer;
  546.     FDuration: Integer;
  547.     // startpoint props in seconds these used to hold millisecond value
  548.     FActualDuration: Integer;
  549.     FActualStartPoint: Integer;
  550.     FIsInitialized: Boolean;
  551.     FMusicDataProp: TMusicDataProp;
  552.     procedure SetDuration(const Value: integer);
  553.     procedure SetRepeats(const Value: Cardinal);
  554.     procedure SetStartPoint(const Value: integer);
  555.     function GetMusicListCollection: TMusicListCollection;
  556.   protected
  557.     function GetDisplayName: string; override;
  558.   public
  559.     constructor Create(Collection: TCollection); override;
  560.     destructor Destroy; override;
  561.     function Size: Integer;
  562.     procedure Play;
  563.     function IsPlaying: Boolean;
  564.     procedure Stop;
  565.     procedure Load;
  566.     procedure Init;
  567.     procedure LoadFromFile(const MidiFileName: string);
  568.     procedure SaveToFile(const MidiFileName: string);
  569.     property MusicCollection: TMusicListCollection read GetMusicListCollection;
  570.     property IsInitialized: Boolean read FIsInitialized write FIsInitialized;
  571.   published
  572.     property Name;
  573.     property Repeats: Cardinal read Frepeats write SetRepeats;
  574.     property Duration: integer read FDuration write SetDuration;
  575.     property StartPoint: integer read FStartPoint write SetStartPoint;
  576.     property Midi: TMusicDataProp read FMusicDataProp write FMusicDataProp;
  577.   end;
  578.  
  579.   {  TMusicListCollection  }
  580.  
  581.   TMusicListCollection = class(THashCollection)
  582.   private
  583.     FOwner: TPersistent;
  584.     FDirectSound: IDirectSound;
  585.   protected
  586.     function GetItem(Index: Integer): TMusicListCollectionItem;
  587.     procedure SetItem(Index: Integer; Value: TMusicListCollectionItem);
  588.     procedure Update(Item: TCollectionItem); override;
  589.     function GetOwner: TPersistent; override;
  590.   public
  591.     constructor Create(AOwner: TComponent);
  592.     function Add: TMusicListCollectionItem;
  593.     function Find(const Name: string): TMusicListCollectionItem;
  594.     procedure Restore;
  595.     procedure LoadFromFile(const FileName: string);
  596.     procedure LoadFromStream(Stream: TStream);
  597.     procedure SaveToFile(const FileName: string);
  598.     procedure SaveToStream(Stream: TStream);
  599. {$IFDEF VER4UP}
  600.     function Insert(Index: Integer): TMusicListCollectionItem;
  601. {$ENDIF}
  602.     property Items[Index: Integer]: TMusicListCollectionItem read GetItem write SetItem;
  603.   published
  604.   end;
  605.  
  606.   {  TDXMusic  }
  607.  
  608.   TDXMusic = class(TComponent)
  609.   private
  610.     FDXSound: TDXSound;
  611.     FMidis: TMusicListCollection;
  612.     procedure SetMidis(const value: TMusicListCollection);
  613.     procedure SetDXSound(const Value: TDXSound);
  614.   public
  615.     constructor Create(AOwner: TComponent); override;
  616.     destructor Destroy; override;
  617.   published
  618.     property DXSound: TDXSound read FDXSound write SetDXSound;
  619.     property Midis: TMusicListCollection read FMidis write SetMidis;
  620.   end;
  621.  
  622. implementation
  623.  
  624. uses DXConsts;
  625.  
  626. const
  627.   dm_OK = 0;
  628.  
  629. function DXDirectSoundCreate(lpGUID: PGUID; out lpDS: IDirectSound;
  630.   pUnkOuter: IUnknown): HRESULT;
  631. type
  632.   TDirectSoundCreate = function(lpGUID: PGUID; out lplpDD: IDirectSound;
  633.     pUnkOuter: IUnknown): HRESULT; stdcall;
  634. begin
  635.   Result := TDirectSoundCreate(DXLoadLibrary('DSound.dll', 'DirectSoundCreate'))
  636.     (lpGUID, lpDS, pUnkOuter);
  637. end;
  638.  
  639. function DXDirectSoundEnumerate(lpCallback: TDSEnumCallbackA;
  640.   lpContext: Pointer): HRESULT;
  641. type
  642.   TDirectSoundEnumerate = function(lpCallback: TDSEnumCallbackA;
  643.     lpContext: Pointer): HRESULT; stdcall;
  644. begin
  645.   Result := TDirectSoundEnumerate(DXLoadLibrary('DSound.dll', 'DirectSoundEnumerateA'))
  646.     (lpCallback, lpContext);
  647. end;
  648.  
  649. function DXDirectSoundCaptureCreate(lpGUID: PGUID; out lplpDSC: IDirectSoundCapture;
  650.   pUnkOuter: IUnknown): HRESULT;
  651. type
  652.   TDirectSoundCaptureCreate = function(lpGUID: PGUID; out lplpDD: IDirectSoundCapture;
  653.     pUnkOuter: IUnknown): HRESULT; stdcall;
  654. begin
  655.   try
  656.     Result := TDirectSoundCaptureCreate(DXLoadLibrary('DSound.dll', 'DirectSoundCaptureCreate'))
  657.       (lpGUID, lplpDSC, pUnkOuter);
  658.   except
  659.     raise EDirectXError.Create(SSinceDirectX5);
  660.   end;
  661. end;
  662.  
  663. function DXDirectSoundCaptureEnumerate(lpCallback: TDSEnumCallbackA;
  664.   lpContext: Pointer): HRESULT;
  665. type
  666.   TDirectSoundCaptureEnumerate = function(lpCallback: TDSEnumCallbackA;
  667.     lpContext: Pointer): HRESULT; stdcall;
  668. begin
  669.   try
  670.     Result := TDirectSoundCaptureEnumerate(DXLoadLibrary('DSound.dll', 'DirectSoundCaptureEnumerateA'))
  671.       (lpCallback, lpContext);
  672.   except
  673.     raise EDirectXError.Create(SSinceDirectX5);
  674.   end;
  675. end;
  676.  
  677. var
  678.   DirectSoundDrivers: TDirectXDrivers;
  679.   DirectSoundCaptureDrivers: TDirectXDrivers;
  680.  
  681. function EnumDirectSoundDrivers_DSENUMCALLBACK(lpGuid: PGUID; lpstrDescription: {$IFDEF UNICODE}LPCTSTR{$ELSE}LPCSTR{$ENDIF};
  682.   lpstrModule: {$IFDEF UNICODE}LPCTSTR{$ELSE}LPCSTR{$ENDIF}; lpContext: Pointer): BOOL; stdcall;
  683. begin
  684.   Result := True;
  685.   with TDirectXDriver.Create(TDirectXDrivers(lpContext)) do
  686.   begin
  687.     Guid := lpGuid;
  688.     Description := lpstrDescription;
  689.     DriverName := lpstrModule;
  690.   end;
  691. end;
  692.  
  693. function EnumDirectSoundDrivers: TDirectXDrivers;
  694. begin
  695.   if DirectSoundDrivers = nil then
  696.   begin
  697.     DirectSoundDrivers := TDirectXDrivers.Create;
  698.     try
  699.       DXDirectSoundEnumerate(@EnumDirectSoundDrivers_DSENUMCALLBACK, DirectSoundDrivers);
  700.     except
  701.       DirectSoundDrivers.Free;
  702.       raise;
  703.     end;
  704.   end;
  705.  
  706.   Result := DirectSoundDrivers;
  707. end;
  708.  
  709. function EnumDirectSoundCaptureDrivers: TDirectXDrivers;
  710. begin
  711.   if DirectSoundCaptureDrivers = nil then
  712.   begin
  713.     DirectSoundCaptureDrivers := TDirectXDrivers.Create;
  714.     try
  715.       DXDirectSoundCaptureEnumerate(@EnumDirectSoundDrivers_DSENUMCALLBACK, DirectSoundCaptureDrivers);
  716.     except
  717.       DirectSoundCaptureDrivers.Free;
  718.       raise;
  719.     end;
  720.   end;
  721.  
  722.   Result := DirectSoundCaptureDrivers;
  723. end;
  724.  
  725. {  TDirectSound  }
  726.  
  727. constructor TDirectSound.Create(GUID: PGUID);
  728. begin
  729.   inherited Create;
  730.   FBufferList := TList.Create;
  731.  
  732.   if DXDirectSoundCreate(GUID, FIDSound, nil) <> DS_OK then
  733.     raise EDirectSoundError.CreateFmt(SCannotInitialized, [SDirectSound]);
  734. end;
  735.  
  736. destructor TDirectSound.Destroy;
  737. begin
  738.   while BufferCount > 0 do
  739.     Buffers[BufferCount - 1].Free;
  740.   FBufferList.Free;
  741.  
  742.   FIDSound := nil;
  743.   inherited Destroy;
  744. end;
  745.  
  746. class function TDirectSound.Drivers: TDirectXDrivers;
  747. begin
  748.   Result := EnumDirectSoundDrivers;
  749. end;
  750.  
  751. procedure TDirectSound.CheckBuffer(Buffer: TDirectSoundBuffer);
  752. begin
  753.   case Buffer.DXResult of
  754.     DSERR_BUFFERLOST:
  755.       begin
  756.         if not FInRestoreBuffer then
  757.         begin
  758.           FInRestoreBuffer := True;
  759.           try
  760.             DoRestoreBuffer;
  761.           finally
  762.             FInRestoreBuffer := False;
  763.           end;
  764.         end;
  765.       end;
  766.   end;
  767. end;
  768.  
  769. procedure TDirectSound.DoRestoreBuffer;
  770. begin
  771. end;
  772.  
  773. function TDirectSound.GetBuffer(Index: Integer): TDirectSoundBuffer;
  774. begin
  775.   Result := FBufferList[Index];
  776. end;
  777.  
  778. function TDirectSound.GetBufferCount: Integer;
  779. begin
  780.   Result := FBufferList.Count;
  781. end;
  782.  
  783. function TDirectSound.GetIDSound: IDirectSound;
  784. begin
  785.   if Self <> nil then
  786.     Result := FIDSound
  787.   else
  788.     Result := nil;
  789. end;
  790.  
  791. function TDirectSound.GetISound: IDirectSound;
  792. begin
  793.   Result := IDSound;
  794.   if Result = nil then
  795.     raise EDirectSoundError.CreateFmt(SNotMade, ['IDirectSound']);
  796. end;
  797.  
  798. {  TDirectSoundBuffer  }
  799.  
  800. constructor TDirectSoundBuffer.Create(ADirectSound: TDirectSound);
  801. begin
  802.   inherited Create;
  803.   FIsD3D := False;
  804.   FDSound := ADirectSound;
  805.   FIDS3DBuffer := nil;
  806.   FDSound.FBufferList.Add(Self);
  807. end;
  808.  
  809. destructor TDirectSoundBuffer.Destroy;
  810. begin
  811.   IDSBuffer := nil;
  812.   IDS3DBuffer := nil;
  813.   FDSound.FBufferList.Remove(Self);
  814.   inherited Destroy;
  815. end;
  816.  
  817. procedure TDirectSoundBuffer.Assign(Source: TPersistent);
  818. var
  819.   TempBuffer: IDirectSoundBuffer;
  820. begin
  821.   if Source = nil then
  822.     IDSBuffer := nil
  823.   else
  824.   if Source is TWave then
  825.     LoadFromWave(TWave(Source))
  826.   else
  827.   if Source is TDirectSoundBuffer then
  828.   begin
  829.     if TDirectSoundBuffer(Source).IDSBuffer = nil then
  830.       IDSBuffer := nil
  831.     else
  832.     begin
  833.       FDSound.DXResult := FDSound.ISound.DuplicateSoundBuffer(TDirectSoundBuffer(Source).IDSBuffer, TempBuffer);
  834.       if FDSound.DXResult = DS_OK then
  835.       begin
  836.         IDSBuffer := TempBuffer;
  837.       end;
  838.     end;
  839.  
  840.     if FIsD3D then
  841.       if TDirectSoundBuffer(Source).IDS3DBuffer = nil then
  842.         IDS3DBuffer := nil
  843.       else
  844.       begin
  845.         FDSound.DXResult := FDSound.ISound.QueryInterface(IID_IDirectSound3DBuffer, FIDS3DBuffer);
  846.         if FDSound.DXResult = DS_OK then
  847.           FD3DSParams := TDirectSoundBuffer(Source).FD3DSParams;
  848.       end;
  849.  
  850.   end
  851.   else
  852.     inherited Assign(Source);
  853. end;
  854.  
  855. procedure TDirectSoundBuffer.Check;
  856. begin
  857.   FDSound.CheckBuffer(Self);
  858. end;
  859.  
  860. function TDirectSoundBuffer.CreateBuffer(const BufferDesc: TDSBufferDesc): Boolean;
  861. var
  862.   TempBuffer: IDirectSoundBuffer;
  863. begin
  864.   IDSBuffer := nil;
  865.  
  866.   FDSound.DXResult := FDSound.ISound.CreateSoundBuffer(BufferDesc, TempBuffer, nil);
  867.   FDXResult := FDSound.DXResult;
  868.   Result := DXResult = DS_OK;
  869.   if Result then
  870.     IDSBuffer := TempBuffer;
  871. end;
  872.  
  873. function TDirectSoundBuffer.GetBitCount: Longint;
  874. begin
  875.   Result := Format.wBitsPerSample;
  876. end;
  877.  
  878. function TDirectSoundBuffer.GetFormat: PWaveFormatEx;
  879. begin
  880.   GetIBuffer;
  881.   Result := FFormat;
  882. end;
  883.  
  884. function TDirectSoundBuffer.GetFrequency: Integer;
  885. begin
  886.   DXResult := IBuffer.GetFrequency(DWORD(Result));
  887. end;
  888.  
  889. function TDirectSoundBuffer.GetIDS3DBuffer: IDirectSound3DBuffer;
  890. begin
  891.   if Self <> nil then
  892.     Result := FIDS3DBuffer
  893.   else
  894.     Result := nil;
  895. end;
  896.  
  897. function TDirectSoundBuffer.GetIDSBuffer: IDirectSoundBuffer;
  898. begin
  899.   if Self <> nil then
  900.     Result := FIDSBuffer
  901.   else
  902.     Result := nil;
  903. end;
  904.  
  905. function TDirectSoundBuffer.GetIBuffer: IDirectSoundBuffer;
  906. begin
  907.   Result := IDSBuffer;
  908.   if Result = nil then
  909.     raise EDirectSoundBufferError.CreateFmt(SNotMade, ['IDirectSoundBuffer']);
  910. end;
  911.  
  912. function TDirectSoundBuffer.GetPlaying: Boolean;
  913. begin
  914.   Result := (GetStatus and (DSBSTATUS_PLAYING or DSBSTATUS_LOOPING)) <> 0;
  915. end;
  916.  
  917. function TDirectSoundBuffer.GetPan: Integer;
  918. begin
  919.   DXResult := IBuffer.GetPan(Longint(Result));
  920. end;
  921.  
  922. function TDirectSoundBuffer.GetPosition: Longint;
  923. var
  924.   dwCurrentWriteCursor: Longint;
  925. begin
  926.   IBuffer.GetCurrentPosition(@DWORD(Result), @DWORD(dwCurrentWriteCursor));
  927. end;
  928.  
  929. function TDirectSoundBuffer.GetSize: Integer;
  930. begin
  931.   Result := FCaps.dwBufferBytes;
  932. end;
  933.  
  934. function TDirectSoundBuffer.GetStatus: Integer;
  935. begin
  936.   DXResult := IBuffer.GetStatus(DWORD(Result));
  937. end;
  938.  
  939. function TDirectSoundBuffer.GetVolume: Integer;
  940. begin
  941.   DXResult := IBuffer.GetVolume(Longint(Result));
  942. end;
  943.  
  944. procedure TDirectSoundBuffer.LoadFromFile(const FileName: string);
  945. var
  946.   Stream: TFileStream;
  947. begin
  948.   Stream := TFileStream.Create(FileName, fmOpenRead);
  949.   try
  950.     LoadFromStream(Stream);
  951.   finally
  952.     Stream.Free;
  953.   end;
  954. end;
  955.  
  956. procedure TDirectSoundBuffer.LoadFromMemory(const Format: TWaveFormatEx;
  957.   Data: Pointer; Size: Integer);
  958. var
  959.   Data1, Data2: Pointer;
  960.   Data1Size, Data2Size: Longint;
  961. begin
  962.   SetSize(Format, Size, FIsD3D);
  963.  
  964.   if Data <> nil then
  965.   begin
  966.     if Lock(0, Size, Data1, Data1Size, Data2, Data2Size) then
  967.     begin
  968.       try
  969.         Move(Data^, Data1^, Data1Size);
  970.         if Data2 <> nil then
  971.           Move(Pointer(Longint(Data) + Data1Size)^, Data2^, Data2Size);
  972.       finally
  973.         UnLock;
  974.       end;
  975.     end
  976.     else
  977.     begin
  978.       FIDSBuffer := nil;
  979.       FIDS3DBuffer := nil;
  980.       raise EDirectSoundBufferError.CreateFmt(SCannotLock, [SDirectSoundBuffer]);
  981.     end;
  982.   end;
  983. end;
  984.  
  985. procedure TDirectSoundBuffer.LoadFromStream(Stream: TStream);
  986. var
  987.   Wave: TWave;
  988. begin
  989.   Wave := TWave.Create;
  990.   try
  991.     Wave.LoadFromStream(Stream);
  992.     LoadFromWave(Wave);
  993.   finally
  994.     Wave.Free;
  995.   end;
  996. end;
  997.  
  998. procedure TDirectSoundBuffer.LoadFromWave(Wave: TWave);
  999. begin
  1000.   LoadFromMemory(Wave.Format^, Wave.Data, Wave.Size);
  1001. end;
  1002.  
  1003. function TDirectSoundBuffer.Lock(LockPosition, LockSize: Longint;
  1004.   var AudioPtr1: Pointer; var AudioSize1: Longint;
  1005.   var AudioPtr2: Pointer; var AudioSize2: Longint): Boolean;
  1006. begin
  1007.   Result := False;
  1008.   if IDSBuffer = nil then Exit;
  1009.  
  1010.   if FLockCount > High(FLockAudioPtr1) then Exit;
  1011.   DXResult := IBuffer.Lock(LockPosition, LockSize,
  1012.     {$IFNDEF DX7}@{$ENDIF}FLockAudioPtr1[FLockCount], {$IFNDEF DX7}@{$ENDIF}FLockAudioSize1[FLockCount],
  1013.     {$IFNDEF DX7}@{$ENDIF}FLockAudioPtr2[FLockCount], {$IFNDEF DX7}@{$ENDIF}FLockAudioSize2[FLockCount], 0);
  1014.   Result := DXResult = DS_OK;
  1015.  
  1016.   if Result then
  1017.   begin
  1018.     AudioPtr1 := FLockAudioPtr1[FLockCount];
  1019.     AudioPtr2 := FLockAudioPtr2[FLockCount];
  1020.     AudioSize1 := FLockAudioSize1[FLockCount];
  1021.     AudioSize2 := FLockAudioSize2[FLockCount];
  1022.     Inc(FLockCount);
  1023.   end;
  1024. end;
  1025.  
  1026. function TDirectSoundBuffer.Play(Loop: Boolean): Boolean;
  1027. begin
  1028.   if Loop then
  1029.     DXResult := IBuffer.Play(0, 0, DSBPLAY_LOOPING)
  1030.   else
  1031.     DXResult := IBuffer.Play(0, 0, 0);
  1032.   Result := DXResult = DS_OK;
  1033. end;
  1034.  
  1035. function TDirectSoundBuffer.Restore: Boolean;
  1036. begin
  1037.   DXResult := IBuffer.Restore;
  1038.   Result := DXResult = DS_OK;
  1039. end;
  1040.  
  1041. procedure TDirectSoundBuffer.SetD3DSParams(const Value: TD3DSParams);
  1042. begin
  1043.   FD3DSParams.Assign(Value);
  1044. end;
  1045.  
  1046. function TDirectSoundBuffer.SetFormat(const Format: TWaveFormatEx): Boolean;
  1047. begin
  1048.   DXResult := IBuffer.SetFormat(FFormat{$IFDEF DX7}^{$ENDIF});
  1049.   Result := DXResult = DS_OK;
  1050.  
  1051.   if Result then
  1052.   begin
  1053.     FreeMem(FFormat);
  1054.     FFormat := nil;
  1055.     FFormatSize := 0;
  1056.     if IBuffer.GetFormat(PWaveFormatEx(nil), 0, @DWORD(FFormatSize)) = DS_OK then
  1057.     begin
  1058.       GetMem(FFormat, FFormatSize);
  1059.       IBuffer.GetFormat(FFormat, FFormatSize, nil);
  1060.     end;
  1061.   end;
  1062. end;
  1063.  
  1064. procedure TDirectSoundBuffer.SetFrequency(Value: Integer);
  1065. begin
  1066.   DXResult := IBuffer.SetFrequency(Value);
  1067. end;
  1068.  
  1069. procedure TDirectSoundBuffer.SetIDS3DBuffer(const Value: IDirectSound3DBuffer);
  1070. begin
  1071.   if FIDS3DBuffer = Value then Exit;
  1072.  
  1073.   FIDS3DBuffer := Value;
  1074.   FillChar(FCaps, SizeOf(FCaps), 0);
  1075.   FreeMem(FFormat);
  1076.   FFormat := nil;
  1077.   FFormatSize := 0;
  1078.   FLockCount := 0;
  1079.  
  1080.   if FIDS3DBuffer <> nil then
  1081.   begin
  1082.     FCaps.dwSize := SizeOf(FCaps);
  1083.     IBuffer.GetCaps(FCaps);
  1084.  
  1085.     if IBuffer.GetFormat(PWaveFormatEx(nil), 0, @DWORD(FFormatSize)) = DS_OK then
  1086.     begin
  1087.       GetMem(FFormat, FFormatSize);
  1088.       IBuffer.GetFormat(FFormat, FFormatSize, nil);
  1089.     end;
  1090.   end;
  1091. end;
  1092.  
  1093. procedure TDirectSoundBuffer.SetIDSBuffer(Value: IDirectSoundBuffer);
  1094. begin
  1095.   if FIDSBuffer = Value then Exit;
  1096.  
  1097.   FIDSBuffer := Value;
  1098.   FillChar(FCaps, SizeOf(FCaps), 0);
  1099.   FreeMem(FFormat);
  1100.   FFormat := nil;
  1101.   FFormatSize := 0;
  1102.   FLockCount := 0;
  1103.  
  1104.   if FIDSBuffer <> nil then
  1105.   begin
  1106.     FCaps.dwSize := SizeOf(FCaps);
  1107.     IBuffer.GetCaps(FCaps);
  1108.  
  1109.     if IBuffer.GetFormat(PWaveFormatEx(nil), 0, @DWORD(FFormatSize)) = DS_OK then
  1110.     begin
  1111.       GetMem(FFormat, FFormatSize);
  1112.       IBuffer.GetFormat(FFormat, FFormatSize, nil);
  1113.     end;
  1114.   end;
  1115. end;
  1116.  
  1117. procedure TDirectSoundBuffer.SetPan(Value: Integer);
  1118. begin
  1119.   DXResult := IBuffer.SetPan(Value);
  1120. end;
  1121.  
  1122. procedure TDirectSoundBuffer.SetPosition(Value: Longint);
  1123. begin
  1124.   DXResult := IBuffer.SetCurrentPosition(Value);
  1125. end;
  1126. {$IFNDEF DX7}
  1127. const
  1128.   DSBCAPS_CTRLDEFAULT = DSBCAPS_CTRLFREQUENCY or DSBCAPS_CTRLPAN or DSBCAPS_CTRLVOLUME;
  1129. {$ENDIF}
  1130.  
  1131. procedure TDirectSoundBuffer.SetSize(const Format: TWaveFormatEx; Size: Integer; D3D: Boolean {$IFNDEF VER100}= False{$ENDIF});
  1132. var
  1133.   BufferDesc: TDSBufferDesc;
  1134. begin
  1135.   {  IDirectSoundBuffer made.  }
  1136.   FillChar(BufferDesc, SizeOf(BufferDesc), 0);
  1137.  
  1138.   with BufferDesc do
  1139.   begin
  1140.     dwSize := SizeOf(TDSBufferDesc);
  1141.     dwFlags := DSBCAPS_CTRLDEFAULT;
  1142.     if DSound.FStickyFocus then
  1143.       dwFlags := dwFlags or DSBCAPS_STICKYFOCUS
  1144.     else if DSound.FGlobalFocus then
  1145.       dwFlags := dwFlags or DSBCAPS_GLOBALFOCUS;
  1146.     if D3D then
  1147.       dwFlags := DSBCAPS_STATIC + DSBCAPS_CTRLDEFAULT + DSBCAPS_CTRL3D - DSBCAPS_CTRLPAN;
  1148.     dwBufferBytes := Size;
  1149.     lpwfxFormat := @Format;
  1150.   end;
  1151.  
  1152.   if not CreateBuffer(BufferDesc) then
  1153.     raise EDirectSoundBufferError.CreateFmt(SCannotMade, [SDirectSoundBuffer]);
  1154. end;
  1155.  
  1156. procedure TDirectSoundBuffer.SetVolume(Value: Integer);
  1157. begin
  1158.   DXResult := IBuffer.SetVolume(Value);
  1159. end;
  1160.  
  1161. procedure TDirectSoundBuffer.Stop;
  1162. begin
  1163.   DXResult := IBuffer.Stop;
  1164. end;
  1165.  
  1166. procedure TDirectSoundBuffer.Unlock;
  1167. begin
  1168.   if IDSBuffer = nil then Exit;
  1169.   if FLockCount = 0 then Exit;
  1170.  
  1171.   Dec(FLockCount);
  1172.   DXResult := IBuffer.UnLock(FLockAudioPtr1[FLockCount], FLockAudioSize1[FLockCount],
  1173.     FLockAudioPtr2[FLockCount], FLockAudioSize2[FLockCount]);
  1174. end;
  1175.  
  1176. {  TD3DSParams  }
  1177.  
  1178. function TD3DSParams.CheckValidity: Boolean;
  1179. begin
  1180.   Result := (FOwner <> nil) and (TDirectSoundBuffer(FOwner).IDS3DBuffer <> nil)
  1181. end;
  1182.  
  1183. constructor TD3DSParams.Create(Owner: TDirectSoundBuffer);
  1184.   {$IFDEF VER14UP}
  1185.   function MakeD3DVector(x, y, z: TD3DValue): TD3DVector; {$IFDEF VER9UP}inline; {$ENDIF}
  1186.   begin
  1187.     Result.x := x;
  1188.     Result.y := y;
  1189.     Result.z := z;
  1190.   end;
  1191.   {$ENDIF}
  1192. begin
  1193.   inherited Create;
  1194.   FOwner := Owner;
  1195.   with FDsb do
  1196.   begin
  1197.     dwSize := SizeOf(TDS3DBuffer);
  1198.     vPosition := MakeD3DVector(0, 0, 0);
  1199.     vVelocity := MakeD3DVector(0, 0, 0);
  1200.     dwInsideConeAngle := DS3D_DEFAULTCONEANGLE;
  1201.     dwOutsideConeAngle := DS3D_DEFAULTCONEANGLE;
  1202.     vConeOrientation := MakeD3DVector(0, 0, 0);
  1203.     lConeoutsideVolume := DS3D_DEFAULTCONEOUTSIDEVOLUME;
  1204.     flMinDistance := 5;
  1205.     flMaxDistance := 100.0;
  1206.     dwMode := DS3DMODE_NORMAL;
  1207.   end;
  1208. end;
  1209.  
  1210. destructor TD3DSParams.destroy;
  1211. begin
  1212.   inherited destroy;
  1213. end;
  1214.  
  1215. function TD3DSParams.getPosition: TD3DVector;
  1216. begin
  1217.   if CheckValidity then
  1218.   begin
  1219.     FOwner.IDS3DBuffer.GetPosition(FDsb.vPosition);
  1220.   end;
  1221.   result := FDsb.vPosition;
  1222. end;
  1223.  
  1224. function TD3DSParams.getVelocity: TD3DVector;
  1225. begin
  1226.   if CheckValidity then
  1227.   begin
  1228.     FOwner.IDS3DBuffer.GetVelocity(FDsb.vVelocity);
  1229.   end;
  1230.   result := FDsb.vVelocity;
  1231. end;
  1232.  
  1233. function TD3DSParams.getConeOrientation: TD3DVector;
  1234. begin
  1235.   if CheckValidity then
  1236.   begin
  1237.     FOwner.IDS3DBuffer.GetConeOrientation(FDsb.vConeOrientation);
  1238.   end;
  1239.   result := FDsb.vConeOrientation;
  1240. end;
  1241.  
  1242. function TD3DSParams.getConeAngle: TConeAngle;
  1243. begin
  1244.   if CheckValidity then
  1245.   begin
  1246.     FOwner.IDS3DBuffer.GetConeAngles(FDsb.dwInsideConeAngle, FDsb.dwOutsideConeAngle);
  1247.   end;
  1248.   with result do
  1249.   begin
  1250.     Inside := FDsb.dwInsideConeAngle;
  1251.     OutSide := FDsb.dwOutsideConeAngle;
  1252.   end;
  1253. end;
  1254.  
  1255. function TD3DSParams.getConeOutsideVolume: Integer;
  1256. begin
  1257.   if CheckValidity then
  1258.   begin
  1259.     FOwner.IDS3DBuffer.GetConeOutsideVolume(FDsb.lConeOutsideVolume);
  1260.   end;
  1261.   result := FDsb.lConeOutsideVolume;
  1262. end;
  1263.  
  1264. function TD3DSParams.getMinDistance: TD3DValue;
  1265. begin
  1266.   if CheckValidity then
  1267.   begin
  1268.     FOwner.IDS3DBuffer.GetMinDistance(FDsb.flMinDistance);
  1269.   end;
  1270.   result := FDsb.flMinDistance;
  1271. end;
  1272.  
  1273. function TD3DSParams.getMaxDistance: TD3DValue;
  1274. begin
  1275.   if CheckValidity then
  1276.   begin
  1277.     FOwner.IDS3DBuffer.GetMaxDistance(FDsb.flMaxDistance);
  1278.   end;
  1279.   result := FDsb.flMaxDistance;
  1280. end;
  1281.  
  1282. function TD3DSParams.getRaw: TDS3DBuffer;
  1283. begin
  1284.   if CheckValidity then
  1285.   begin
  1286.     FOwner.IDS3DBuffer.GetAllParameters(FDsb);
  1287.   end;
  1288.   result := FDsb;
  1289. end;
  1290.  
  1291.  
  1292. procedure TD3DSParams.setPosition(const v: TD3DVector);
  1293. begin
  1294.   if CheckValidity then
  1295.   begin
  1296.     FOwner.IDS3DBuffer.SetPosition(v.x, v.y, v.z, DS3D_IMMEDIATE);
  1297.   end;
  1298.   FDsb.vPosition := v;
  1299. end;
  1300.  
  1301. procedure TD3DSParams.setVelocity(const v: TD3DVector);
  1302. begin
  1303.   if CheckValidity then
  1304.   begin
  1305.     FOwner.IDS3DBuffer.SetVelocity(v.x, v.y, v.z, DS3D_IMMEDIATE);
  1306.   end;
  1307.   FDsb.vVelocity := v;
  1308. end;
  1309.  
  1310. procedure TD3DSParams.setConeOrientation(const v: TD3DVector);
  1311. begin
  1312.   if CheckValidity then
  1313.   begin
  1314.     FOwner.IDS3DBuffer.SetConeOrientation(v.x, v.y, v.z, DS3D_IMMEDIATE);
  1315.   end;
  1316.   FDsb.vConeOrientation := v;
  1317. end;
  1318.  
  1319. procedure TD3DSParams.setConeAngle(const v: TConeAngle);
  1320. begin
  1321.   if CheckValidity then
  1322.   begin
  1323.     FOwner.IDS3DBuffer.SetConeAngles(v.Inside, v.Outside, DS3D_IMMEDIATE);
  1324.   end;
  1325.   FDsb.dwInsideConeAngle := v.Inside;
  1326.   FDsb.dwInsideConeAngle := v.Outside;
  1327. end;
  1328.  
  1329. procedure TD3DSParams.setConeOutsideVolume(const v: Integer);
  1330. begin
  1331.   if CheckValidity then
  1332.   begin
  1333.     FOwner.IDS3DBuffer.SetConeOutsideVolume(v, DS3D_IMMEDIATE);
  1334.   end;
  1335.   FDsb.lConeOutsideVolume := v;
  1336. end;
  1337.  
  1338. procedure TD3DSParams.setMinDistance(const v: TD3DValue);
  1339. begin
  1340.   if CheckValidity then
  1341.   begin
  1342.     FOwner.IDS3DBuffer.SetMinDistance(v, DS3D_IMMEDIATE);
  1343.   end;
  1344.   FDsb.flMinDistance := v;
  1345. end;
  1346.  
  1347. procedure TD3DSParams.setMaxDistance(const v: TD3DValue);
  1348. begin
  1349.   if CheckValidity then
  1350.   begin
  1351.     FOwner.IDS3DBuffer.SetMaxDistance(v, DS3D_IMMEDIATE);
  1352.   end;
  1353.   FDsb.flMaxDistance := v;
  1354. end;
  1355.  
  1356. procedure TD3DSParams.setRaw(const v: TDS3DBuffer);
  1357. begin
  1358.   if CheckValidity then
  1359.   begin
  1360.     if FOwner.IDS3DBuffer.SetAllParameters(v, DS3D_IMMEDIATE) <> DS_OK then
  1361.       {'Parameter is invalid for Params3D'};
  1362.   end;
  1363.   FDsb := v;
  1364. end;
  1365.  
  1366. procedure TD3DSParams.Assign(Prms: TD3DSParams);
  1367. begin
  1368.   FDsb := Prms.RawParams;
  1369.  
  1370.   if CheckValidity then
  1371.   begin
  1372.     if FOwner.IDS3DBuffer.SetAllParameters(FDsb, DS3D_IMMEDIATE) <> DS_OK then
  1373.       {'Parameter is invalid for Params3D'};
  1374.   end;
  1375. end;
  1376.  
  1377. {  TAudioStream  }
  1378.  
  1379. type
  1380.   TAudioStreamNotify = class(TThread)
  1381.   private
  1382.     FAudio: TAudioStream;
  1383.     FSleepTime: Integer;
  1384.     FStopOnTerminate: Boolean;
  1385.     constructor Create(Audio: TAudioStream);
  1386.     destructor Destroy; override;
  1387.     procedure Execute; override;
  1388.     procedure Update;
  1389.     procedure ThreadTerminate(Sender: TObject);
  1390.   end;
  1391.  
  1392. constructor TAudioStreamNotify.Create(Audio: TAudioStream);
  1393. begin
  1394.   FAudio := Audio;
  1395.  
  1396.   OnTerminate := ThreadTerminate;
  1397.  
  1398.   FAudio.FNotifyEvent := CreateEvent(nil, False, False, nil);
  1399.   FAudio.FNotifyThread := Self;
  1400.  
  1401.   FSleepTime := Min(FAudio.FBufferLength div 4, 1000 div 20);
  1402.   FStopOnTerminate := True;
  1403.  
  1404.   FreeOnTerminate := True;
  1405.   inherited Create(False);
  1406. end;
  1407.  
  1408. destructor TAudioStreamNotify.Destroy;
  1409. begin
  1410.   FreeOnTerminate := False;
  1411.  
  1412.   SetEvent(FAudio.FNotifyEvent);
  1413.   inherited Destroy;
  1414.   CloseHandle(FAudio.FNotifyEvent);
  1415.  
  1416.   FAudio.FNotifyThread := nil;
  1417. end;
  1418.  
  1419. procedure TAudioStreamNotify.ThreadTerminate(Sender: TObject);
  1420. begin
  1421.   FAudio.FNotifyThread := nil;
  1422.   if FStopOnTerminate then FAudio.Stop;
  1423. end;
  1424.  
  1425. procedure TAudioStreamNotify.Execute;
  1426. begin
  1427.   while WaitForSingleObject(FAudio.FNotifyEvent, FSleepTime) = WAIT_TIMEOUT do
  1428.     Synchronize(Update);
  1429. end;
  1430.  
  1431. procedure TAudioStreamNotify.Update;
  1432. begin
  1433.   if not FAudio.Playing then
  1434.   begin
  1435.     SetEvent(FAudio.FNotifyEvent);
  1436.     EXit;
  1437.   end;
  1438.  
  1439.   try
  1440.     FAudio.Update2(True);
  1441.   except
  1442.     on E: Exception do
  1443.     begin
  1444.       Application.HandleException(E);
  1445.       SetEvent(FAudio.FNotifyEvent);
  1446.     end;
  1447.   end;
  1448. end;
  1449.  
  1450. constructor TAudioStream.Create(ADirectSound: TDirectSound);
  1451. begin
  1452.   inherited Create;
  1453.   FDSound := ADirectSound;
  1454.   FAutoUpdate := True;
  1455.   FBuffer := TDirectSoundBuffer.Create(FDSound);
  1456.   FBufferLength := 1000;
  1457. end;
  1458.  
  1459. destructor TAudioStream.Destroy;
  1460. begin
  1461.   Stop;
  1462.   WaveStream := nil;
  1463.   FBuffer.Free;
  1464.   inherited Destroy;
  1465. end;
  1466.  
  1467. function TAudioStream.GetFormat: PWaveFormatEX;
  1468. begin
  1469.   if WaveStream = nil then
  1470.     raise EAudioStreamError.Create(SWaveStreamNotSet);
  1471.   Result := WaveStream.Format;
  1472. end;
  1473.  
  1474. function TAudioStream.GetFormatSize: Integer;
  1475. begin
  1476.   if WaveStream = nil then
  1477.     raise EAudioStreamError.Create(SWaveStreamNotSet);
  1478.   Result := WaveStream.FormatSize;
  1479. end;
  1480.  
  1481. function TAudioStream.GetFrequency: Integer;
  1482. begin
  1483.   Result := FBuffer.Frequency;
  1484. end;
  1485.  
  1486. function TAudioStream.GetPan: Integer;
  1487. begin
  1488.   Result := FBuffer.Pan;
  1489. end;
  1490.  
  1491. function TAudioStream.GetPlayedSize: Integer;
  1492. begin
  1493.   if Playing then UpdatePlayedSize;
  1494.   Result := FPlayedSize;
  1495. end;
  1496.  
  1497. function TAudioStream.GetSize: Integer;
  1498. begin
  1499.   if WaveStream <> nil then
  1500.     Result := WaveStream.Size
  1501.   else
  1502.     Result := 0;
  1503. end;
  1504.  
  1505. function TAudioStream.GetVolume: Integer;
  1506. begin
  1507.   Result := FBuffer.Volume;
  1508. end;
  1509.  
  1510. procedure TAudioStream.UpdatePlayedSize;
  1511. var
  1512.   PlayPosition, PlayedSize: DWORD;
  1513. begin
  1514.   PlayPosition := FBuffer.Position;
  1515.  
  1516.   if FPlayBufferPos <= PlayPosition then
  1517.   begin
  1518.     PlayedSize := PlayPosition - FPlayBufferPos
  1519.   end else
  1520.   begin
  1521.     PlayedSize := PlayPosition + (FBufferSize - FPlayBufferPos);
  1522.   end;
  1523.  
  1524.   Inc(FPlayedSize, PlayedSize);
  1525.  
  1526.   FPlayBufferPos := PlayPosition;
  1527. end;
  1528.  
  1529. function TAudioStream.GetWriteSize: Integer;
  1530. var
  1531.   PlayPosition: DWORD;
  1532.   i: Integer;
  1533. begin
  1534.   PlayPosition := FBuffer.Position;
  1535.  
  1536.   if FBufferPos <= PlayPosition then
  1537.   begin
  1538.     Result := PlayPosition - FBufferPos
  1539.   end else
  1540.   begin
  1541.     Result := PlayPosition + (FBufferSize - FBufferPos);
  1542.   end;
  1543.  
  1544.   i := WaveStream.FilledSize;
  1545.   if i >= 0 then Result := Min(Result, i);
  1546. end;
  1547.  
  1548. procedure TAudioStream.Play;
  1549. begin
  1550.   if not FPlaying then
  1551.   begin
  1552.     if WaveStream = nil then
  1553.       raise EAudioStreamError.Create(SWaveStreamNotSet);
  1554.  
  1555.     if Size = 0 then Exit;
  1556.  
  1557.     FPlaying := True;
  1558.     try
  1559.       SetPosition(FPosition);
  1560.       if FAutoUpdate then
  1561.         FNotifyThread := TAudioStreamNotify.Create(Self);
  1562.     except
  1563.       Stop;
  1564.       raise;
  1565.     end;
  1566.   end;
  1567. end;
  1568.  
  1569. procedure TAudioStream.RecreateBuf;
  1570. var
  1571.   APlaying: Boolean;
  1572.   APosition: Integer;
  1573.   AFrequency: Integer;
  1574.   APan: Integer;
  1575.   AVolume: Integer;
  1576. begin
  1577.   APlaying := Playing;
  1578.  
  1579.   APosition := Position;
  1580.   AFrequency := Frequency;
  1581.   APan := Pan;
  1582.   AVolume := Volume;
  1583.  
  1584.   SetWaveStream(WaveStream);
  1585.  
  1586.   Position := APosition;
  1587.   Frequency := AFrequency;
  1588.   Pan := APan;
  1589.   Volume := AVolume;
  1590.  
  1591.   if APlaying then Play;
  1592. end;
  1593.  
  1594. procedure TAudioStream.SetAutoUpdate(Value: Boolean);
  1595. begin
  1596.   if FAutoUpdate <> Value then
  1597.   begin
  1598.     FAutoUpdate := Value;
  1599.     if FPlaying then
  1600.     begin
  1601.       if FNotifyThread <> nil then
  1602.       begin
  1603.         (FNotifyThread as TAudioStreamNotify).FStopOnTerminate := False;
  1604.         FNotifyThread.Free;
  1605.       end;
  1606.  
  1607.       if FAutoUpdate then
  1608.         FNotifyThread := TAudioStreamNotify.Create(Self);
  1609.     end;
  1610.   end;
  1611. end;
  1612.  
  1613. procedure TAudioStream.SetBufferLength(Value: Integer);
  1614. begin
  1615.   if Value < 10 then Value := 10;
  1616.   if FBufferLength <> Value then
  1617.   begin
  1618.     FBufferLength := Value;
  1619.     if WaveStream <> nil then RecreateBuf;
  1620.   end;
  1621. end;
  1622.  
  1623. procedure TAudioStream.SetFrequency(Value: Integer);
  1624. begin
  1625.   FBuffer.Frequency := Value;
  1626. end;
  1627.  
  1628. procedure TAudioStream.SetLooped(Value: Boolean);
  1629. begin
  1630.   if FLooped <> Value then
  1631.   begin
  1632.     FLooped := Value;
  1633.     Position := Position;
  1634.   end;
  1635. end;
  1636.  
  1637. procedure TAudioStream.SetPan(Value: Integer);
  1638. begin
  1639.   FBuffer.Pan := Value;
  1640. end;
  1641.  
  1642. procedure TAudioStream.SetPlayedSize(Value: Integer);
  1643. begin
  1644.   if Playing then UpdatePlayedSize;
  1645.   FPlayedSize := Value;
  1646. end;
  1647.  
  1648. procedure TAudioStream.SetPosition(Value: Integer);
  1649. begin
  1650.   if WaveStream = nil then
  1651.     raise EAudioStreamError.Create(SWaveStreamNotSet);
  1652.  
  1653.   Value := Max(Min(Value, Size - 1), 0);
  1654.   Value := Value div Format^.nBlockAlign * Format^.nBlockAlign;
  1655.  
  1656.   FPosition := Value;
  1657.  
  1658.   if Playing then
  1659.   begin
  1660.     try
  1661.       FBuffer.Stop;
  1662.  
  1663.       FBufferPos := 0;
  1664.       FPlayBufferPos := 0;
  1665.       FWritePosition := Value;
  1666.  
  1667.       WriteWave(FBufferSize);
  1668.  
  1669.       FBuffer.Position := 0;
  1670.       FBuffer.Play(True);
  1671.     except
  1672.       Stop;
  1673.       raise;
  1674.     end;
  1675.   end;
  1676. end;
  1677.  
  1678. procedure TAudioStream.SetVolume(Value: Integer);
  1679. begin
  1680.   FBuffer.Volume := Value;
  1681. end;
  1682.  
  1683. procedure TAudioStream.SetWaveStream(Value: TCustomWaveStream);
  1684. var
  1685.   BufferDesc: TDSBufferDesc;
  1686. begin
  1687.   Stop;
  1688.  
  1689.   FWaveStream := nil;
  1690.   FBufferPos := 0;
  1691.   FPosition := 0;
  1692.   FWritePosition := 0;
  1693.  
  1694.   if (Value <> nil) and (FBufferLength > 0) then
  1695.   begin
  1696.     FBufferSize := FBufferLength * Integer(Value.Format^.nAvgBytesPerSec) div 1000;
  1697.  
  1698.     FillChar(BufferDesc, SizeOf(BufferDesc), 0);
  1699.     with BufferDesc do
  1700.     begin
  1701.       dwSize := SizeOf(TDSBufferDesc);
  1702.       dwFlags := DSBCAPS_CTRLDEFAULT or DSBCAPS_GETCURRENTPOSITION2;
  1703.       if FDSound.FStickyFocus then
  1704.         dwFlags := dwFlags or DSBCAPS_STICKYFOCUS
  1705.       else if FDSound.FGlobalFocus then
  1706.         dwFlags := dwFlags or DSBCAPS_GLOBALFOCUS;
  1707.       dwBufferBytes := FBufferSize;
  1708.       lpwfxFormat := Value.Format;
  1709.     end;
  1710.  
  1711.     if not FBuffer.CreateBuffer(BufferDesc) then
  1712.       raise EDirectSoundBufferError.CreateFmt(SCannotMade, [SDirectSoundBuffer]);
  1713.   end else
  1714.   begin
  1715.     FBuffer.IDSBuffer := nil;
  1716.     FBufferSize := 0;
  1717.   end;
  1718.  
  1719.   FWaveStream := Value;
  1720. end;
  1721.  
  1722. procedure TAudioStream.Stop;
  1723. begin
  1724.   if FPlaying then
  1725.   begin
  1726.     FPlaying := False;
  1727.     FBuffer.Stop;
  1728.     FNotifyThread.Free;
  1729.   end;
  1730. end;
  1731.  
  1732. procedure TAudioStream.Update;
  1733. begin
  1734.   Update2(False);
  1735. end;
  1736.  
  1737. procedure TAudioStream.Update2(InThread: Boolean);
  1738. var
  1739.   WriteSize: Integer;
  1740. begin
  1741.   if not FPlaying then Exit;
  1742.  
  1743.   try
  1744.     UpdatePlayedSize;
  1745.  
  1746.     if Size < 0 then
  1747.     begin
  1748.       WriteSize := GetWriteSize;
  1749.       if WriteSize > 0 then
  1750.       begin
  1751.         WriteSize := WriteWave(WriteSize);
  1752.         FPosition := FPosition + WriteSize;
  1753.       end;
  1754.     end else
  1755.     begin
  1756.       if FLooped then
  1757.       begin
  1758.         WriteSize := GetWriteSize;
  1759.         if WriteSize > 0 then
  1760.         begin
  1761.           WriteWave(WriteSize);
  1762.           FPosition := (FPosition + WriteSize) mod Size;
  1763.         end;
  1764.       end else
  1765.       begin
  1766.         if FPosition < Size then
  1767.         begin
  1768.           WriteSize := GetWriteSize;
  1769.           if WriteSize > 0 then
  1770.           begin
  1771.             WriteWave(WriteSize);
  1772.             FPosition := FPosition + WriteSize;
  1773.             if FPosition > Size then FPosition := Size;
  1774.           end;
  1775.         end else
  1776.         begin
  1777.           if InThread then
  1778.             SetEvent(FNotifyEvent)
  1779.           else
  1780.             Stop;
  1781.         end;
  1782.       end;
  1783.     end;
  1784.   except
  1785.     if InThread then
  1786.       SetEvent(FNotifyEvent)
  1787.     else
  1788.       Stop;
  1789.     raise;
  1790.   end;
  1791. end;
  1792.  
  1793. function TAudioStream.WriteWave(WriteSize: Integer): Integer;
  1794.  
  1795.   procedure WriteData(Size: Integer);
  1796.   var
  1797.     Data1, Data2: Pointer;
  1798.     Data1Size, Data2Size: Longint;
  1799.   begin
  1800.     if FBuffer.Lock(FBufferPos, Size, Data1, Data1Size, Data2, Data2Size) then
  1801.     begin
  1802.       try
  1803.         FWaveStream.Position := FWritePosition;
  1804.         FWaveStream.ReadBuffer(Data1^, Data1Size);
  1805.         FWritePosition := FWritePosition + Data1Size;
  1806.  
  1807.         if Data2 <> nil then
  1808.         begin
  1809.           FWaveStream.ReadBuffer(Data2^, Data2Size);
  1810.           FWritePosition := FWritePosition + Data2Size;
  1811.         end;
  1812.  
  1813.         FBufferPos := (FBufferPos + DWORD(Data1Size) + DWORD(Data2Size)) mod FBufferSize;
  1814.       finally
  1815.         FBuffer.UnLock;
  1816.       end;
  1817.     end;
  1818.   end;
  1819.  
  1820.   procedure WriteData2(Size: Integer);
  1821.   var
  1822.     Data1, Data2: Pointer;
  1823.     Data1Size, Data2Size, s1, s2: Longint;
  1824.   begin
  1825.     if FBuffer.Lock(FBufferPos, Size, Data1, Data1Size, Data2, Data2Size) then
  1826.     begin
  1827.       try
  1828.         FWaveStream.Position := FWritePosition;
  1829.         s1 := FWaveStream.Read(Data1^, Data1Size);
  1830.         FWritePosition := FWritePosition + s1;
  1831.         FBufferPos := (FBufferPos + DWORD(s1)) mod FBufferSize;
  1832.         Inc(Result, s1);
  1833.  
  1834.         if (Data2 <> nil) and (s1 = Data1Size) then
  1835.         begin
  1836.           s2 := FWaveStream.Read(Data2^, Data2Size);
  1837.           FWritePosition := FWritePosition + s2;
  1838.           FBufferPos := (FBufferPos + DWORD(s2)) mod FBufferSize;
  1839.           Inc(Result, s2);
  1840.         end;
  1841.       finally
  1842.         FBuffer.UnLock;
  1843.       end;
  1844.     end;
  1845.   end;
  1846.  
  1847.   procedure WriteSilence(Size: Integer);
  1848.   var
  1849.     C: Byte;
  1850.     Data1, Data2: Pointer;
  1851.     Data1Size, Data2Size: Longint;
  1852.   begin
  1853.     if Format^.wBitsPerSample = 8 then C := $80 else C := 0;
  1854.  
  1855.     if FBuffer.Lock(FBufferPos, Size, Data1, Data1Size, Data2, Data2Size) then
  1856.     begin
  1857.       try
  1858.         FillChar(Data1^, Data1Size, C);
  1859.  
  1860.         if Data2 <> nil then
  1861.           FillChar(Data2^, Data2Size, C);
  1862.       finally
  1863.         FBuffer.UnLock;
  1864.       end;
  1865.       FBufferPos := (FBufferPos + DWORD(Data1Size) + DWORD(Data2Size)) mod FBufferSize;
  1866.       FWritePosition := FWritePosition + Data1Size + Data2Size;
  1867.     end;
  1868.   end;
  1869.  
  1870. var
  1871.   DataSize: Integer;
  1872. begin
  1873.   if Size >= 0 then
  1874.   begin
  1875.     Result := WriteSize;
  1876.     if FLooped then
  1877.     begin
  1878.       while WriteSize > 0 do
  1879.       begin
  1880.         DataSize := Min(Size - FWritePosition, WriteSize);
  1881.  
  1882.         WriteData(DataSize);
  1883.         FWritePosition := FWritePosition mod Size;
  1884.  
  1885.         Dec(WriteSize, DataSize);
  1886.       end;
  1887.     end else
  1888.     begin
  1889.       DataSize := Size - FWritePosition;
  1890.  
  1891.       if DataSize <= 0 then
  1892.       begin
  1893.         WriteSilence(WriteSize);
  1894.       end else
  1895.         if DataSize >= WriteSize then
  1896.         begin
  1897.           WriteData(WriteSize);
  1898.         end else
  1899.         begin
  1900.           WriteData(DataSize);
  1901.           WriteSilence(WriteSize - DataSize);
  1902.         end;
  1903.     end;
  1904.   end else
  1905.   begin
  1906.     Result := 0;
  1907.     WriteData2(WriteSize);
  1908.   end;
  1909. end;
  1910.  
  1911. {  TAudioFileStream  }
  1912.  
  1913. destructor TAudioFileStream.Destroy;
  1914. begin
  1915.   inherited Destroy;
  1916.   FWaveFileStream.Free;
  1917. end;
  1918.  
  1919. procedure TAudioFileStream.SetFileName(const Value: string);
  1920. begin
  1921.   if FFileName = Value then Exit;
  1922.  
  1923.   FFileName := Value;
  1924.  
  1925.   if FWaveFileStream <> nil then
  1926.   begin
  1927.     WaveStream := nil;
  1928.     FWaveFileStream.Free;
  1929.     FWaveFileStream := nil;
  1930.   end;
  1931.  
  1932.   if Value <> '' then
  1933.   begin
  1934.     try
  1935.       FWaveFileStream := TWaveFileStream.Create(Value, fmOpenRead or fmShareDenyWrite);
  1936.       FWaveFileStream.Open(False);
  1937.       WaveStream := FWaveFileStream;
  1938.     except
  1939.       WaveStream := nil;
  1940.       FFileName := '';
  1941.       raise;
  1942.     end;
  1943.   end;
  1944. end;
  1945.  
  1946. {  TSoundCaptureFormats  }
  1947.  
  1948. constructor TSoundCaptureFormats.Create;
  1949. begin
  1950.   inherited Create(TSoundCaptureFormat);
  1951. end;
  1952.  
  1953. function TSoundCaptureFormats.GetItem(Index: Integer): TSoundCaptureFormat;
  1954. begin
  1955.   Result := TSoundCaptureFormat(inherited Items[Index]);
  1956. end;
  1957.  
  1958. function TSoundCaptureFormats.IndexOf(ASamplesPerSec, ABitsPerSample, AChannels: Integer): Integer;
  1959. var
  1960.   i: Integer;
  1961. begin
  1962.   Result := -1;
  1963.   for i := 0 to Count - 1 do
  1964.     with Items[i] do
  1965.       if (FSamplesPerSec = ASamplesPerSec) and (FBitsPerSample = ABitsPerSample) and (FChannels = AChannels) then
  1966.       begin
  1967.         Result := i;
  1968.         Break;
  1969.       end;
  1970. end;
  1971.  
  1972. {  TSoundCaptureStream  }
  1973.  
  1974. type
  1975.   TSoundCaptureStreamNotify = class(TThread)
  1976.   private
  1977.     FCapture: TSoundCaptureStream;
  1978.     FSleepTime: Integer;
  1979.     constructor Create(Capture: TSoundCaptureStream);
  1980.     destructor Destroy; override;
  1981.     procedure Execute; override;
  1982.     procedure Update;
  1983.   end;
  1984.  
  1985. constructor TSoundCaptureStreamNotify.Create(Capture: TSoundCaptureStream);
  1986. begin
  1987.   FCapture := Capture;
  1988.  
  1989.   FCapture.FNotifyEvent := CreateEvent(nil, False, False, nil);
  1990.   FSleepTime := Min(FCapture.FBufferLength div 4, 1000 div 20);
  1991.  
  1992.   FreeOnTerminate := True;
  1993.   inherited Create(True);
  1994. end;
  1995.  
  1996. destructor TSoundCaptureStreamNotify.Destroy;
  1997. begin
  1998.   FreeOnTerminate := False;
  1999.   SetEvent(FCapture.FNotifyEvent);
  2000.  
  2001.   inherited Destroy;
  2002.  
  2003.   CloseHandle(FCapture.FNotifyEvent);
  2004.   FCapture.FNotifyThread := nil;
  2005.  
  2006.   if Assigned(FCapture.FOnFilledBuffer) then FCapture.Stop;
  2007. end;
  2008.  
  2009. procedure TSoundCaptureStreamNotify.Execute;
  2010. begin
  2011.   while WaitForSingleObject(FCapture.FNotifyEvent, FSleepTime) = WAIT_TIMEOUT do
  2012.   begin
  2013.     Synchronize(Update);
  2014.   end;
  2015. end;
  2016.  
  2017. procedure TSoundCaptureStreamNotify.Update;
  2018. begin
  2019.   if FCapture.FilledSize > 0 then
  2020.   begin
  2021.     try
  2022.       FCapture.DoFilledBuffer;
  2023.     except
  2024.       on E: Exception do
  2025.       begin
  2026.         Application.HandleException(E);
  2027.         SetEvent(FCapture.FNotifyEvent);
  2028.       end;
  2029.     end;
  2030.   end;
  2031. end;
  2032.  
  2033. constructor TSoundCaptureStream.Create(GUID: PGUID);
  2034. const
  2035.   SamplesPerSecList: array[0..6] of Integer = (8000, 11025, 22050, 33075, 44100, 48000, 96000);
  2036.   BitsPerSampleList: array[0..3] of Integer = (8, 16, 24, 32);
  2037.   ChannelsList: array[0..1] of Integer = (1, 2);
  2038. var
  2039.   ASamplesPerSec, ABitsPerSample, AChannels: Integer;
  2040.   dscbd: TDSCBufferDesc;
  2041.   TempBuffer: IDirectSoundCaptureBuffer;
  2042.   Format: TWaveFormatEx;
  2043. begin
  2044.   inherited Create;
  2045.   FBufferLength := 1000;
  2046.   FSupportedFormats := TSoundCaptureFormats.Create;
  2047.  
  2048.   if DXDirectSoundCaptureCreate(GUID, FCapture, nil) <> DS_OK then
  2049.     raise ESoundCaptureStreamError.CreateFmt(SCannotInitialized, [SDirectSoundCapture]);
  2050.  
  2051.   {  The supported format list is acquired.  }
  2052.   for ASamplesPerSec := Low(SamplesPerSecList) to High(SamplesPerSecList) do
  2053.     for ABitsPerSample := Low(BitsPerSampleList) to High(BitsPerSampleList) do
  2054.       for AChannels := Low(ChannelsList) to High(ChannelsList) do
  2055.       begin
  2056.         {  Test  }
  2057.         MakePCMWaveFormatEx(Format, SamplesPerSecList[ASamplesPerSec], BitsPerSampleList[ABitsPerSample], ChannelsList[AChannels]);
  2058.  
  2059.         FillChar(dscbd, SizeOf(dscbd), 0);
  2060.         dscbd.dwSize := SizeOf(dscbd);
  2061.         dscbd.dwBufferBytes := Format.nAvgBytesPerSec;
  2062.         dscbd.lpwfxFormat := @Format;
  2063.  
  2064.         {  If the buffer can be made,  the format of present can be used.  }
  2065.         if FCapture.CreateCaptureBuffer(dscbd, TempBuffer, nil) = DS_OK then
  2066.         begin
  2067.           TempBuffer := nil;
  2068.           with TSoundCaptureFormat.Create(FSupportedFormats) do
  2069.           begin
  2070.             FSamplesPerSec := Format.nSamplesPerSec;
  2071.             FBitsPerSample := Format.wBitsPerSample;
  2072.             FChannels := Format.nChannels;
  2073.           end;
  2074.         end;
  2075.       end;
  2076. end;
  2077.  
  2078. destructor TSoundCaptureStream.Destroy;
  2079. begin
  2080.   Stop;
  2081.   FSupportedFormats.Free;
  2082.   inherited Destroy;
  2083. end;
  2084.  
  2085. procedure TSoundCaptureStream.DoFilledBuffer;
  2086. begin
  2087.   if Assigned(FOnFilledBuffer) then FOnFilledBuffer(Self);
  2088. end;
  2089.  
  2090. class function TSoundCaptureStream.Drivers: TDirectXDrivers;
  2091. begin
  2092.   Result := EnumDirectSoundCaptureDrivers;
  2093. end;
  2094.  
  2095. function TSoundCaptureStream.GetFilledSize: Integer;
  2096. begin
  2097.   Result := GetReadSize;
  2098. end;
  2099.  
  2100. function TSoundCaptureStream.GetReadSize: Integer;
  2101. var
  2102.   CapturePosition, ReadPosition: DWORD;
  2103. begin
  2104.   if FBuffer.GetCurrentPosition(@DWORD(CapturePosition), @DWORD(ReadPosition)) = DS_OK then
  2105.   begin
  2106.     if FBufferPos <= ReadPosition then
  2107.       Result := ReadPosition - FBufferPos
  2108.     else
  2109.       Result := FBufferSize - FBufferPos + ReadPosition;
  2110.   end else
  2111.     Result := 0;
  2112. end;
  2113.  
  2114. function TSoundCaptureStream.ReadWave(var Buffer; Count: Integer): Integer;
  2115. var
  2116.   Size: Integer;
  2117.   Data1, Data2: Pointer;
  2118.   Data1Size, Data2Size: DWORD;
  2119.   C: Byte;
  2120. begin
  2121.   if not FCapturing then
  2122.     Start;
  2123.   Data1 := nil;
  2124.   Data2 := nil;
  2125.   Result := 0;
  2126.   while Result < Count do
  2127.   begin
  2128.     Size := Min(Count - Result, GetReadSize);
  2129.     if Size > 0 then
  2130.     begin
  2131.       if FBuffer.Lock(FBufferPos, Size, Data1, {$IFNDEF DX7}@{$ENDIF}Data1Size,
  2132.         Data2, {$IFNDEF DX7}@{$ENDIF}Data2Size, 0) = DS_OK then
  2133.       begin
  2134.         Move(Data1^, Pointer(Integer(@Buffer) + Result)^, Data1Size);
  2135.         Result := Result + Integer(Data1Size);
  2136.  
  2137.         if Data2 <> nil then
  2138.         begin
  2139.           Move(Data2^, Pointer(Integer(@Buffer) + Result)^, Data2Size);
  2140.           Result := Result + Integer(Data1Size);
  2141.         end;
  2142.  
  2143.         FBuffer.UnLock(Data1, Data1Size, Data2, Data2Size);
  2144.         FBufferPos := (FBufferPos + Data1Size + Data2Size) mod FBufferSize;
  2145.       end else
  2146.         Break;
  2147.     end;
  2148.     if Result < Count then Sleep(50);
  2149.   end;
  2150.  
  2151.   case Format^.wBitsPerSample of
  2152.     8: C := $80;
  2153.     16: C := $00;
  2154.   else
  2155.     C := $00;
  2156.   end;
  2157.  
  2158.   FillChar(Pointer(Integer(@Buffer) + Result)^, Count - Result, C);
  2159.   Result := Count;
  2160. end;
  2161.  
  2162. procedure TSoundCaptureStream.SetBufferLength(Value: Integer);
  2163. begin
  2164.   FBufferLength := Max(Value, 0);
  2165. end;
  2166.  
  2167. procedure TSoundCaptureStream.SetOnFilledBuffer(Value: TNotifyEvent);
  2168. begin
  2169.   if CompareMem(@TMethod(FOnFilledBuffer), @TMethod(Value), SizeOf(TMethod)) then Exit;
  2170.  
  2171.   if FCapturing then
  2172.   begin
  2173.     if Assigned(FOnFilledBuffer) then
  2174.       FNotifyThread.Free;
  2175.  
  2176.     FOnFilledBuffer := Value;
  2177.  
  2178.     if Assigned(FOnFilledBuffer) then
  2179.     begin
  2180.       FNotifyThread := TSoundCaptureStreamNotify.Create(Self);
  2181.       FNotifyThread.Resume;
  2182.     end;
  2183.   end else
  2184.     FOnFilledBuffer := Value;
  2185. end;
  2186.  
  2187. procedure TSoundCaptureStream.Start;
  2188. var
  2189.   dscbd: TDSCBufferDesc;
  2190. begin
  2191.   Stop;
  2192.   try
  2193.     FCapturing := True;
  2194.  
  2195.     FormatSize := SizeOf(TWaveFormatEx);
  2196.     with FSupportedFormats[CaptureFormat] do
  2197.       MakePCMWaveFormatEx(Format^, SamplesPerSec, BitsPerSample, Channels);
  2198.  
  2199.     FBufferSize := Max(MulDiv(Format^.nAvgBytesPerSec, FBufferLength, 1000), 8000);
  2200.  
  2201.     FillChar(dscbd, SizeOf(dscbd), 0);
  2202.     dscbd.dwSize := SizeOf(dscbd);
  2203.     dscbd.dwBufferBytes := FBufferSize;
  2204.     dscbd.lpwfxFormat := Format;
  2205.  
  2206.     if FCapture.CreateCaptureBuffer(dscbd, FBuffer, nil) <> DS_OK then
  2207.       raise ESoundCaptureStreamError.CreateFmt(SCannotMade, [SDirectSoundCaptureBuffer]);
  2208.  
  2209.     FBufferPos := 0;
  2210.  
  2211.     FBuffer.Start(DSCBSTART_LOOPING);
  2212.  
  2213.     if Assigned(FOnFilledBuffer) then
  2214.     begin
  2215.       FNotifyThread := TSoundCaptureStreamNotify.Create(Self);
  2216.       FNotifyThread.Resume;
  2217.     end;
  2218.   except
  2219.     Stop;
  2220.     raise;
  2221.   end;
  2222. end;
  2223.  
  2224. procedure TSoundCaptureStream.Stop;
  2225. begin
  2226.   if FCapturing then
  2227.   begin
  2228.     FNotifyThread.Free;
  2229.     FCapturing := False;
  2230.     if FBuffer <> nil then
  2231.       FBuffer.Stop;
  2232.     FBuffer := nil;
  2233.   end;
  2234. end;
  2235.  
  2236. {  TSoundEngine  }
  2237.  
  2238. constructor TSoundEngine.Create(ADSound: TDirectSound);
  2239. begin
  2240.   inherited Create;
  2241.   FDSound := ADSound;
  2242.   FEnabled := True;
  2243.  
  2244.   FEffectList := TList.Create;
  2245.   FTimer := TTimer.Create(nil);
  2246.   FTimer.Interval := 500;
  2247.   FTimer.OnTimer := TimerEvent;
  2248. end;
  2249.  
  2250. destructor TSoundEngine.Destroy;
  2251. begin
  2252.   Clear;
  2253.   FTimer.Free;
  2254.   FEffectList.Free;
  2255.   inherited Destroy;
  2256. end;
  2257.  
  2258. procedure TSoundEngine.Clear;
  2259. var
  2260.   i: Integer;
  2261. begin
  2262.   for i := EffectCount - 1 downto 0 do
  2263.     Effects[i].Free;
  2264.   FEffectList.Clear;
  2265. end;
  2266.  
  2267. procedure TSoundEngine.EffectFile(const Filename: string; Loop, Wait: Boolean);
  2268. var
  2269.   Stream: TFileStream;
  2270. begin
  2271.   Stream := TFileStream.Create(Filename, fmOpenRead);
  2272.   try
  2273.     EffectStream(Stream, Loop, Wait);
  2274.   finally
  2275.     Stream.Free;
  2276.   end;
  2277. end;
  2278.  
  2279. procedure TSoundEngine.EffectStream(Stream: TStream; Loop, Wait: Boolean);
  2280. var
  2281.   Wave: TWave;
  2282. begin
  2283.   Wave := TWave.Create;
  2284.   try
  2285.     Wave.LoadfromStream(Stream);
  2286.     EffectWave(Wave, Loop, Wait);
  2287.   finally
  2288.     Wave.Free;
  2289.   end;
  2290. end;
  2291.  
  2292. procedure TSoundEngine.EffectWave(Wave: TWave; Loop, Wait: Boolean);
  2293. var
  2294.   Buffer: TDirectSoundBuffer;
  2295. begin
  2296.   if not FEnabled then Exit;
  2297.  
  2298.   if Wait then
  2299.   begin
  2300.     Buffer := TDirectSoundBuffer.Create(FDSound);
  2301.     try
  2302.       Buffer.LoadFromWave(Wave);
  2303.       Buffer.Play(False);
  2304.       while Buffer.Playing do
  2305.         Sleep(1);
  2306.     finally
  2307.       Buffer.Free;
  2308.     end;
  2309.   end else
  2310.   begin
  2311.     Buffer := TDirectSoundBuffer.Create(FDSound);
  2312.     try
  2313.       Buffer.LoadFromWave(Wave);
  2314.       Buffer.Play(Loop);
  2315.     except
  2316.       Buffer.Free;
  2317.       raise;
  2318.     end;
  2319.     FEffectList.Add(Buffer);
  2320.   end;
  2321. end;
  2322.  
  2323. function TSoundEngine.GetEffect(Index: Integer): TDirectSoundBuffer;
  2324. begin
  2325.   Result := TDirectSoundBuffer(FEffectList[Index]);
  2326. end;
  2327.  
  2328. function TSoundEngine.GetEffectCount: Integer;
  2329. begin
  2330.   Result := FEffectList.Count;
  2331. end;
  2332.  
  2333. procedure TSoundEngine.SetEnabled(Value: Boolean);
  2334. var
  2335.   i: Integer;
  2336. begin
  2337.   for i := EffectCount - 1 downto 0 do
  2338.     Effects[i].Free;
  2339.   FEffectList.Clear;
  2340.  
  2341.   FEnabled := Value;
  2342.   FTimer.Enabled := Value;
  2343. end;
  2344.  
  2345. procedure TSoundEngine.TimerEvent(Sender: TObject);
  2346. var
  2347.   i: Integer;
  2348. begin
  2349.   for i := EffectCount - 1 downto 0 do
  2350.     if not TDirectSoundBuffer(FEffectList[i]).Playing then
  2351.     begin
  2352.       TDirectSoundBuffer(FEffectList[i]).Free;
  2353.       FEffectList.Delete(i);
  2354.     end;
  2355. end;
  2356.  
  2357. {  TCustomDXSound  }
  2358.  
  2359. type
  2360.   TDXSoundDirectSound = class(TDirectSound)
  2361.   private
  2362.     FDXSound: TCustomDXSound;
  2363.   protected
  2364.     procedure DoRestoreBuffer; override;
  2365.   end;
  2366.  
  2367. procedure TDXSoundDirectSound.DoRestoreBuffer;
  2368. begin
  2369.   inherited DoRestoreBuffer;
  2370.   FDXSound.Restore;
  2371. end;
  2372.  
  2373. constructor TCustomDXSound.Create(AOwner: TComponent);
  2374. begin
  2375.   FNotifyEventList := TList.Create;
  2376.   inherited Create(AOwner);
  2377.   FAutoInitialize := True;
  2378.   Options := [];
  2379. end;
  2380.  
  2381. destructor TCustomDXSound.Destroy;
  2382. begin
  2383.   Finalize;
  2384.   NotifyEventList(dsntDestroying);
  2385.   FNotifyEventList.Free;
  2386.   inherited Destroy;
  2387. end;
  2388.  
  2389. type
  2390.   PDXSoundNotifyEvent = ^TDXSoundNotifyEvent;
  2391.  
  2392. procedure TCustomDXSound.RegisterNotifyEvent(NotifyEvent: TDXSoundNotifyEvent);
  2393. var
  2394.   Event: PDXSoundNotifyEvent;
  2395. begin
  2396.   UnRegisterNotifyEvent(NotifyEvent);
  2397.  
  2398.   New(Event);
  2399.   Event^ := NotifyEvent;
  2400.   FNotifyEventList.Add(Event);
  2401.  
  2402.   if Initialized then
  2403.   begin
  2404.     NotifyEvent(Self, dsntInitialize);
  2405.     NotifyEvent(Self, dsntRestore);
  2406.   end;
  2407. end;
  2408.  
  2409. procedure TCustomDXSound.UnRegisterNotifyEvent(NotifyEvent: TDXSoundNotifyEvent);
  2410. var
  2411.   Event: PDXSoundNotifyEvent;
  2412.   i: Integer;
  2413. begin
  2414.   for i := 0 to FNotifyEventList.Count - 1 do
  2415.   begin
  2416.     Event := FNotifyEventList[i];
  2417.     if (TMethod(Event^).Code = TMethod(NotifyEvent).Code) and
  2418.       (TMethod(Event^).Data = TMethod(NotifyEvent).Data) then
  2419.     begin
  2420.       Dispose(Event);
  2421.       FNotifyEventList.Delete(i);
  2422.  
  2423.       if Initialized then
  2424.         NotifyEvent(Self, dsntFinalize);
  2425.  
  2426.       Break;
  2427.     end;
  2428.   end;
  2429. end;
  2430.  
  2431. procedure TCustomDXSound.NotifyEventList(NotifyType: TDXSoundNotifyType);
  2432. var
  2433.   i: Integer;
  2434. begin
  2435.   for i := FNotifyEventList.Count - 1 downto 0 do
  2436.     PDXSoundNotifyEvent(FNotifyEventList[i])^(Self, NotifyType);
  2437. end;
  2438.  
  2439. procedure TCustomDXSound.FormWndProc(var Message: TMessage; DefWindowProc: TWndMethod);
  2440. begin
  2441.   case Message.Msg of
  2442.     WM_CREATE:
  2443.       begin
  2444.         DefWindowProc(Message);
  2445.         SetForm(FForm);
  2446.         Exit;
  2447.       end;
  2448.   end;
  2449.   DefWindowProc(Message);
  2450. end;
  2451.  
  2452. class function TCustomDXSound.Drivers: TDirectXDrivers;
  2453. begin
  2454.   Result := EnumDirectSoundDrivers;
  2455. end;
  2456.  
  2457. procedure TCustomDXSound.DoFinalize;
  2458. begin
  2459.   if Assigned(FOnFinalize) then FOnFinalize(Self);
  2460. end;
  2461.  
  2462. procedure TCustomDXSound.DoInitialize;
  2463. begin
  2464.   if Assigned(FOnInitialize) then FOnInitialize(Self);
  2465. end;
  2466.  
  2467. procedure TCustomDXSound.DoInitializing;
  2468. begin
  2469.   if Assigned(FOnInitializing) then FOnInitializing(Self);
  2470. end;
  2471.  
  2472. procedure TCustomDXSound.DoRestore;
  2473. begin
  2474.   if Assigned(FOnRestore) then FOnRestore(Self);
  2475. end;
  2476.  
  2477. procedure TCustomDXSound.Finalize;
  2478. begin
  2479.   if FInternalInitialized then
  2480.   begin
  2481.     try
  2482.       FSubClass.Free; FSubClass := nil;
  2483.  
  2484.       try
  2485.         if FCalledDoInitialize then
  2486.         begin
  2487.           FCalledDoInitialize := False;
  2488.           DoFinalize;
  2489.         end;
  2490.       finally
  2491.         NotifyEventList(dsntFinalize);
  2492.       end;
  2493.     finally
  2494.       FInitialized := False;
  2495.       FInternalInitialized := False;
  2496.  
  2497.       SetOptions(FOptions);
  2498.  
  2499.       FPrimary.Free; FPrimary := nil;
  2500.       FDSound.Free; FDSound := nil;
  2501.     end;
  2502.   end;
  2503. end;
  2504.  
  2505. procedure TCustomDXSound.Initialize;
  2506. const
  2507.   PrimaryDesc: TDSBufferDesc = (
  2508.     dwSize: SizeOf(PrimaryDesc);
  2509.     dwFlags: DSBCAPS_PRIMARYBUFFER);
  2510. var
  2511.   Component: TComponent;
  2512. begin
  2513.   Finalize;
  2514.  
  2515.   Component := Owner;
  2516.   while (Component <> nil) and (not (Component is TCustomForm)) do
  2517.     Component := Component.Owner;
  2518.   if Component = nil then
  2519.     raise EDXSoundError.Create(SNoForm);
  2520.  
  2521.   NotifyEventList(dsntInitializing);
  2522.   DoInitializing;
  2523.  
  2524.   FInternalInitialized := True;
  2525.   try
  2526.     {  DirectSound initialization.  }
  2527.     FDSound := TDXSoundDirectSound.Create(Driver);
  2528.     TDXSoundDirectSound(FDSound).FDXSound := Self;
  2529.  
  2530.     FDSound.FGlobalFocus := soGlobalFocus in FNowOptions;
  2531.  
  2532.     {  Primary buffer made.  }
  2533.     FPrimary := TDirectSoundBuffer.Create(FDSound);
  2534.     if not FPrimary.CreateBuffer(PrimaryDesc) then
  2535.       raise EDXSoundError.CreateFmt(SCannotMade, [SDirectSoundPrimaryBuffer]);
  2536.  
  2537.     FInitialized := True;
  2538.  
  2539.     SetForm(TCustomForm(Component));
  2540.   except
  2541.     Finalize;
  2542.     raise;
  2543.   end;
  2544.  
  2545.   NotifyEventList(dsntInitialize);
  2546.  
  2547.   FCalledDoInitialize := True; DoInitialize;
  2548.  
  2549.   Restore;
  2550. end;
  2551.  
  2552. procedure TCustomDXSound.Loaded;
  2553. begin
  2554.   inherited Loaded;
  2555.  
  2556.   if FAutoInitialize and (not (csDesigning in ComponentState)) then
  2557.   begin
  2558.     try
  2559.       Initialize;
  2560.     except
  2561.       on E: EDirectSoundError do ;
  2562.     else raise;
  2563.     end;
  2564.   end;
  2565. end;
  2566.  
  2567. procedure TCustomDXSound.Restore;
  2568. begin
  2569.   if FInitialized then
  2570.   begin
  2571.     NotifyEventList(dsntRestore);
  2572.     DoRestore;
  2573.   end;
  2574. end;
  2575.  
  2576. procedure TCustomDXSound.SetDriver(Value: PGUID);
  2577. begin
  2578.   if not IsBadHugeReadPtr(Value, SizeOf(TGUID)) then
  2579.   begin
  2580.     FDriverGUID := Value^;
  2581.     FDriver := @FDriverGUID;
  2582.   end else
  2583.     FDriver := Value;
  2584. end;
  2585.  
  2586. procedure TCustomDXSound.SetForm(Value: TCustomForm);
  2587. var
  2588.   Level: Integer;
  2589. begin
  2590.   FForm := Value;
  2591.  
  2592.   FSubClass.Free;
  2593.   FSubClass := TControlSubClass.Create(FForm, FormWndProc);
  2594.  
  2595.   if FInitialized then
  2596.   begin
  2597.     if soExclusive in FNowOptions then
  2598.       Level := DSSCL_EXCLUSIVE
  2599.     else
  2600.       Level := DSSCL_NORMAL;
  2601.  
  2602.     FDSound.DXResult := FDSound.ISound.SetCooperativeLevel(FForm.Handle, Level);
  2603.   end;
  2604. end;
  2605.  
  2606. procedure TCustomDXSound.SetOptions(Value: TDXSoundOptions);
  2607. const
  2608.   DXSoundOptions = [soGlobalFocus, soStickyFocus, soExclusive];
  2609.   InitOptions: TDXSoundOptions = [soExclusive];
  2610. var
  2611.   OldOptions: TDXSoundOptions;
  2612. begin
  2613.   FOptions := Value;
  2614.  
  2615.   if Initialized then
  2616.   begin
  2617.     OldOptions := FNowOptions;
  2618.  
  2619.     FNowOptions := (FNowOptions - (DXSoundOptions - InitOptions)) +
  2620.       (Value - InitOptions);
  2621.  
  2622.     FDSound.FGlobalFocus := soGlobalFocus in FNowOptions;
  2623.     FDSound.FStickyFocus := soStickyFocus in FNowOptions;
  2624.   end else
  2625.     FNowOptions := FOptions;
  2626. end;
  2627.  
  2628. {  TWaveCollectionItem  }
  2629.  
  2630. constructor TWaveCollectionItem.Create(Collection: TCollection);
  2631. begin
  2632.   inherited Create(Collection);
  2633.   FWave := TWave.Create;
  2634.   FBufferList := TList.Create;
  2635. end;
  2636.  
  2637. destructor TWaveCollectionItem.Destroy;
  2638. begin
  2639.   Finalize;
  2640.   FWave.Free;
  2641.   FBufferList.Free;
  2642.   inherited Destroy;
  2643. end;
  2644.  
  2645. procedure TWaveCollectionItem.Assign(Source: TPersistent);
  2646. var
  2647.   PrevInitialized: Boolean;
  2648. begin
  2649.   if Source is TWaveCollectionItem then
  2650.   begin
  2651.     PrevInitialized := Initialized;
  2652.     Finalize;
  2653.  
  2654.     FLooped := TWaveCollectionItem(Source).FLooped;
  2655.     Name := TWaveCollectionItem(Source).Name;
  2656.     FMaxPlayingCount := TWaveCollectionItem(Source).FMaxPlayingCount;
  2657.  
  2658.     FFrequency := TWaveCollectionItem(Source).FFrequency;
  2659.     FPan := TWaveCollectionItem(Source).FPan;
  2660.     FVolume := TWaveCollectionItem(Source).FVolume;
  2661.  
  2662.     FWave.Assign(TWaveCollectionItem(Source).FWave);
  2663.  
  2664.     if PrevInitialized then
  2665.       Restore;
  2666.   end
  2667.   else
  2668.     inherited Assign(Source);
  2669. end;
  2670.  
  2671. function TWaveCollectionItem.GetPlaying: boolean;
  2672. var
  2673.   Buffer: TDirectSoundBuffer;
  2674.   index: integer;
  2675. begin
  2676.   Result := False;
  2677.   if not FInitialized then Exit;
  2678.   Assert(GetBuffer <> nil);
  2679.   Assert(FBufferList <> nil);
  2680.   if FLooped then
  2681.   begin
  2682.     Buffer := GetBuffer;
  2683.     Assert(Buffer <> nil);
  2684.     Result := Buffer.Playing;
  2685.   end
  2686.   else
  2687.   begin
  2688.     for index := 0 to FBufferList.Count - 1 do
  2689.     begin
  2690.       Result := TDirectSoundBuffer(FBufferList[index]).Playing;
  2691.       if Result then
  2692.         Break;
  2693.     end;
  2694.   end;
  2695. end; {GetPlaying}
  2696.  
  2697. function TWaveCollectionItem.GetBuffer: TDirectSoundBuffer;
  2698. begin
  2699.   if FInitialized and (FBuffer = nil) then
  2700.     Restore;
  2701.   Result := FBuffer;
  2702. end;
  2703.  
  2704. function TWaveCollectionItem.GetWaveCollection: TWaveCollection;
  2705. begin
  2706.   Result := Collection as TWaveCollection;
  2707. end;
  2708.  
  2709. procedure TWaveCollectionItem.Finalize;
  2710. var
  2711.   i: Integer;
  2712. begin
  2713.   if not FInitialized then Exit;
  2714.   FInitialized := False;
  2715.  
  2716.   for i := 0 to FBufferList.Count - 1 do
  2717.     TDirectSoundBuffer(FBufferList[i]).Free;
  2718.   FBufferList.Clear;
  2719.   FBuffer.Free; FBuffer := nil;
  2720. end;
  2721.  
  2722. procedure TWaveCollectionItem.Initialize;
  2723. begin
  2724.   Finalize;
  2725.   FInitialized := WaveCollection.Initialized;
  2726. end;
  2727.  
  2728. function TWaveCollectionItem.CreateBuffer: TDirectSoundBuffer;
  2729. begin
  2730.   Result := nil;
  2731.   if GetBuffer = nil then Exit;
  2732.  
  2733.   Result := TDirectSoundBuffer.Create(WaveCollection.DXSound.DSound);
  2734.   try
  2735.     Result.Assign(GetBuffer);
  2736.   except
  2737.     Result.Free;
  2738.     raise;
  2739.   end;
  2740. end;
  2741.  
  2742. procedure TWaveCollectionItem.Play(Wait: Boolean);
  2743. var
  2744.   NewBuffer: TDirectSoundBuffer;
  2745.   i: Integer;
  2746. begin
  2747.   if not FInitialized then Exit;
  2748.  
  2749.   if FLooped then
  2750.   begin
  2751.     GetBuffer.Stop;
  2752.     GetBuffer.Position := 0;
  2753.     GetBuffer.Play(True);
  2754.   end
  2755.   else
  2756.   begin
  2757.     NewBuffer := nil;
  2758.     for i := 0 to FBufferList.Count - 1 do
  2759.       if not TDirectSoundBuffer(FBufferList[i]).Playing then
  2760.       begin
  2761.         NewBuffer := FBufferList[i];
  2762.         Break;
  2763.       end;
  2764.  
  2765.     if NewBuffer = nil then
  2766.     begin
  2767.       if FMaxPlayingCount = 0 then
  2768.       begin
  2769.         NewBuffer := CreateBuffer;
  2770.         if NewBuffer = nil then Exit;
  2771.  
  2772.         FBufferList.Add(NewBuffer);
  2773.       end
  2774.       else
  2775.       begin
  2776.         if FBufferList.Count < FMaxPlayingCount then
  2777.         begin
  2778.           NewBuffer := CreateBuffer;
  2779.           if NewBuffer = nil then Exit;
  2780.  
  2781.           FBufferList.Add(NewBuffer);
  2782.         end
  2783.         else
  2784.         begin
  2785.           NewBuffer := FBufferList[0];
  2786.           FBufferList.Move(0, FBufferList.Count - 1);
  2787.         end;
  2788.       end;
  2789.     end;
  2790.  
  2791.     NewBuffer.Stop;
  2792.     NewBuffer.Position := 0;
  2793.     NewBuffer.Frequency := FFrequency;
  2794.     NewBuffer.Pan := FPan;
  2795.     NewBuffer.Volume := FVolume;
  2796.     NewBuffer.Play(False);
  2797.  
  2798.     if Wait then
  2799.     begin
  2800.       while NewBuffer.Playing do
  2801.         Sleep(10);
  2802.     end;
  2803.   end;
  2804. end;
  2805.  
  2806. procedure TWaveCollectionItem.Restore;
  2807. begin
  2808.   if FWave.Size = 0 then Exit;
  2809.  
  2810.   if not FInitialized then
  2811.   begin
  2812.     if WaveCollection.Initialized then
  2813.       Initialize;
  2814.     if not FInitialized then Exit;
  2815.   end;
  2816.  
  2817.   if FBuffer = nil then
  2818.     FBuffer := TDirectSoundBuffer.Create(WaveCollection.DXSound.DSound);
  2819.  
  2820.   FBuffer.LoadFromWave(FWave);
  2821.   FBuffer.Frequency := FFrequency;
  2822.   FBuffer.Pan := FPan;
  2823.   FBuffer.Volume := FVolume;
  2824. end;
  2825.  
  2826. procedure TWaveCollectionItem.Stop;
  2827. var
  2828.   i: Integer;
  2829. begin
  2830.   if not FInitialized then Exit;
  2831.  
  2832.   FBuffer.Stop;
  2833.   for i := 0 to FBufferList.Count - 1 do
  2834.     TDirectSoundBuffer(FBufferList[i]).Stop;
  2835. end;
  2836.  
  2837. procedure TWaveCollectionItem.SetFrequency(Value: Integer);
  2838. begin
  2839.   FFrequency := Value;
  2840.   if FInitialized then
  2841.     GetBuffer.Frequency := Value;
  2842. end;
  2843.  
  2844. procedure TWaveCollectionItem.SetLooped(Value: Boolean);
  2845. begin
  2846.   if FLooped <> Value then
  2847.   begin
  2848.     Stop;
  2849.     FLooped := Value;
  2850.   end;
  2851. end;
  2852.  
  2853. procedure TWaveCollectionItem.SetMaxPlayingCount(Value: Integer);
  2854. var
  2855.   i: Integer;
  2856. begin
  2857.   if Value < 0 then Value := 0;
  2858.  
  2859.   if FMaxPlayingCount <> Value then
  2860.   begin
  2861.     FMaxPlayingCount := Value;
  2862.  
  2863.     if FInitialized then
  2864.     begin
  2865.       for i := 0 to FBufferList.Count - 1 do
  2866.         TDirectSoundBuffer(FBufferList[i]).Free;
  2867.       FBufferList.Clear;
  2868.     end;
  2869.   end;
  2870. end;
  2871.  
  2872. procedure TWaveCollectionItem.SetPan(Value: Integer);
  2873. begin
  2874.   FPan := Value;
  2875.   if FInitialized then
  2876.     GetBuffer.Pan := Value;
  2877. end;
  2878.  
  2879. procedure TWaveCollectionItem.SetVolume(Value: Integer);
  2880. begin
  2881.   FVolume := Value;
  2882.   if FInitialized then
  2883.     GetBuffer.Volume := Value;
  2884. end;
  2885.  
  2886. procedure TWaveCollectionItem.SetWave(Value: TWave);
  2887. begin
  2888.   FWave.Assign(Value);
  2889. end;
  2890.  
  2891. {  TWaveCollection  }
  2892.  
  2893. constructor TWaveCollection.Create(AOwner: TPersistent);
  2894. begin
  2895.   inherited Create(TWaveCollectionItem);
  2896.   FOwner := AOwner;
  2897. end;
  2898.  
  2899. function TWaveCollection.GetItem(Index: Integer): TWaveCollectionItem;
  2900. begin
  2901.   Result := TWaveCollectionItem(inherited Items[Index]);
  2902. end;
  2903.  
  2904. function TWaveCollection.GetOwner: TPersistent;
  2905. begin
  2906.   Result := FOwner;
  2907. end;
  2908.  
  2909. function TWaveCollection.Find(const Name: string): TWaveCollectionItem;
  2910. var
  2911.   i: Integer;
  2912. begin
  2913.   i := IndexOf(Name);
  2914.   if i = -1 then
  2915.     raise EWaveCollectionError.CreateFmt(SWaveNotFound, [Name]);
  2916.   Result := Items[i];
  2917. end;
  2918.  
  2919. procedure TWaveCollection.Finalize;
  2920. var
  2921.   i: Integer;
  2922. begin
  2923.   for i := 0 to Count - 1 do
  2924.     Items[i].Finalize;
  2925.   FDXSound := nil;
  2926. end;
  2927.  
  2928. procedure TWaveCollection.Initialize(DXSound: TCustomDXSound);
  2929. var
  2930.   i: Integer;
  2931. begin
  2932.   Finalize;
  2933.   FDXSound := DXSound;
  2934.   for i := 0 to Count - 1 do
  2935.     Items[i].Initialize;
  2936. end;
  2937.  
  2938. function TWaveCollection.Initialized: Boolean;
  2939. begin
  2940.   Result := (FDXSound <> nil) and (FDXSound.Initialized);
  2941. end;
  2942.  
  2943. procedure TWaveCollection.Restore;
  2944. var
  2945.   i: Integer;
  2946. begin
  2947.   for i := 0 to Count - 1 do
  2948.     Items[i].Restore;
  2949. end;
  2950.  
  2951. type
  2952.   TWaveCollectionComponent = class(TComponent)
  2953.   private
  2954.     FList: TWaveCollection;
  2955.   published
  2956.     property List: TWaveCollection read FList write FList;
  2957.   end;
  2958.  
  2959. procedure TWaveCollection.LoadFromFile(const FileName: string);
  2960. var
  2961.   Stream: TFileStream;
  2962. begin
  2963.   Stream := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
  2964.   try
  2965.     LoadFromStream(Stream);
  2966.   finally
  2967.     Stream.Free;
  2968.   end;
  2969. end;
  2970.  
  2971. procedure TWaveCollection.LoadFromStream(Stream: TStream);
  2972. var
  2973.   Component: TWaveCollectionComponent;
  2974. begin
  2975.   Clear;
  2976.   Component := TWaveCollectionComponent.Create(nil);
  2977.   try
  2978.     Component.FList := Self;
  2979.     Stream.ReadComponentRes(Component);
  2980.  
  2981.     if Initialized then
  2982.     begin
  2983.       Initialize(FDXSound);
  2984.       Restore;
  2985.     end;
  2986.   finally
  2987.     Component.Free;
  2988.   end;
  2989. end;
  2990.  
  2991. procedure TWaveCollection.SaveToFile(const FileName: string);
  2992. var
  2993.   Stream: TFileStream;
  2994. begin
  2995.   Stream := TFileStream.Create(FileName, fmCreate);
  2996.   try
  2997.     SaveToStream(Stream);
  2998.   finally
  2999.     Stream.Free;
  3000.   end;
  3001. end;
  3002.  
  3003. procedure TWaveCollection.SaveToStream(Stream: TStream);
  3004. var
  3005.   Component: TWaveCollectionComponent;
  3006. begin
  3007.   Component := TWaveCollectionComponent.Create(nil);
  3008.   try
  3009.     Component.FList := Self;
  3010.     Stream.WriteComponentRes('DelphiXWaveCollection', Component);
  3011.   finally
  3012.     Component.Free;
  3013.   end;
  3014. end;
  3015.  
  3016. {  TCustomDXWaveList  }
  3017.  
  3018. constructor TCustomDXWaveList.Create(AOwner: TComponent);
  3019. begin
  3020.   inherited Create(AOwner);
  3021.   FItems := TWaveCollection.Create(Self);
  3022. end;
  3023.  
  3024. destructor TCustomDXWaveList.Destroy;
  3025. begin
  3026.   DXSound := nil;
  3027.   FItems.Free;
  3028.   inherited Destroy;
  3029. end;
  3030.  
  3031. procedure TCustomDXWaveList.Notification(AComponent: TComponent; Operation: TOperation);
  3032. begin
  3033.   inherited Notification(AComponent, Operation);
  3034.   if (Operation = opRemove) and (DXSound = AComponent) then
  3035.     DXSound := nil;
  3036. end;
  3037.  
  3038. procedure TCustomDXWaveList.DXSoundNotifyEvent(Sender: TCustomDXSound;
  3039.   NotifyType: TDXSoundNotifyType);
  3040. begin
  3041.   case NotifyType of
  3042.     dsntDestroying: DXSound := nil;
  3043.     dsntInitialize: FItems.Initialize(Sender);
  3044.     dsntFinalize: FItems.Finalize;
  3045.     dsntRestore: FItems.Restore;
  3046.   end;
  3047. end;
  3048.  
  3049. procedure TCustomDXWaveList.SetDXSound(Value: TCustomDXSound);
  3050. begin
  3051.   if FDXSound <> nil then
  3052.     FDXSound.UnRegisterNotifyEvent(DXSoundNotifyEvent);
  3053.  
  3054.   FDXSound := Value;
  3055.  
  3056.   if FDXSound <> nil then
  3057.     FDXSound.RegisterNotifyEvent(DXSoundNotifyEvent);
  3058. end;
  3059.  
  3060. procedure TCustomDXWaveList.SetItems(Value: TWaveCollection);
  3061. begin
  3062.   FItems.Assign(Value);
  3063. end;
  3064.  
  3065. {(c) 2006 Jaro Benes, Play midi from memory module}
  3066.  
  3067. { TMusicDataProp }
  3068.  
  3069. type
  3070.   TMidiDataHeader = packed record
  3071.     Size: Integer;
  3072.   end;
  3073.  
  3074. procedure TMusicDataProp.DefineProperties(Filer: TFiler);
  3075. begin
  3076.   inherited DefineProperties(Filer);
  3077.   Filer.DefineBinaryProperty('Midi', ReadMidiData, WriteMidiData, Length(Self.FMusicData) <> 0);
  3078. end;
  3079.  
  3080. function TMusicDataProp.GetMusicData: string;
  3081. begin
  3082.   SetLength(Result, Length(FMusicData));
  3083.   if Length(FMusicData) <> 0 then
  3084.     Move(FMusicData[1], Result[1], Length(FMusicData));
  3085. end;
  3086.  
  3087. procedure TMusicDataProp.ReadMidiData(Stream: TStream);
  3088. var
  3089.   Header: TMidiDataHeader;
  3090. begin
  3091.   Stream.ReadBuffer(Header, SizeOf(Header));
  3092.   SetLength(FMusicData, Header.Size);
  3093.   Stream.ReadBuffer(FMusicData[1], Header.Size);
  3094. end;
  3095.  
  3096. procedure TMusicDataProp.SetMusicData(const Value: string);
  3097. begin
  3098.   SetLength(FMusicData, Length(Value));
  3099.   if Length(Value) <> 0 then
  3100.     Move(Value[1], FMusicData[1], Length(Value));
  3101. end;
  3102.  
  3103. procedure TMusicDataProp.WriteMidiData(Stream: TStream);
  3104. var
  3105.   Header: TMidiDataHeader;
  3106. begin
  3107.   Header.Size := Length(FMusicData);
  3108.   Stream.WriteBuffer(Header, SizeOf(Header));
  3109.   Stream.WriteBuffer(FMusicData[1], Header.Size);
  3110. end;
  3111.  
  3112. { TMusicListCollectionItem }
  3113.  
  3114. procedure TMusicListCollectionItem.Load;
  3115. var
  3116.   MidiFilelength: Integer;
  3117. begin
  3118.   // kdyby nahodou uz nejaky existoval tak ho znic
  3119.   if FDirectMusicSegment <> nil then
  3120.     FDirectMusicSegment := nil;
  3121.   ZeroMemory(@FMusicObjDesc, SizeOf(TDMUS_OBJECTDESC));
  3122.   // tohle je popisek parametru - chceme hrat z pameti
  3123.   with FMusicObjDesc do
  3124.   begin
  3125.     dwsize := SizeOf(TDMUS_OBJECTDESC);
  3126.     guidclass := CLSID_DirectMusicSegment;
  3127.     //tohle jen pokud je to ze souboru
  3128.     //dwvaliddata := DMUS_OBJ_CLASS or DMUS_OBJ_FULLPATH or DMUS_OBJ_FILENAME;
  3129.     dwvaliddata := DMUS_OBJ_CLASS or DMUS_OBJ_MEMORY or DMUS_OBJ_LOADED;
  3130.     pbMemData := @FMusicDataProp.FMusicData[1];
  3131.     llMemLength := Length(FMusicDataProp.FMusicData);
  3132.   end;
  3133.   if FDirectMusicLoader.GetObject(FMusicObjDesc, IID_IDirectMusicSegment, FDirectMusicSegment) <> dm_ok then
  3134.     raise EDXMusicError.Create('Failed to Get object for Direct music'); ;
  3135.   if FDirectMusicSegment.setParam(GUID_StandardMidiFile, $FFFFFFFF, 0, 0, Pointer(FDirectMusicPerformance)) <> dm_ok then
  3136.     raise EDXMusicError.Create('Failed to Set param for Direct music'); ;
  3137.   if FDirectMusicSegment.setParam(GUID_Download, $FFFFFFFF, 0, 0, Pointer(FDirectMusicPerformance)) <> dm_ok then
  3138.     raise EDXMusicError.Create('Failed to Set param for Direct music'); ;
  3139.   FDirectMusicSegment.GetLength(MidiFilelength);
  3140.   if (FActualDuration < MidiFilelength) and (FActualDuration > 0) then
  3141.     FDirectMusicSegment.SetLength(FActualDuration);
  3142.   if FActualStartPoint < MidiFilelength - FActualDuration then
  3143.     FDirectMusicSegment.SetStartpoint(FActualStartPoint);
  3144.   // jak opakovat
  3145.   FDirectMusicSegment.Setrepeats(repeats - 1);
  3146. end;
  3147.  
  3148. constructor TMusicListCollectionItem.Create(Collection: TCollection);
  3149. begin
  3150.   inherited Create(Collection);
  3151.   CoInitialize(nil);
  3152.   FMusicDataProp := TMusicDataProp.Create;
  3153.   SetLength(FMusicDataProp.FMusicData, 0);
  3154.   FDirectMusicPerformance := nil;
  3155.   FDirectMusic := nil;
  3156.   FDirectSound := nil;
  3157.   FDirectMusicSegment := nil;
  3158.   FDirectMusicLoader := nil;
  3159.   FIsInitialized := False;
  3160. end;
  3161.  
  3162. procedure TMusicListCollectionItem.Stop;
  3163. begin
  3164.   if FDirectMusicPerformance <> nil then
  3165.     FDirectMusicPerformance.Stop(nil, nil, 0, 0);
  3166. end;
  3167.  
  3168. function TMusicListCollectionItem.GetDisplayName: string;
  3169. begin
  3170.   Result := inherited GetDisplayName
  3171. end;
  3172.  
  3173. procedure TMusicListCollectionItem.Play;
  3174. begin
  3175.   if not FIsInitialized then
  3176.     Init;
  3177.   Load;
  3178.   if FDirectMusicPerformance <> nil then
  3179.     FDirectMusicPerformance.PlaySegment(FDirectMusicSegment, 0, 0, @FDirectMusicSegmentState);
  3180. end;
  3181.  
  3182. function TMusicListCollectionItem.IsPlaying: Boolean;
  3183. begin
  3184.   Result := False;
  3185.   if FDirectMusicPerformance <> nil then
  3186.     Result := FDirectMusicPerformance.IsPlaying(FDirectMusicSegment, FDirectMusicSegmentState) = DM_OK;
  3187. end;
  3188.  
  3189. destructor TMusicListCollectionItem.Destroy;
  3190. begin
  3191.   FDirectMusicPerformance := nil;
  3192.   FDirectMusic := nil;
  3193.   FDirectSound := nil;
  3194.   FDirectMusicSegment := nil;
  3195.   FDirectMusicLoader := nil;
  3196.   FMusicDataProp.Free;
  3197.   CoUninitialize;
  3198.   inherited Destroy;
  3199. end;
  3200.  
  3201. procedure TMusicListCollectionItem.SetRepeats(const Value: Cardinal);
  3202. begin
  3203.   Frepeats := Value;
  3204. end;
  3205.  
  3206. procedure TMusicListCollectionItem.SetStartPoint(const Value: integer);
  3207. begin
  3208.   FStartPoint := Value;
  3209. end;
  3210.  
  3211. procedure TMusicListCollectionItem.SetDuration(const Value: integer);
  3212. begin
  3213.   FDuration := Value;
  3214. end;
  3215.  
  3216. procedure TMusicListCollectionItem.Init;
  3217. var OK: Boolean;
  3218. begin
  3219.   FIsInitialized := False;
  3220.   OK := False;
  3221.   // vytvor FDirectMusicPerformance pokud uz neni vytvoreno
  3222.   if FDirectMusicPerformance = nil then
  3223.     OK := CoCreateInstance(CLSID_DirectMusicPerformance, nil, CLSCTX_INPROC,
  3224.       IID_IDirectMusicperformance, FDirectMusicPerformance) = DM_OK;
  3225.   if not OK then Exit;
  3226.   if FDirectSound <> nil then
  3227.     OK := FDirectMusicPerformance.Init({$IFDEF DX7}@{$ENDIF}FDirectMusic, FDirectSound, 0) = DM_OK
  3228.   else
  3229.     OK := FDirectMusicPerformance.Init({$IFDEF DX7}@{$ENDIF}FDirectMusic, nil, 0) = dm_OK;
  3230.   if not OK then Exit;
  3231.   // vychozi midi port
  3232.   // pridej pokud neni nastaven
  3233.   if FDirectMusicPerformance.Addport(nil) <> DM_OK then Exit;
  3234.   // zkus vytvorit loader
  3235.   OK := CoCreateInstance(CLSID_DirectMusicLoader, nil, CLSCTX_Inproc,
  3236.     IID_IDirectMusicLoader, FDirectMusicLoader) = DM_OK;
  3237.   FIsInitialized := OK;
  3238. end;
  3239.  
  3240. function TMusicListCollectionItem.GetMusicListCollection: TMusicListCollection;
  3241. begin
  3242.   Result := Collection as TMusicListCollection;
  3243. end;
  3244.  
  3245. procedure TMusicListCollectionItem.SaveToFile(const MidiFileName: string);
  3246. var F: file;
  3247. begin
  3248.   AssignFile(F, MidiFileName);
  3249.   Rewrite(F, 1);
  3250.   try
  3251.     BlockWrite(F, FMusicDataProp.FMusicData[1], Length(FMusicDataProp.FMusicData));
  3252.   finally
  3253.     CloseFile(F);
  3254.   end;
  3255. end;
  3256.  
  3257. procedure TMusicListCollectionItem.LoadFromFile(const MidiFileName: string);
  3258. var F: file; S: string; I: Integer;
  3259. begin
  3260.   AssignFile(F, MidiFileName);
  3261.   Reset(F, 1);
  3262.   try
  3263.     SetLength(FMusicDataProp.FMusicData, FileSize(F));
  3264.     BlockRead(F, FMusicDataProp.FMusicData[1], FileSize(F));
  3265.     S := ExtractFileName(MidiFileName);
  3266.     I := Pos(ExtractFileExt(S), S);
  3267.     if I > 0 then S := Copy(S, 1, I - 1);
  3268.     FMusicDataProp.Midiname := S;
  3269.   finally
  3270.     CloseFile(F);
  3271.   end;
  3272.   Name := ExtractFileName(MidiFileName);
  3273. end;
  3274.  
  3275. function TMusicListCollectionItem.Size: Integer;
  3276. begin
  3277.   Result := Length(FMusicDataProp.FMusicData);
  3278. end;
  3279.  
  3280. { TMusicListCollection }
  3281.  
  3282. constructor TMusicListCollection.Create(AOwner: TComponent);
  3283. begin
  3284.   inherited Create(TMusicListCollectionItem);
  3285.   FOwner := AOwner;
  3286. end;
  3287.  
  3288. function TMusicListCollection.Add: TMusicListCollectionItem;
  3289. begin
  3290.   Result := TMusicListCollectionItem(inherited Add);
  3291.   Result.FDirectSound := Self.FDirectSound;
  3292. end;
  3293.  
  3294. function TMusicListCollection.GetItem(Index: Integer): TMusicListCollectionItem;
  3295. begin
  3296.   Result := TMusicListCollectionItem(inherited GetItem(Index));
  3297. end;
  3298.  
  3299. procedure TMusicListCollection.SetItem(Index: Integer;
  3300.   Value: TMusicListCollectionItem);
  3301. begin
  3302.   inherited SetItem(Index, Value);
  3303. end;
  3304.  
  3305. procedure TMusicListCollection.Update(Item: TCollectionItem);
  3306. begin
  3307.   inherited Update(Item);
  3308. end;
  3309.  
  3310. function TMusicListCollection.Find(
  3311.   const Name: string): TMusicListCollectionItem;
  3312. var
  3313.   i: Integer;
  3314. begin
  3315.   i := IndexOf(Name);
  3316.   if i = -1 then
  3317.     raise EDXMusicError.CreateFmt('The midi document does not exist: %s.', [Name]);
  3318.   Result := Items[i];
  3319. end;
  3320.  
  3321. {$IFDEF VER4UP}
  3322. function TMusicListCollection.Insert(Index: Integer): TMusicListCollectionItem;
  3323. begin
  3324.   Result := TMusicListCollectionItem(inherited Insert(Index));
  3325. end;
  3326. {$ENDIF}
  3327.  
  3328. function TMusicListCollection.GetOwner: TPersistent;
  3329. begin
  3330.   Result := FOwner;
  3331. end;
  3332.  
  3333. procedure TMusicListCollection.Restore;
  3334. begin
  3335.  
  3336. end;
  3337.  
  3338. procedure TMusicListCollection.SaveToFile(const FileName: string);
  3339. var
  3340.   Stream: TFileStream;
  3341. begin
  3342.   Stream := TFileStream.Create(FileName, fmCreate);
  3343.   try
  3344.     SaveToStream(Stream);
  3345.   finally
  3346.     Stream.Free;
  3347.   end;
  3348. end;
  3349.  
  3350. procedure TMusicListCollection.LoadFromFile(const FileName: string);
  3351. var
  3352.   Stream: TFileStream;
  3353. begin
  3354.   Stream := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
  3355.   try
  3356.     LoadFromStream(Stream);
  3357.   finally
  3358.     Stream.Free;
  3359.   end;
  3360. end;
  3361.  
  3362. type
  3363.   TMidiCollectionComponent = class(TComponent)
  3364.   private
  3365.     FList: TMusicListCollection;
  3366.   published
  3367.     property List: TMusicListCollection read FList write FList;
  3368.   end;
  3369.  
  3370. procedure TMusicListCollection.SaveToStream(Stream: TStream);
  3371. var
  3372.   Component: TMidiCollectionComponent;
  3373. begin
  3374.   Component := TMidiCollectionComponent.Create(nil);
  3375.   try
  3376.     Component.FList := Self;
  3377.     Stream.WriteComponentRes('DelphiXMidiCollection', Component);
  3378.   finally
  3379.     Component.Free;
  3380.   end;
  3381. end;
  3382.  
  3383. procedure TMusicListCollection.LoadFromStream(Stream: TStream);
  3384. var
  3385.   Component: TMidiCollectionComponent;
  3386. begin
  3387.   Clear;
  3388.   Component := TMidiCollectionComponent.Create(nil);
  3389.   try
  3390.     Component.FList := Self;
  3391.     Stream.ReadComponentRes(Component);
  3392.     Restore;
  3393.   finally
  3394.     Component.Free;
  3395.   end;
  3396. end;
  3397.  
  3398. { TDXMusic }
  3399.  
  3400. constructor TDXMusic.Create(AOwner: TComponent);
  3401. begin
  3402.   inherited Create(AOwner);
  3403.   FMidis := TMusicListCollection.Create(Self);
  3404.   if Assigned(FDXSound) then
  3405.     FMidis.FDirectSound := FDXSound.DSound.IDSound;
  3406. end;
  3407.  
  3408. procedure TDXMusic.SetMidis(const value: TMusicListCollection);
  3409. begin
  3410.   FMidis.Assign(Value);
  3411. end;
  3412.  
  3413. destructor TDXMusic.Destroy;
  3414. begin
  3415.   FMidis.Free;
  3416.   inherited Destroy;
  3417. end;
  3418.  
  3419. procedure TDXMusic.SetDXSound(const Value: TDXSound);
  3420. begin
  3421.   FDXSound := Value;
  3422.   if Assigned(FDXSound) then
  3423.     FMidis.FDirectSound := FDXSound.DSound.IDSound;
  3424. end;
  3425.  
  3426. initialization
  3427. finalization
  3428.   DirectSoundDrivers.Free;
  3429.   DirectSoundCaptureDrivers.Free;
  3430. end.
  3431.