WebSVN – spacemission – Diff – /VCL_DELPHIX_D6/DXSounds.pas

 interface
 {$INCLUDE DelphiXcfg.inc}
 uses
-  Windows, Messages, SysUtils, Classes, Controls, Forms, ExtCtrls, MMSystem,
+  Windows, Messages, SysUtils, Classes, Controls, Forms, ExtCtrls, MMSystem, ActiveX,
+  DXClass, DXWave, D3DUtils, {$IFDEF VER17UP} Types, {$ENDIF}
+{$IFDEF StandardDX}
-  DirectX, DXClass, Wave;
+  DirectSound, DirectMusic;
+{$ELSE}
+  DirectX;
+{$ENDIF}
 type
   {  EDirectSoundError  }
     property Buffers[Index: Integer]: TDirectSoundBuffer read GetBuffer;
     property IDSound: IDirectSound read GetIDSound;
     property ISound: IDirectSound read GetISound;
   end;
+  {  TD3DSParams  }
+  TConeAngle = record
+    Inside,Outside:DWord;
+  end;
+  TD3DSParams = class
+  private
+    FOwner: TDirectSoundBuffer;
+    FDsb: TDS3DBUFFER;
+    function GetPosition: TD3DVector;
+    function GetVelocity: TD3DVector;
+    function GetConeOrientation: TD3DVector;
+    function GetConeAngle: TConeAngle;
+    function GetConeOutsideVolume: Integer;
+    function GetMinDistance: TD3DValue;
+    function GetMaxDistance: TD3DValue;
+    function GetRaw: TDS3DBuffer;
+    procedure SetPosition(const v: TD3DVector);
+    procedure SetVelocity(const v: TD3DVector);
+    procedure SetConeOrientation(const v: TD3DVector);
+    procedure SetConeAngle(const v: TConeAngle);
+    procedure SetConeOutsideVolume(const v: Integer);
+    procedure SetMinDistance(const v: TD3DValue);
+    procedure SetMaxDistance(const v: TD3DValue);
+    procedure SetRaw(const v: TDS3DBuffer);
+    function CheckValidity: Boolean;
+  public
+    constructor Create(Owner: TDirectSoundBuffer);
+    destructor Destroy; override;
+    property Position: TD3DVector read getPosition write setPosition;
+    property Velocity: TD3DVector read getVelocity write setVelocity;
+    property ConeOrientation: TD3DVector read getConeOrientation write setConeOrientation;
+    property ConeAngle: TConeAngle read getConeAngle write setConeAngle;
+    property ConeOutsideVolume: Integer read getConeOutsideVolume write setConeOutsideVolume;
+    property MinDistance: TD3DValue read getMinDistance write setMinDistance;
+    property MaxDistance: TD3DValue read getMaxDistance write setMaxDistance;
+    property RawParams: TDS3DBuffer read getRaw write setRaw;
+    procedure Assign(Prms: TD3DSParams);
+  end;
   {  TDirectSoundBuffer  }
   TDirectSoundBuffer = class(TDirectX)
   private
     FDSound: TDirectSound;
     FIDSBuffer: IDirectSoundBuffer;
+    FIDS3DBuffer:IDirectSound3DBuffer;
+    FD3DSParams: TD3DSParams;
     FCaps: TDSBCaps;
     FFormat: PWaveFormatEx;
     FFormatSize: Integer;
     FLockAudioPtr1, FLockAudioPtr2: array[0..0] of Pointer;
     FLockAudioSize1, FLockAudioSize2: array[0..0] of DWORD;
     FLockCount: Integer;
+    FIsD3D: Boolean;
     function GetBitCount: Longint;
     function GetFormat: PWaveFormatEx;
     function GetFrequency: Integer;
     function GetIDSBuffer: IDirectSoundBuffer;
     function GetIBuffer: IDirectSoundBuffer;
     procedure SetFrequency(Value: Integer);
     procedure SetIDSBuffer(Value: IDirectSoundBuffer);
     procedure SetPan(Value: Integer);
     procedure SetPosition(Value: Longint);
     procedure SetVolume(Value: Integer);
+    function GetIDS3DBuffer: IDirectSound3DBuffer;
+    procedure SetIDS3DBuffer(const Value: IDirectSound3DBuffer);
+    procedure SetD3DSParams(const Value: TD3DSParams);
   protected
     procedure Check; override;
   public
     constructor Create(ADirectSound: TDirectSound);
     destructor Destroy; override;
       var AudioPtr1: Pointer; var AudioSize1: Longint;
       var AudioPtr2: Pointer; var AudioSize2: Longint): Boolean;
-    function Play(Loop: Boolean{$IFNDEF VER100}=False{$ENDIF}): Boolean;
+    function Play(Loop: Boolean{$IFNDEF VER100} = False{$ENDIF}): Boolean;
     function Restore: Boolean;
     function SetFormat(const Format: TWaveFormatEx): Boolean;
-    procedure SetSize(const Format: TWaveFormatEx; Size: Integer);
+    procedure SetSize(const Format: TWaveFormatEx; Size: Integer; D3D: Boolean {$IFNDEF VER100}= False{$ENDIF});
     procedure Stop;
     procedure UnLock;
     property BitCount: Longint read GetBitCount;
     property DSound: TDirectSound read FDSound;
     property Format: PWaveFormatEx read GetFormat;
     property FormatSize: Integer read FFormatSize;
     property Frequency: Integer read GetFrequency write SetFrequency;
     property IBuffer: IDirectSoundBuffer read GetIBuffer;
     property IDSBuffer: IDirectSoundBuffer read GetIDSBuffer write SetIDSBuffer;
+    property IDS3DBuffer: IDirectSound3DBuffer read GetIDS3DBuffer write SetIDS3DBuffer;
     property Playing: Boolean read GetPlaying;
     property Pan: Integer read GetPan write SetPan;
+    property D3DSParams: TD3DSParams read FD3DSParams write SetD3DSParams;
+    property IsD3D: Boolean read FIsD3D write FIsD3D default False;
     property Position: Longint read GetPosition write SetPosition;
     property Size: Integer read GetSize;
     property Volume: Integer read GetVolume write SetVolume;
   end;
     procedure SetLooped(Value: Boolean);
     procedure SetMaxPlayingCount(Value: Integer);
     procedure SetPan(Value: Integer);
     procedure SetVolume(Value: Integer);
     procedure SetWave(Value: TWave);
+  protected
+    function GetPlaying: boolean;
   public
     constructor Create(Collection: TCollection); override;
     destructor Destroy; override;
     procedure Assign(Source: TPersistent); override;
     procedure Play(Wait: Boolean);
     property Frequency: Integer read FFrequency write SetFrequency;
     property Initialized: Boolean read FInitialized;
     property Pan: Integer read FPan write SetPan;
     property Volume: Integer read FVolume write SetVolume;
     property WaveCollection: TWaveCollection read GetWaveCollection;
+    property Playing: boolean read GetPlaying;
   published
     property Looped: Boolean read FLooped write SetLooped;
     property MaxPlayingCount: Integer read FMaxPlayingCount write SetMaxPlayingCount;
     property Wave: TWave read FWave write SetWave;
   end;
   published
     property DXSound;
     property Items;
   end;
+  {  EDXMusicError  }
+  EDXMusicError = class(Exception);
+  TMusicListCollection = class;
+  {  TMusicListCollectionItem  }
+  TMusicDataProp = class(TPersistent)
+  private
+    FMusicData: string;
+    FMidiname: string;
+    function GetMusicData: string;
+    procedure SetMusicData(const Value: string);
+  protected
+    procedure DefineProperties(Filer: TFiler); override;
+    procedure ReadMidiData(Stream: TStream);
+    procedure WriteMidiData(Stream: TStream);
+  public
+    property MusicData: string read GetMusicData write SetMusicData;
+  published
+    property MidiName: string read FMidiname write FMidiname;
+  end;
+  TMusicListCollectionItem = class(THashCollectionItem)
+  private
+    { Private declarations }
+    FDirectMusicPerformance: IDirectMusicPerformance;
+    FDirectSound: IDirectSound;
+    FDirectMusic: IDirectMusic;
+    FDirectMusicLoader: IDirectMusicLoader;
+    FDirectMusicSegment: IDirectMusicSegment;
+    FMusicObjDesc: TDMus_ObjectDesc;
+    FDirectMusicSegmentState: IDirectMusicSegmentState;
+    FRepeats: Cardinal;
+    FStartpoint: Integer;
+    FDuration: Integer;
+    // startpoint props in seconds these used to hold millisecond value
+    FActualDuration: Integer;
+    FActualStartPoint: Integer;
+    FIsInitialized: Boolean;
+    FMusicDataProp: TMusicDataProp;
+    procedure SetDuration(const Value: integer);
+    procedure SetRepeats(const Value: Cardinal);
+    procedure SetStartPoint(const Value: integer);
+    function GetMusicListCollection: TMusicListCollection;
+  protected
+    function GetDisplayName: string; override;
+  public
+    constructor Create(Collection: TCollection); override;
+    destructor Destroy; override;
+    function Size: Integer;
+    procedure Play;
+    function IsPlaying: Boolean;
+    procedure Stop;
+    procedure Load;
+    procedure Init;
+    procedure LoadFromFile(const MidiFileName: string);
+    procedure SaveToFile(const MidiFileName: string);
+    property MusicCollection: TMusicListCollection read GetMusicListCollection;
+    property IsInitialized: Boolean read FIsInitialized write FIsInitialized;
+  published
+    property Name;
+    property Repeats: Cardinal read Frepeats write SetRepeats;
+    property Duration: integer read FDuration write SetDuration;
+    property StartPoint: integer read FStartPoint write SetStartPoint;
+    property Midi: TMusicDataProp read FMusicDataProp write FMusicDataProp;
+  end;
+  {  TMusicListCollection  }
+  TMusicListCollection = class(THashCollection)
+  private
+    FOwner: TPersistent;
+    FDirectSound: IDirectSound;
+  protected
+    function GetItem(Index: Integer): TMusicListCollectionItem;
+    procedure SetItem(Index: Integer; Value: TMusicListCollectionItem);
+    procedure Update(Item: TCollectionItem); override;
+    function GetOwner: TPersistent; override;
+  public
+    constructor Create(AOwner: TComponent);
+    function Add: TMusicListCollectionItem;
+    function Find(const Name: string): TMusicListCollectionItem;
+    procedure Restore;
+    procedure LoadFromFile(const FileName: string);
+    procedure LoadFromStream(Stream: TStream);
+    procedure SaveToFile(const FileName: string);
+    procedure SaveToStream(Stream: TStream);
+{$IFDEF VER4UP}
+    function Insert(Index: Integer): TMusicListCollectionItem;
+{$ENDIF}
+    property Items[Index: Integer]: TMusicListCollectionItem read GetItem write SetItem;
+  published
+  end;
+  {  TDXMusic  }
+  TDXMusic = class(TComponent)
+  private
+    FDXSound: TDXSound;
+    FMidis: TMusicListCollection;
+    procedure SetMidis(const value: TMusicListCollection);
+    procedure SetDXSound(const Value: TDXSound);
+  public
+    constructor Create(AOwner: TComponent); override;
+    destructor Destroy; override;
+  published
+    property DXSound: TDXSound read FDXSound write SetDXSound;
+    property Midis: TMusicListCollection read FMidis write SetMidis;
+  end;
 implementation
 uses DXConsts;
+const
+  dm_OK = 0;
 function DXDirectSoundCreate(lpGUID: PGUID; out lpDS: IDirectSound;
   pUnkOuter: IUnknown): HRESULT;
 type
   TDirectSoundCreate = function(lpGUID: PGUID; out lplpDD: IDirectSound;
     pUnkOuter: IUnknown): HRESULT; stdcall;
 var
   DirectSoundDrivers: TDirectXDrivers;
   DirectSoundCaptureDrivers: TDirectXDrivers;
-function EnumDirectSoundDrivers_DSENUMCALLBACK(lpGuid: PGUID; lpstrDescription: LPCSTR;
+function EnumDirectSoundDrivers_DSENUMCALLBACK(lpGuid: PGUID; lpstrDescription: {$IFDEF UNICODE}LPCTSTR{$ELSE}LPCSTR{$ENDIF};
-  lpstrModule: LPCSTR; lpContext: Pointer): BOOL; stdcall;
+  lpstrModule: {$IFDEF UNICODE}LPCTSTR{$ELSE}LPCSTR{$ENDIF}; lpContext: Pointer): BOOL; stdcall;
 begin
   Result := True;
   with TDirectXDriver.Create(TDirectXDrivers(lpContext)) do
   begin
     Guid := lpGuid;
 {  TDirectSoundBuffer  }
 constructor TDirectSoundBuffer.Create(ADirectSound: TDirectSound);
 begin
   inherited Create;
+  FIsD3D := False;
   FDSound := ADirectSound;
+  FIDS3DBuffer := nil;
   FDSound.FBufferList.Add(Self);
 end;
 destructor TDirectSoundBuffer.Destroy;
 begin
   IDSBuffer := nil;
+  IDS3DBuffer := nil;
   FDSound.FBufferList.Remove(Self);
   inherited Destroy;
 end;
 procedure TDirectSoundBuffer.Assign(Source: TPersistent);
 var
   TempBuffer: IDirectSoundBuffer;
 begin
-  if Source=nil then
+  if Source = nil then
     IDSBuffer := nil
+  else
-  else if Source is TWave then
+  if Source is TWave then
     LoadFromWave(TWave(Source))
+  else
-  else if Source is TDirectSoundBuffer then
+  if Source is TDirectSoundBuffer then
   begin
-    if TDirectSoundBuffer(Source).IDSBuffer=nil then
+    if TDirectSoundBuffer(Source).IDSBuffer = nil then
       IDSBuffer := nil
+    else
-    else begin
+    begin
-      FDSound.DXResult := FDSound.ISound.DuplicateSoundBuffer(TDirectSoundBuffer(Source).IDSBuffer,
+      FDSound.DXResult := FDSound.ISound.DuplicateSoundBuffer(TDirectSoundBuffer(Source).IDSBuffer, TempBuffer);
-        TempBuffer);
-      if FDSound.DXResult=0 then
+      if FDSound.DXResult = DS_OK then
       begin
         IDSBuffer := TempBuffer;
       end;
     end;
+    if FIsD3D then
+      if TDirectSoundBuffer(Source).IDS3DBuffer = nil then
+        IDS3DBuffer := nil
-  end else
+      else
+      begin
+        FDSound.DXResult := FDSound.ISound.QueryInterface(IID_IDirectSound3DBuffer, FIDS3DBuffer);
+        if FDSound.DXResult = DS_OK then
+          FD3DSParams := TDirectSoundBuffer(Source).FD3DSParams;
+      end;
+  end
+  else
     inherited Assign(Source);
 end;
 procedure TDirectSoundBuffer.Check;
 begin
 function TDirectSoundBuffer.GetFrequency: Integer;
 begin
   DXResult := IBuffer.GetFrequency(DWORD(Result));
 end;
+function TDirectSoundBuffer.GetIDS3DBuffer: IDirectSound3DBuffer;
+begin
+  if Self <> nil then
+    Result := FIDS3DBuffer
+  else
+    Result := nil;
+end;
 function TDirectSoundBuffer.GetIDSBuffer: IDirectSoundBuffer;
 begin
-  if Self<>nil then
+  if Self <> nil then
     Result := FIDSBuffer
   else
 function TDirectSoundBuffer.GetPosition: Longint;
 var
   dwCurrentWriteCursor: Longint;
 begin
-  IBuffer.GetCurrentPosition(DWORD(Result), DWORD(dwCurrentWriteCursor));
+  IBuffer.GetCurrentPosition(@DWORD(Result), @DWORD(dwCurrentWriteCursor));
 end;
 function TDirectSoundBuffer.GetSize: Integer;
 begin
   Result := FCaps.dwBufferBytes;
   Data: Pointer; Size: Integer);
 var
   Data1, Data2: Pointer;
   Data1Size, Data2Size: Longint;
 begin
-  SetSize(Format, Size);
+  SetSize(Format, Size, FIsD3D);
-  if Data<>nil then
+  if Data <> nil then
   begin
     if Lock(0, Size, Data1, Data1Size, Data2, Data2Size) then
     begin
-        if Data2<>nil then
+        if Data2 <> nil then
-          Move(Pointer(Longint(Data)+Data1Size)^, Data2^, Data2Size);
+          Move(Pointer(Longint(Data) + Data1Size)^, Data2^, Data2Size);
       finally
         UnLock;
       end;
+    end
-    end else
+    else
     begin
       FIDSBuffer := nil;
+      FIDS3DBuffer := nil;
       raise EDirectSoundBufferError.CreateFmt(SCannotLock, [SDirectSoundBuffer]);
     end;
   end;
 end;
 begin
   Result := False;
-  if IDSBuffer=nil then Exit;
+  if IDSBuffer = nil then Exit;
-  if FLockCount>High(FLockAudioPtr1) then Exit;
+  if FLockCount > High(FLockAudioPtr1) then Exit;
   DXResult := IBuffer.Lock(LockPosition, LockSize,
-    FLockAudioPtr1[FLockCount], FLockAudioSize1[FLockCount],
+    {$IFNDEF DX7}@{$ENDIF}FLockAudioPtr1[FLockCount], {$IFNDEF DX7}@{$ENDIF}FLockAudioSize1[FLockCount],
-    FLockAudioPtr2[FLockCount], FLockAudioSize2[FLockCount], 0);
+    {$IFNDEF DX7}@{$ENDIF}FLockAudioPtr2[FLockCount], {$IFNDEF DX7}@{$ENDIF}FLockAudioSize2[FLockCount], 0);
-  Result := DXResult=DS_OK;
+  Result := DXResult = DS_OK;
   if Result then
   begin
     AudioPtr1 := FLockAudioPtr1[FLockCount];
 begin
   DXResult := IBuffer.Restore;
-  Result := DXResult=DS_OK;
+  Result := DXResult = DS_OK;
 end;
+procedure TDirectSoundBuffer.SetD3DSParams(const Value: TD3DSParams);
+begin
+  FD3DSParams.Assign(Value);
+end;
 function TDirectSoundBuffer.SetFormat(const Format: TWaveFormatEx): Boolean;
 begin
-  DXResult := IBuffer.SetFormat(Format);
+  DXResult := IBuffer.SetFormat(FFormat{$IFDEF DX7}^{$ENDIF});
-  Result := DXResult=DS_OK;
+  Result := DXResult = DS_OK;
   if Result then
   begin
     FreeMem(FFormat);
     FFormat := nil;
     FFormatSize := 0;
-    if IBuffer.GetFormat(PWaveFormatEx(nil)^, 0, DWORD(FFormatSize))=DS_OK then
+    if IBuffer.GetFormat(PWaveFormatEx(nil), 0, @DWORD(FFormatSize)) = DS_OK then
     begin
       GetMem(FFormat, FFormatSize);
-      IBuffer.GetFormat(FFormat^, FFormatSize, PDWORD(nil)^);
+      IBuffer.GetFormat(FFormat, FFormatSize, nil);
     end;
   end;
 end;
 procedure TDirectSoundBuffer.SetFrequency(Value: Integer);
 begin
   DXResult := IBuffer.SetFrequency(Value);
 end;
+procedure TDirectSoundBuffer.SetIDS3DBuffer(const Value: IDirectSound3DBuffer);
+begin
+  if FIDS3DBuffer = Value then Exit;
+  FIDS3DBuffer := Value;
+  FillChar(FCaps, SizeOf(FCaps), 0);
+  FreeMem(FFormat);
+  FFormat := nil;
+  FFormatSize := 0;
+  FLockCount := 0;
+  if FIDS3DBuffer <> nil then
+  begin
+    FCaps.dwSize := SizeOf(FCaps);
+    IBuffer.GetCaps(FCaps);
+    if IBuffer.GetFormat(PWaveFormatEx(nil), 0, @DWORD(FFormatSize)) = DS_OK then
+    begin
+      GetMem(FFormat, FFormatSize);
+      IBuffer.GetFormat(FFormat, FFormatSize, nil);
+    end;
+  end;
+end;
 procedure TDirectSoundBuffer.SetIDSBuffer(Value: IDirectSoundBuffer);
 begin
-  if FIDSBuffer=Value then Exit;
+  if FIDSBuffer = Value then Exit;
   FIDSBuffer := Value;
-  if FIDSBuffer<>nil then
+  if FIDSBuffer <> nil then
   begin
     FCaps.dwSize := SizeOf(FCaps);
     IBuffer.GetCaps(FCaps);
-    if IBuffer.GetFormat(PWaveFormatEx(nil)^, 0, DWORD(FFormatSize))=DS_OK then
+    if IBuffer.GetFormat(PWaveFormatEx(nil), 0, @DWORD(FFormatSize)) = DS_OK then
     begin
       GetMem(FFormat, FFormatSize);
-      IBuffer.GetFormat(FFormat^, FFormatSize, PDWORD(nil)^);
+      IBuffer.GetFormat(FFormat, FFormatSize, nil);
     end;
   end;
 end;
 procedure TDirectSoundBuffer.SetPan(Value: Integer);
 procedure TDirectSoundBuffer.SetPosition(Value: Longint);
 begin
   DXResult := IBuffer.SetCurrentPosition(Value);
 end;
+{$IFNDEF DX7}
+const
+  DSBCAPS_CTRLDEFAULT = DSBCAPS_CTRLFREQUENCY or DSBCAPS_CTRLPAN or DSBCAPS_CTRLVOLUME;
+{$ENDIF}
-procedure TDirectSoundBuffer.SetSize(const Format: TWaveFormatEx; Size: Integer);
+procedure TDirectSoundBuffer.SetSize(const Format: TWaveFormatEx; Size: Integer; D3D: Boolean {$IFNDEF VER100}= False{$ENDIF});
 var
   BufferDesc: TDSBufferDesc;
 begin
   {  IDirectSoundBuffer made.  }
   FillChar(BufferDesc, SizeOf(BufferDesc), 0);
     dwFlags := DSBCAPS_CTRLDEFAULT;
     if DSound.FStickyFocus then
       dwFlags := dwFlags or DSBCAPS_STICKYFOCUS
     else if DSound.FGlobalFocus then
       dwFlags := dwFlags or DSBCAPS_GLOBALFOCUS;
+    if D3D then
+      dwFlags := DSBCAPS_STATIC + DSBCAPS_CTRLDEFAULT + DSBCAPS_CTRL3D - DSBCAPS_CTRLPAN;
     dwBufferBytes := Size;
     lpwfxFormat := @Format;
   end;
   if not CreateBuffer(BufferDesc) then
   Dec(FLockCount);
   DXResult := IBuffer.UnLock(FLockAudioPtr1[FLockCount], FLockAudioSize1[FLockCount],
     FLockAudioPtr2[FLockCount], FLockAudioSize2[FLockCount]);
 end;
+{  TD3DSParams  }
+function TD3DSParams.CheckValidity: Boolean;
+begin
+  Result := (FOwner <> nil) and (TDirectSoundBuffer(FOwner).IDS3DBuffer <> nil)
+end;
+constructor TD3DSParams.Create(Owner: TDirectSoundBuffer);
+  {$IFDEF VER14UP}
+  function MakeD3DVector(x, y, z: TD3DValue): TD3DVector; {$IFDEF VER9UP}inline; {$ENDIF}
+  begin
+    Result.x := x;
+    Result.y := y;
+    Result.z := z;
+  end;
+  {$ENDIF}
+begin
+  inherited Create;
+  FOwner := Owner;
+  with FDsb do
+  begin
+    dwSize := SizeOf(TDS3DBuffer);
+    vPosition := MakeD3DVector(0, 0, 0);
+    vVelocity := MakeD3DVector(0, 0, 0);
+    dwInsideConeAngle := DS3D_DEFAULTCONEANGLE;
+    dwOutsideConeAngle := DS3D_DEFAULTCONEANGLE;
+    vConeOrientation := MakeD3DVector(0, 0, 0);
+    lConeoutsideVolume := DS3D_DEFAULTCONEOUTSIDEVOLUME;
+    flMinDistance := 5;
+    flMaxDistance := 100.0;
+    dwMode := DS3DMODE_NORMAL;
+  end;
+end;
+destructor TD3DSParams.destroy;
+begin
+  inherited destroy;
+end;
+function TD3DSParams.getPosition: TD3DVector;
+begin
+  if CheckValidity then
+  begin
+    FOwner.IDS3DBuffer.GetPosition(FDsb.vPosition);
+  end;
+  result := FDsb.vPosition;
+end;
+function TD3DSParams.getVelocity: TD3DVector;
+begin
+  if CheckValidity then
+  begin
+    FOwner.IDS3DBuffer.GetVelocity(FDsb.vVelocity);
+  end;
+  result := FDsb.vVelocity;
+end;
+function TD3DSParams.getConeOrientation: TD3DVector;
+begin
+  if CheckValidity then
+  begin
+    FOwner.IDS3DBuffer.GetConeOrientation(FDsb.vConeOrientation);
+  end;
+  result := FDsb.vConeOrientation;
+end;
+function TD3DSParams.getConeAngle: TConeAngle;
+begin
+  if CheckValidity then
+  begin
+    FOwner.IDS3DBuffer.GetConeAngles(FDsb.dwInsideConeAngle, FDsb.dwOutsideConeAngle);
+  end;
+  with result do
+  begin
+    Inside := FDsb.dwInsideConeAngle;
+    OutSide := FDsb.dwOutsideConeAngle;
+  end;
+end;
+function TD3DSParams.getConeOutsideVolume: Integer;
+begin
+  if CheckValidity then
+  begin
+    FOwner.IDS3DBuffer.GetConeOutsideVolume(FDsb.lConeOutsideVolume);
+  end;
+  result := FDsb.lConeOutsideVolume;
+end;
+function TD3DSParams.getMinDistance: TD3DValue;
+begin
+  if CheckValidity then
+  begin
+    FOwner.IDS3DBuffer.GetMinDistance(FDsb.flMinDistance);
+  end;
+  result := FDsb.flMinDistance;
+end;
+function TD3DSParams.getMaxDistance: TD3DValue;
+begin
+  if CheckValidity then
+  begin
+    FOwner.IDS3DBuffer.GetMaxDistance(FDsb.flMaxDistance);
+  end;
+  result := FDsb.flMaxDistance;
+end;
+function TD3DSParams.getRaw: TDS3DBuffer;
+begin
+  if CheckValidity then
+  begin
+    FOwner.IDS3DBuffer.GetAllParameters(FDsb);
+  end;
+  result := FDsb;
+end;
+procedure TD3DSParams.setPosition(const v: TD3DVector);
+begin
+  if CheckValidity then
+  begin
+    FOwner.IDS3DBuffer.SetPosition(v.x, v.y, v.z, DS3D_IMMEDIATE);
+  end;
+  FDsb.vPosition := v;
+end;
+procedure TD3DSParams.setVelocity(const v: TD3DVector);
+begin
+  if CheckValidity then
+  begin
+    FOwner.IDS3DBuffer.SetVelocity(v.x, v.y, v.z, DS3D_IMMEDIATE);
+  end;
+  FDsb.vVelocity := v;
+end;
+procedure TD3DSParams.setConeOrientation(const v: TD3DVector);
+begin
+  if CheckValidity then
+  begin
+    FOwner.IDS3DBuffer.SetConeOrientation(v.x, v.y, v.z, DS3D_IMMEDIATE);
+  end;
+  FDsb.vConeOrientation := v;
+end;
+procedure TD3DSParams.setConeAngle(const v: TConeAngle);
+begin
+  if CheckValidity then
+  begin
+    FOwner.IDS3DBuffer.SetConeAngles(v.Inside, v.Outside, DS3D_IMMEDIATE);
+  end;
+  FDsb.dwInsideConeAngle := v.Inside;
+  FDsb.dwInsideConeAngle := v.Outside;
+end;
+procedure TD3DSParams.setConeOutsideVolume(const v: Integer);
+begin
+  if CheckValidity then
+  begin
+    FOwner.IDS3DBuffer.SetConeOutsideVolume(v, DS3D_IMMEDIATE);
+  end;
+  FDsb.lConeOutsideVolume := v;
+end;
+procedure TD3DSParams.setMinDistance(const v: TD3DValue);
+begin
+  if CheckValidity then
+  begin
+    FOwner.IDS3DBuffer.SetMinDistance(v, DS3D_IMMEDIATE);
+  end;
+  FDsb.flMinDistance := v;
+end;
+procedure TD3DSParams.setMaxDistance(const v: TD3DValue);
+begin
+  if CheckValidity then
+  begin
+    FOwner.IDS3DBuffer.SetMaxDistance(v, DS3D_IMMEDIATE);
+  end;
+  FDsb.flMaxDistance := v;
+end;
+procedure TD3DSParams.setRaw(const v: TDS3DBuffer);
+begin
+  if CheckValidity then
+  begin
+    if FOwner.IDS3DBuffer.SetAllParameters(v, DS3D_IMMEDIATE) <> DS_OK then
+      {'Parameter is invalid for Params3D'};
+  end;
+  FDsb := v;
+end;
+procedure TD3DSParams.Assign(Prms: TD3DSParams);
+begin
+  FDsb := Prms.RawParams;
+  if CheckValidity then
+  begin
+    if FOwner.IDS3DBuffer.SetAllParameters(FDsb, DS3D_IMMEDIATE) <> DS_OK then
+      {'Parameter is invalid for Params3D'};
+  end;
+end;
 {  TAudioStream  }
 type
   TAudioStreamNotify = class(TThread)
   private
 function TSoundCaptureStream.GetReadSize: Integer;
 var
   CapturePosition, ReadPosition: DWORD;
 begin
-  if FBuffer.GetCurrentPosition(CapturePosition, ReadPosition)=DS_OK then
+  if FBuffer.GetCurrentPosition(@DWORD(CapturePosition), @DWORD(ReadPosition)) = DS_OK then
   begin
-    if FBufferPos<=ReadPosition then
+    if FBufferPos <= ReadPosition then
       Result := ReadPosition - FBufferPos
     else
       Result := FBufferSize - FBufferPos + ReadPosition;
   Data1Size, Data2Size: DWORD;
   C: Byte;
 begin
   if not FCapturing then
     Start;
+  Data1 := nil;
+  Data2 := nil;
   Result := 0;
-  while Result<Count do
+  while Result < Count do
   begin
-    Size := Min(Count-Result, GetReadSize);
+    Size := Min(Count - Result, GetReadSize);
-    if Size>0 then
+    if Size > 0 then
     begin
-      if FBuffer.Lock(FBufferPos, Size, Data1, Data1Size, Data2, Data2Size, 0)=DS_OK then
+      if FBuffer.Lock(FBufferPos, Size, Data1, {$IFNDEF DX7}@{$ENDIF}Data1Size,
+        Data2, {$IFNDEF DX7}@{$ENDIF}Data2Size, 0) = DS_OK then
       begin
-        Move(Data1^, Pointer(Integer(@Buffer)+Result)^, Data1Size);
+        Move(Data1^, Pointer(Integer(@Buffer) + Result)^, Data1Size);
         Result := Result + Integer(Data1Size);
-        if Data2<>nil then
+        if Data2 <> nil then
 begin
   inherited Create;
   FDSound := ADSound;
   FEnabled := True;
   FEffectList := TList.Create;
   FTimer := TTimer.Create(nil);
   FTimer.Interval := 500;
   FTimer.OnTimer := TimerEvent;
 end;
     FWave.Assign(TWaveCollectionItem(Source).FWave);
     if PrevInitialized then
       Restore;
+  end
-  end else
+  else
     inherited Assign(Source);
 end;
+function TWaveCollectionItem.GetPlaying: boolean;
+var
+  Buffer: TDirectSoundBuffer;
+  index: integer;
+begin
+  Result := False;
+  if not FInitialized then Exit;
+  Assert(GetBuffer <> nil);
+  Assert(FBufferList <> nil);
+  if FLooped then
+  begin
+    Buffer := GetBuffer;
+    Assert(Buffer <> nil);
+    Result := Buffer.Playing;
+  end
+  else
+  begin
+    for index := 0 to FBufferList.Count - 1 do
+    begin
+      Result := TDirectSoundBuffer(FBufferList[index]).Playing;
+      if Result then
+        Break;
+    end;
+  end;
+end; {GetPlaying}
 function TWaveCollectionItem.GetBuffer: TDirectSoundBuffer;
 begin
-  if FInitialized and (FBuffer=nil) then
+  if FInitialized and (FBuffer = nil) then
     Restore;
   Result := FBuffer;
   if FLooped then
   begin
     GetBuffer.Stop;
     GetBuffer.Position := 0;
     GetBuffer.Play(True);
+  end
-  end else
+  else
   begin
     NewBuffer := nil;
-    for i:=0 to FBufferList.Count-1  do
+    for i := 0 to FBufferList.Count - 1 do
       if not TDirectSoundBuffer(FBufferList[i]).Playing then
       begin
       begin
         NewBuffer := CreateBuffer;
-        if NewBuffer=nil then Exit;
+        if NewBuffer = nil then Exit;
         FBufferList.Add(NewBuffer);
+      end
-      end else
+      else
       begin
-        if FBufferList.Count<FMaxPlayingCount then
+        if FBufferList.Count < FMaxPlayingCount then
         begin
           NewBuffer := CreateBuffer;
-          if NewBuffer=nil then Exit;
+          if NewBuffer = nil then Exit;
           FBufferList.Add(NewBuffer);
+        end
-        end else
+        else
         begin
           NewBuffer := FBufferList[0];
-          FBufferList.Move(0, FBufferList.Count-1);
+          FBufferList.Move(0, FBufferList.Count - 1);
         end;
       end;
 procedure TCustomDXWaveList.SetItems(Value: TWaveCollection);
 begin
   FItems.Assign(Value);
 end;
+{(c) 2006 Jaro Benes, Play midi from memory module}
+{ TMusicDataProp }
+type
+  TMidiDataHeader = packed record
+    Size: Integer;
+  end;
+procedure TMusicDataProp.DefineProperties(Filer: TFiler);
+begin
+  inherited DefineProperties(Filer);
+  Filer.DefineBinaryProperty('Midi', ReadMidiData, WriteMidiData, Length(Self.FMusicData) <> 0);
+end;
+function TMusicDataProp.GetMusicData: string;
+begin
+  SetLength(Result, Length(FMusicData));
+  if Length(FMusicData) <> 0 then
+    Move(FMusicData[1], Result[1], Length(FMusicData));
+end;
+procedure TMusicDataProp.ReadMidiData(Stream: TStream);
+var
+  Header: TMidiDataHeader;
+begin
+  Stream.ReadBuffer(Header, SizeOf(Header));
+  SetLength(FMusicData, Header.Size);
+  Stream.ReadBuffer(FMusicData[1], Header.Size);
+end;
+procedure TMusicDataProp.SetMusicData(const Value: string);
+begin
+  SetLength(FMusicData, Length(Value));
+  if Length(Value) <> 0 then
+    Move(Value[1], FMusicData[1], Length(Value));
+end;
+procedure TMusicDataProp.WriteMidiData(Stream: TStream);
+var
+  Header: TMidiDataHeader;
+begin
+  Header.Size := Length(FMusicData);
+  Stream.WriteBuffer(Header, SizeOf(Header));
+  Stream.WriteBuffer(FMusicData[1], Header.Size);
+end;
+{ TMusicListCollectionItem }
+procedure TMusicListCollectionItem.Load;
+var
+  MidiFilelength: Integer;
+begin
+  // kdyby nahodou uz nejaky existoval tak ho znic
+  if FDirectMusicSegment <> nil then
+    FDirectMusicSegment := nil;
+  ZeroMemory(@FMusicObjDesc, SizeOf(TDMUS_OBJECTDESC));
+  // tohle je popisek parametru - chceme hrat z pameti
+  with FMusicObjDesc do
+  begin
+    dwsize := SizeOf(TDMUS_OBJECTDESC);
+    guidclass := CLSID_DirectMusicSegment;
+    //tohle jen pokud je to ze souboru
+    //dwvaliddata := DMUS_OBJ_CLASS or DMUS_OBJ_FULLPATH or DMUS_OBJ_FILENAME;
+    dwvaliddata := DMUS_OBJ_CLASS or DMUS_OBJ_MEMORY or DMUS_OBJ_LOADED;
+    pbMemData := @FMusicDataProp.FMusicData[1];
+    llMemLength := Length(FMusicDataProp.FMusicData);
+  end;
+  if FDirectMusicLoader.GetObject(FMusicObjDesc, IID_IDirectMusicSegment, FDirectMusicSegment) <> dm_ok then
+    raise EDXMusicError.Create('Failed to Get object for Direct music'); ;
+  if FDirectMusicSegment.setParam(GUID_StandardMidiFile, $FFFFFFFF, 0, 0, Pointer(FDirectMusicPerformance)) <> dm_ok then
+    raise EDXMusicError.Create('Failed to Set param for Direct music'); ;
+  if FDirectMusicSegment.setParam(GUID_Download, $FFFFFFFF, 0, 0, Pointer(FDirectMusicPerformance)) <> dm_ok then
+    raise EDXMusicError.Create('Failed to Set param for Direct music'); ;
+  FDirectMusicSegment.GetLength(MidiFilelength);
+  if (FActualDuration < MidiFilelength) and (FActualDuration > 0) then
+    FDirectMusicSegment.SetLength(FActualDuration);
+  if FActualStartPoint < MidiFilelength - FActualDuration then
+    FDirectMusicSegment.SetStartpoint(FActualStartPoint);
+  // jak opakovat
+  FDirectMusicSegment.Setrepeats(repeats - 1);
+end;
+constructor TMusicListCollectionItem.Create(Collection: TCollection);
+begin
+  inherited Create(Collection);
+  CoInitialize(nil);
+  FMusicDataProp := TMusicDataProp.Create;
+  SetLength(FMusicDataProp.FMusicData, 0);
+  FDirectMusicPerformance := nil;
+  FDirectMusic := nil;
+  FDirectSound := nil;
+  FDirectMusicSegment := nil;
+  FDirectMusicLoader := nil;
+  FIsInitialized := False;
+end;
+procedure TMusicListCollectionItem.Stop;
+begin
+  if FDirectMusicPerformance <> nil then
+    FDirectMusicPerformance.Stop(nil, nil, 0, 0);
+end;
+function TMusicListCollectionItem.GetDisplayName: string;
+begin
+  Result := inherited GetDisplayName
+end;
+procedure TMusicListCollectionItem.Play;
+begin
+  if not FIsInitialized then
+    Init;
+  Load;
+  if FDirectMusicPerformance <> nil then
+    FDirectMusicPerformance.PlaySegment(FDirectMusicSegment, 0, 0, @FDirectMusicSegmentState);
+end;
+function TMusicListCollectionItem.IsPlaying: Boolean;
+begin
+  Result := False;
+  if FDirectMusicPerformance <> nil then
+    Result := FDirectMusicPerformance.IsPlaying(FDirectMusicSegment, FDirectMusicSegmentState) = DM_OK;
+end;
+destructor TMusicListCollectionItem.Destroy;
+begin
+  FDirectMusicPerformance := nil;
+  FDirectMusic := nil;
+  FDirectSound := nil;
+  FDirectMusicSegment := nil;
+  FDirectMusicLoader := nil;
+  FMusicDataProp.Free;
+  CoUninitialize;
+  inherited Destroy;
+end;
+procedure TMusicListCollectionItem.SetRepeats(const Value: Cardinal);
+begin
+  Frepeats := Value;
+end;
+procedure TMusicListCollectionItem.SetStartPoint(const Value: integer);
+begin
+  FStartPoint := Value;
+end;
+procedure TMusicListCollectionItem.SetDuration(const Value: integer);
+begin
+  FDuration := Value;
+end;
+procedure TMusicListCollectionItem.Init;
+var OK: Boolean;
+begin
+  FIsInitialized := False;
+  OK := False;
+  // vytvor FDirectMusicPerformance pokud uz neni vytvoreno
+  if FDirectMusicPerformance = nil then
+    OK := CoCreateInstance(CLSID_DirectMusicPerformance, nil, CLSCTX_INPROC,
+      IID_IDirectMusicperformance, FDirectMusicPerformance) = DM_OK;
+  if not OK then Exit;
+  if FDirectSound <> nil then
+    OK := FDirectMusicPerformance.Init({$IFDEF DX7}@{$ENDIF}FDirectMusic, FDirectSound, 0) = DM_OK
+  else
+    OK := FDirectMusicPerformance.Init({$IFDEF DX7}@{$ENDIF}FDirectMusic, nil, 0) = dm_OK;
+  if not OK then Exit;
+  // vychozi midi port
+  // pridej pokud neni nastaven
+  if FDirectMusicPerformance.Addport(nil) <> DM_OK then Exit;
+  // zkus vytvorit loader
+  OK := CoCreateInstance(CLSID_DirectMusicLoader, nil, CLSCTX_Inproc,
+    IID_IDirectMusicLoader, FDirectMusicLoader) = DM_OK;
+  FIsInitialized := OK;
+end;
+function TMusicListCollectionItem.GetMusicListCollection: TMusicListCollection;
+begin
+  Result := Collection as TMusicListCollection;
+end;
+procedure TMusicListCollectionItem.SaveToFile(const MidiFileName: string);
+var F: file;
+begin
+  AssignFile(F, MidiFileName);
+  Rewrite(F, 1);
+  try
+    BlockWrite(F, FMusicDataProp.FMusicData[1], Length(FMusicDataProp.FMusicData));
+  finally
+    CloseFile(F);
+  end;
+end;
+procedure TMusicListCollectionItem.LoadFromFile(const MidiFileName: string);
+var F: file; S: string; I: Integer;
+begin
+  AssignFile(F, MidiFileName);
+  Reset(F, 1);
+  try
+    SetLength(FMusicDataProp.FMusicData, FileSize(F));
+    BlockRead(F, FMusicDataProp.FMusicData[1], FileSize(F));
+    S := ExtractFileName(MidiFileName);
+    I := Pos(ExtractFileExt(S), S);
+    if I > 0 then S := Copy(S, 1, I - 1);
+    FMusicDataProp.Midiname := S;
+  finally
+    CloseFile(F);
+  end;
+  Name := ExtractFileName(MidiFileName);
+end;
+function TMusicListCollectionItem.Size: Integer;
+begin
+  Result := Length(FMusicDataProp.FMusicData);
+end;
+{ TMusicListCollection }
+constructor TMusicListCollection.Create(AOwner: TComponent);
+begin
+  inherited Create(TMusicListCollectionItem);
+  FOwner := AOwner;
+end;
+function TMusicListCollection.Add: TMusicListCollectionItem;
+begin
+  Result := TMusicListCollectionItem(inherited Add);
+  Result.FDirectSound := Self.FDirectSound;
+end;
+function TMusicListCollection.GetItem(Index: Integer): TMusicListCollectionItem;
+begin
+  Result := TMusicListCollectionItem(inherited GetItem(Index));
+end;
+procedure TMusicListCollection.SetItem(Index: Integer;
+  Value: TMusicListCollectionItem);
+begin
+  inherited SetItem(Index, Value);
+end;
+procedure TMusicListCollection.Update(Item: TCollectionItem);
+begin
+  inherited Update(Item);
+end;
+function TMusicListCollection.Find(
+  const Name: string): TMusicListCollectionItem;
+var
+  i: Integer;
+begin
+  i := IndexOf(Name);
+  if i = -1 then
+    raise EDXMusicError.CreateFmt('The midi document does not exist: %s.', [Name]);
+  Result := Items[i];
+end;
+{$IFDEF VER4UP}
+function TMusicListCollection.Insert(Index: Integer): TMusicListCollectionItem;
+begin
+  Result := TMusicListCollectionItem(inherited Insert(Index));
+end;
+{$ENDIF}
+function TMusicListCollection.GetOwner: TPersistent;
+begin
+  Result := FOwner;
+end;
+procedure TMusicListCollection.Restore;
+begin
+end;
+procedure TMusicListCollection.SaveToFile(const FileName: string);
+var
+  Stream: TFileStream;
+begin
+  Stream := TFileStream.Create(FileName, fmCreate);
+  try
+    SaveToStream(Stream);
+  finally
+    Stream.Free;
+  end;
+end;
+procedure TMusicListCollection.LoadFromFile(const FileName: string);
+var
+  Stream: TFileStream;
+begin
+  Stream := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
+  try
+    LoadFromStream(Stream);
+  finally
+    Stream.Free;
+  end;
+end;
+type
+  TMidiCollectionComponent = class(TComponent)
+  private
+    FList: TMusicListCollection;
+  published
+    property List: TMusicListCollection read FList write FList;
+  end;
+procedure TMusicListCollection.SaveToStream(Stream: TStream);
+var
+  Component: TMidiCollectionComponent;
+begin
+  Component := TMidiCollectionComponent.Create(nil);
+  try
+    Component.FList := Self;
+    Stream.WriteComponentRes('DelphiXMidiCollection', Component);
+  finally
+    Component.Free;
+  end;
+end;
+procedure TMusicListCollection.LoadFromStream(Stream: TStream);
+var
+  Component: TMidiCollectionComponent;
+begin
+  Clear;
+  Component := TMidiCollectionComponent.Create(nil);
+  try
+    Component.FList := Self;
+    Stream.ReadComponentRes(Component);
+    Restore;
+  finally
+    Component.Free;
+  end;
+end;
+{ TDXMusic }
+constructor TDXMusic.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+  FMidis := TMusicListCollection.Create(Self);
+  if Assigned(FDXSound) then
+    FMidis.FDirectSound := FDXSound.DSound.IDSound;
+end;
+procedure TDXMusic.SetMidis(const value: TMusicListCollection);
+begin
+  FMidis.Assign(Value);
+end;
+destructor TDXMusic.Destroy;
+begin
+  FMidis.Free;
+  inherited Destroy;
+end;
+procedure TDXMusic.SetDXSound(const Value: TDXSound);
+begin
+  FDXSound := Value;
+  if Assigned(FDXSound) then
+    FMidis.FDirectSound := FDXSound.DSound.IDSound;
+end;
 initialization
 finalization
   DirectSoundDrivers.Free;
   DirectSoundCaptureDrivers.Free;
 end.

Subversion Repositories spacemission

spacemission/VCL_DELPHIX_D6/DXSounds.pas – Rev 1 → 4