Subversion Repositories spacemission

Compare Revisions

Ignore whitespace Rev HEAD → Rev 1

/VCL_DELPHIX_D6/DXSounds.pas
5,13 → 5,8
{$INCLUDE DelphiXcfg.inc}
 
uses
Windows, Messages, SysUtils, Classes, Controls, Forms, ExtCtrls, MMSystem, ActiveX,
DXClass, DXWave, D3DUtils, {$IFDEF VER17UP} Types, {$ENDIF}
{$IFDEF StandardDX}
DirectSound, DirectMusic;
{$ELSE}
DirectX;
{$ENDIF}
Windows, Messages, SysUtils, Classes, Controls, Forms, ExtCtrls, MMSystem,
DirectX, DXClass, Wave;
 
type
 
35,7 → 30,7
function GetBufferCount: Integer;
function GetIDSound: IDirectSound;
function GetISound: IDirectSound;
protected
protected
procedure CheckBuffer(Buffer: TDirectSoundBuffer);
procedure DoRestoreBuffer; virtual;
public
48,50 → 43,6
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)
98,8 → 49,6
private
FDSound: TDirectSound;
FIDSBuffer: IDirectSoundBuffer;
FIDS3DBuffer:IDirectSound3DBuffer;
FD3DSParams: TD3DSParams;
FCaps: TDSBCaps;
FFormat: PWaveFormatEx;
FFormatSize: Integer;
106,7 → 55,6
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;
123,9 → 71,6
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
141,10 → 86,10
function Lock(LockPosition, LockSize: Longint;
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; D3D: Boolean {$IFNDEF VER100}= False{$ENDIF});
procedure SetSize(const Format: TWaveFormatEx; Size: Integer);
procedure Stop;
procedure UnLock;
property BitCount: Longint read GetBitCount;
154,11 → 99,8
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;
228,7 → 170,7
property Volume: Integer read GetVolume write SetVolume;
property WaveStream: TCustomWaveStream read FWaveStream write SetWaveStream;
end;
 
{ TAudioFileStream }
 
TAudioFileStream = class(TAudioStream)
435,8 → 377,6
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;
449,8 → 389,6
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;
507,125 → 445,10
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
636,13 → 459,13
(lpGUID, lpDS, pUnkOuter);
end;
 
function DXDirectSoundEnumerate(lpCallback: {$IFDEF UNICODE}TDSEnumCallbackW{$ELSE}TDSEnumCallbackA{$ENDIF};
lpContext: Pointer): HRESULT;
function DXDirectSoundEnumerate(lpCallback: TDSEnumCallbackA;
lpContext: Pointer): HRESULT;
type
TDirectSoundEnumerate = function(lpCallback: {$IFDEF UNICODE}TDSEnumCallbackW{$ELSE}TDSEnumCallbackA{$ENDIF};
TDirectSoundEnumerate = function(lpCallback: TDSEnumCallbackA;
lpContext: Pointer): HRESULT; stdcall;
begin
Result := TDirectSoundEnumerate(DXLoadLibrary('DSound.dll', {$IFDEF UNICODE}'DirectSoundEnumerateW'{$ELSE}'DirectSoundEnumerateA'{$ENDIF}))
Result := TDirectSoundEnumerate(DXLoadLibrary('DSound.dll', 'DirectSoundEnumerateA'))
(lpCallback, lpContext);
end;
 
661,13 → 484,13
end;
 
function DXDirectSoundCaptureEnumerate(lpCallback: TDSEnumCallbackA;
lpContext: Pointer): HRESULT;
lpContext: Pointer): HRESULT;
type
TDirectSoundCaptureEnumerate = function(lpCallback: TDSEnumCallbackA;
lpContext: Pointer): HRESULT; stdcall;
begin
try
Result := TDirectSoundCaptureEnumerate(DXLoadLibrary('DSound.dll', {$IFDEF UNICODE}'DirectSoundCaptureEnumerateW'{$ELSE}'DirectSoundCaptureEnumerateA'{$ENDIF}))
Result := TDirectSoundCaptureEnumerate(DXLoadLibrary('DSound.dll', 'DirectSoundCaptureEnumerateA'))
(lpCallback, lpContext);
except
raise EDirectXError.Create(SSinceDirectX5);
678,8 → 501,8
DirectSoundDrivers: TDirectXDrivers;
DirectSoundCaptureDrivers: TDirectXDrivers;
 
function EnumDirectSoundDrivers_DSENUMCALLBACK(lpGuid: PGUID; lpstrDescription: {$IFDEF UNICODE}LPCTSTR{$ELSE}LPCSTR{$ENDIF};
lpstrModule: {$IFDEF UNICODE}LPCTSTR{$ELSE}LPCSTR{$ENDIF}; lpContext: Pointer): BOOL; stdcall;
function EnumDirectSoundDrivers_DSENUMCALLBACK(lpGuid: PGUID; lpstrDescription: LPCSTR;
lpstrModule: LPCSTR; lpContext: Pointer): BOOL; stdcall;
begin
Result := True;
with TDirectXDriver.Create(TDirectXDrivers(lpContext)) do
692,7 → 515,7
 
function EnumDirectSoundDrivers: TDirectXDrivers;
begin
if DirectSoundDrivers = nil then
if DirectSoundDrivers=nil then
begin
DirectSoundDrivers := TDirectXDrivers.Create;
try
708,7 → 531,7
 
function EnumDirectSoundCaptureDrivers: TDirectXDrivers;
begin
if DirectSoundCaptureDrivers = nil then
if DirectSoundCaptureDrivers=nil then
begin
DirectSoundCaptureDrivers := TDirectXDrivers.Create;
try
729,14 → 552,14
inherited Create;
FBufferList := TList.Create;
 
if DXDirectSoundCreate(GUID, FIDSound, nil) <> DS_OK then
if DXDirectSoundCreate(GUID, FIDSound, nil)<>DS_OK then
raise EDirectSoundError.CreateFmt(SCannotInitialized, [SDirectSound]);
end;
 
destructor TDirectSound.Destroy;
begin
while BufferCount > 0 do
Buffers[BufferCount - 1].Free;
while BufferCount>0 do
Buffers[BufferCount-1].Free;
FBufferList.Free;
 
FIDSound := nil;
782,7 → 605,7
 
function TDirectSound.GetIDSound: IDirectSound;
begin
if Self <> nil then
if Self<>nil then
Result := FIDSound
else
Result := nil;
791,7 → 614,7
function TDirectSound.GetISound: IDirectSound;
begin
Result := IDSound;
if Result = nil then
if Result=nil then
raise EDirectSoundError.CreateFmt(SNotMade, ['IDirectSound']);
end;
 
800,9 → 623,7
constructor TDirectSoundBuffer.Create(ADirectSound: TDirectSound);
begin
inherited Create;
FIsD3D := False;
FDSound := ADirectSound;
FIDS3DBuffer := nil;
FDSound.FBufferList.Add(Self);
end;
 
809,7 → 630,6
destructor TDirectSoundBuffer.Destroy;
begin
IDSBuffer := nil;
IDS3DBuffer := nil;
FDSound.FBufferList.Remove(Self);
inherited Destroy;
end;
818,37 → 638,23
var
TempBuffer: IDirectSoundBuffer;
begin
if Source = nil then
if Source=nil then
IDSBuffer := nil
else
if Source is TWave then
else if Source is TWave then
LoadFromWave(TWave(Source))
else
if Source is TDirectSoundBuffer then
else if Source is TDirectSoundBuffer then
begin
if TDirectSoundBuffer(Source).IDSBuffer = nil then
if TDirectSoundBuffer(Source).IDSBuffer=nil then
IDSBuffer := nil
else
begin
FDSound.DXResult := FDSound.ISound.DuplicateSoundBuffer(TDirectSoundBuffer(Source).IDSBuffer, TempBuffer);
if FDSound.DXResult = DS_OK then
else begin
FDSound.DXResult := FDSound.ISound.DuplicateSoundBuffer(TDirectSoundBuffer(Source).IDSBuffer,
TempBuffer);
if FDSound.DXResult=0 then
begin
IDSBuffer := TempBuffer;
end;
end;
 
if FIsD3D then
if TDirectSoundBuffer(Source).IDS3DBuffer = nil then
IDS3DBuffer := nil
else
begin
FDSound.DXResult := FDSound.ISound.QueryInterface(IID_IDirectSound3DBuffer, FIDS3DBuffer);
if FDSound.DXResult = DS_OK then
FD3DSParams := TDirectSoundBuffer(Source).FD3DSParams;
end;
 
end
else
end else
inherited Assign(Source);
end;
 
865,7 → 671,7
 
FDSound.DXResult := FDSound.ISound.CreateSoundBuffer(BufferDesc, TempBuffer, nil);
FDXResult := FDSound.DXResult;
Result := DXResult = DS_OK;
Result := DXResult=DS_OK;
if Result then
IDSBuffer := TempBuffer;
end;
886,17 → 692,9
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
Result := nil;
905,13 → 703,13
function TDirectSoundBuffer.GetIBuffer: IDirectSoundBuffer;
begin
Result := IDSBuffer;
if Result = nil then
if Result=nil then
raise EDirectSoundBufferError.CreateFmt(SNotMade, ['IDirectSoundBuffer']);
end;
 
function TDirectSoundBuffer.GetPlaying: Boolean;
begin
Result := (GetStatus and (DSBSTATUS_PLAYING or DSBSTATUS_LOOPING)) <> 0;
Result := (GetStatus and (DSBSTATUS_PLAYING or DSBSTATUS_LOOPING))<>0;
end;
 
function TDirectSoundBuffer.GetPan: Integer;
920,10 → 718,10
end;
 
function TDirectSoundBuffer.GetPosition: Longint;
var
var
dwCurrentWriteCursor: Longint;
begin
IBuffer.GetCurrentPosition(@DWORD(Result), @DWORD(dwCurrentWriteCursor));
IBuffer.GetCurrentPosition(DWORD(Result), DWORD(dwCurrentWriteCursor));
end;
 
function TDirectSoundBuffer.GetSize: Integer;
943,9 → 741,9
 
procedure TDirectSoundBuffer.LoadFromFile(const FileName: string);
var
Stream: TFileStream;
Stream : TFileStream;
begin
Stream := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
Stream := TFileStream.Create(FileName, fmOpenRead);
try
LoadFromStream(Stream);
finally
959,24 → 757,22
Data1, Data2: Pointer;
Data1Size, Data2Size: Longint;
begin
SetSize(Format, Size, FIsD3D);
SetSize(Format, Size);
 
if Data <> nil then
if Data<>nil then
begin
if Lock(0, Size, Data1, Data1Size, Data2, Data2Size) then
begin
try
Move(Data^, Data1^, Data1Size);
if Data2 <> nil then
Move(Pointer(Longint(Data) + Data1Size)^, Data2^, Data2Size);
if Data2<>nil then
Move(Pointer(Longint(Data)+Data1Size)^, Data2^, Data2Size);
finally
UnLock;
end;
end
else
end else
begin
FIDSBuffer := nil;
FIDS3DBuffer := nil;
raise EDirectSoundBufferError.CreateFmt(SCannotLock, [SDirectSoundBuffer]);
end;
end;
983,7 → 779,7
end;
 
procedure TDirectSoundBuffer.LoadFromStream(Stream: TStream);
var
var
Wave: TWave;
begin
Wave := TWave.Create;
1005,13 → 801,14
var AudioPtr2: Pointer; var AudioSize2: Longint): Boolean;
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,
{$IFNDEF DX7}@{$ENDIF}FLockAudioPtr1[FLockCount], {$IFNDEF DX7}@{$ENDIF}FLockAudioSize1[FLockCount],
{$IFNDEF DX7}@{$ENDIF}FLockAudioPtr2[FLockCount], {$IFNDEF DX7}@{$ENDIF}FLockAudioSize2[FLockCount], 0);
Result := DXResult = DS_OK;
FLockAudioPtr1[FLockCount], FLockAudioSize1[FLockCount],
FLockAudioPtr2[FLockCount], FLockAudioSize2[FLockCount], 0);
Result := DXResult=DS_OK;
 
if Result then
begin
1029,24 → 826,19
DXResult := IBuffer.Play(0, 0, DSBPLAY_LOOPING)
else
DXResult := IBuffer.Play(0, 0, 0);
Result := DXResult = DS_OK;
Result := DXResult=DS_OK;
end;
 
function TDirectSoundBuffer.Restore: Boolean;
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(FFormat{$IFDEF DX7}^{$ENDIF});
Result := DXResult = DS_OK;
DXResult := IBuffer.SetFormat(Format);
Result := DXResult=DS_OK;
 
if Result then
begin
1053,11 → 845,11
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, nil);
end;
IBuffer.GetFormat(FFormat^, FFormatSize, PDWORD(nil)^);
end;
end;
end;
 
1066,33 → 858,9
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;
FillChar(FCaps, SizeOf(FCaps), 0);
1101,16 → 869,16
FFormatSize := 0;
FLockCount := 0;
 
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, nil);
end;
IBuffer.GetFormat(FFormat^, FFormatSize, PDWORD(nil)^);
end;
end;
end;
 
1123,18 → 891,14
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; D3D: Boolean {$IFNDEF VER100}= False{$ENDIF});
procedure TDirectSoundBuffer.SetSize(const Format: TWaveFormatEx; Size: Integer);
var
BufferDesc: TDSBufferDesc;
begin
{ IDirectSoundBuffer made. }
FillChar(BufferDesc, SizeOf(BufferDesc), 0);
 
with BufferDesc do
begin
dwSize := SizeOf(TDSBufferDesc);
1143,8 → 907,6
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;
1165,8 → 927,8
 
procedure TDirectSoundBuffer.Unlock;
begin
if IDSBuffer = nil then Exit;
if FLockCount = 0 then Exit;
if IDSBuffer=nil then Exit;
if FLockCount=0 then Exit;
 
Dec(FLockCount);
DXResult := IBuffer.UnLock(FLockAudioPtr1[FLockCount], FLockAudioSize1[FLockCount],
1173,207 → 935,6
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
1424,7 → 985,7
 
procedure TAudioStreamNotify.Execute;
begin
while WaitForSingleObject(FAudio.FNotifyEvent, FSleepTime) = WAIT_TIMEOUT do
while WaitForSingleObject(FAudio.FNotifyEvent, FSleepTime)=WAIT_TIMEOUT do
Synchronize(Update);
end;
 
1466,7 → 1027,7
 
function TAudioStream.GetFormat: PWaveFormatEX;
begin
if WaveStream = nil then
if WaveStream=nil then
raise EAudioStreamError.Create(SWaveStreamNotSet);
Result := WaveStream.Format;
end;
1473,7 → 1034,7
 
function TAudioStream.GetFormatSize: Integer;
begin
if WaveStream = nil then
if WaveStream=nil then
raise EAudioStreamError.Create(SWaveStreamNotSet);
Result := WaveStream.FormatSize;
end;
1496,7 → 1057,7
 
function TAudioStream.GetSize: Integer;
begin
if WaveStream <> nil then
if WaveStream<>nil then
Result := WaveStream.Size
else
Result := 0;
1542,7 → 1103,7
end;
 
i := WaveStream.FilledSize;
if i >= 0 then Result := Min(Result, i);
if i>=0 then Result := Min(Result, i);
end;
 
procedure TAudioStream.Play;
1549,10 → 1110,10
begin
if not FPlaying then
begin
if WaveStream = nil then
if WaveStream=nil then
raise EAudioStreamError.Create(SWaveStreamNotSet);
 
if Size = 0 then Exit;
if Size=0 then Exit;
 
FPlaying := True;
try
1575,12 → 1136,12
AVolume: Integer;
begin
APlaying := Playing;
 
APosition := Position;
AFrequency := Frequency;
APan := Pan;
AVolume := Volume;
 
SetWaveStream(WaveStream);
 
Position := APosition;
1587,18 → 1148,18
Frequency := AFrequency;
Pan := APan;
Volume := AVolume;
 
if APlaying then Play;
end;
 
procedure TAudioStream.SetAutoUpdate(Value: Boolean);
begin
if FAutoUpdate <> Value then
if FAutoUpdate<>Value then
begin
FAutoUpdate := Value;
if FPlaying then
begin
if FNotifyThread <> nil then
if FNotifyThread<>nil then
begin
(FNotifyThread as TAudioStreamNotify).FStopOnTerminate := False;
FNotifyThread.Free;
1612,11 → 1173,11
 
procedure TAudioStream.SetBufferLength(Value: Integer);
begin
if Value < 10 then Value := 10;
if FBufferLength <> Value then
if Value<10 then Value := 10;
if FBufferLength<>Value then
begin
FBufferLength := Value;
if WaveStream <> nil then RecreateBuf;
if WaveStream<>nil then RecreateBuf;
end;
end;
 
1627,7 → 1188,7
 
procedure TAudioStream.SetLooped(Value: Boolean);
begin
if FLooped <> Value then
if FLooped<>Value then
begin
FLooped := Value;
Position := Position;
1647,10 → 1208,10
 
procedure TAudioStream.SetPosition(Value: Integer);
begin
if WaveStream = nil then
if WaveStream=nil then
raise EAudioStreamError.Create(SWaveStreamNotSet);
 
Value := Max(Min(Value, Size - 1), 0);
Value := Max(Min(Value, Size-1), 0);
Value := Value div Format^.nBlockAlign * Format^.nBlockAlign;
 
FPosition := Value;
1691,7 → 1252,7
FPosition := 0;
FWritePosition := 0;
 
if (Value <> nil) and (FBufferLength > 0) then
if (Value<>nil) and (FBufferLength>0) then
begin
FBufferSize := FBufferLength * Integer(Value.Format^.nAvgBytesPerSec) div 1000;
 
1743,10 → 1304,10
try
UpdatePlayedSize;
 
if Size < 0 then
if Size<0 then
begin
WriteSize := GetWriteSize;
if WriteSize > 0 then
if WriteSize>0 then
begin
WriteSize := WriteWave(WriteSize);
FPosition := FPosition + WriteSize;
1756,7 → 1317,7
if FLooped then
begin
WriteSize := GetWriteSize;
if WriteSize > 0 then
if WriteSize>0 then
begin
WriteWave(WriteSize);
FPosition := (FPosition + WriteSize) mod Size;
1763,14 → 1324,14
end;
end else
begin
if FPosition < Size then
if FPosition<Size then
begin
WriteSize := GetWriteSize;
if WriteSize > 0 then
if WriteSize>0 then
begin
WriteWave(WriteSize);
FPosition := FPosition + WriteSize;
if FPosition > Size then FPosition := Size;
if FPosition>Size then FPosition := Size;
end;
end else
begin
1804,7 → 1365,7
FWaveStream.ReadBuffer(Data1^, Data1Size);
FWritePosition := FWritePosition + Data1Size;
 
if Data2 <> nil then
if Data2<>nil then
begin
FWaveStream.ReadBuffer(Data2^, Data2Size);
FWritePosition := FWritePosition + Data2Size;
1831,7 → 1392,7
FBufferPos := (FBufferPos + DWORD(s1)) mod FBufferSize;
Inc(Result, s1);
 
if (Data2 <> nil) and (s1 = Data1Size) then
if (Data2<>nil) and (s1=Data1Size) then
begin
s2 := FWaveStream.Read(Data2^, Data2Size);
FWritePosition := FWritePosition + s2;
1850,7 → 1411,7
Data1, Data2: Pointer;
Data1Size, Data2Size: Longint;
begin
if Format^.wBitsPerSample = 8 then C := $80 else C := 0;
if Format^.wBitsPerSample=8 then C := $80 else C := 0;
 
if FBuffer.Lock(FBufferPos, Size, Data1, Data1Size, Data2, Data2Size) then
begin
1857,7 → 1418,7
try
FillChar(Data1^, Data1Size, C);
 
if Data2 <> nil then
if Data2<>nil then
FillChar(Data2^, Data2Size, C);
finally
FBuffer.UnLock;
1870,14 → 1431,14
var
DataSize: Integer;
begin
if Size >= 0 then
if Size>=0 then
begin
Result := WriteSize;
if FLooped then
begin
while WriteSize > 0 do
while WriteSize>0 do
begin
DataSize := Min(Size - FWritePosition, WriteSize);
DataSize := Min(Size-FWritePosition, WriteSize);
 
WriteData(DataSize);
FWritePosition := FWritePosition mod Size;
1886,20 → 1447,20
end;
end else
begin
DataSize := Size - FWritePosition;
DataSize := Size-FWritePosition;
 
if DataSize <= 0 then
if DataSize<=0 then
begin
WriteSilence(WriteSize);
end else
if DataSize >= WriteSize then
begin
WriteData(WriteSize);
end else
begin
WriteData(DataSize);
WriteSilence(WriteSize - DataSize);
end;
if DataSize>=WriteSize then
begin
WriteData(WriteSize);
end else
begin
WriteData(DataSize);
WriteSilence(WriteSize-DataSize);
end;
end;
end else
begin
1918,11 → 1479,11
 
procedure TAudioFileStream.SetFileName(const Value: string);
begin
if FFileName = Value then Exit;
if FFileName=Value then Exit;
 
FFileName := Value;
 
if FWaveFileStream <> nil then
if FWaveFileStream<>nil then
begin
WaveStream := nil;
FWaveFileStream.Free;
1929,7 → 1490,7
FWaveFileStream := nil;
end;
 
if Value <> '' then
if Value<>'' then
begin
try
FWaveFileStream := TWaveFileStream.Create(Value, fmOpenRead or fmShareDenyWrite);
1960,9 → 1521,9
i: Integer;
begin
Result := -1;
for i := 0 to Count - 1 do
for i:=0 to Count-1 do
with Items[i] do
if (FSamplesPerSec = ASamplesPerSec) and (FBitsPerSample = ABitsPerSample) and (FChannels = AChannels) then
if (FSamplesPerSec=ASamplesPerSec) and (FBitsPerSample=ABitsPerSample) and (FChannels=AChannels) then
begin
Result := i;
Break;
2008,7 → 1569,7
 
procedure TSoundCaptureStreamNotify.Execute;
begin
while WaitForSingleObject(FCapture.FNotifyEvent, FSleepTime) = WAIT_TIMEOUT do
while WaitForSingleObject(FCapture.FNotifyEvent, FSleepTime)=WAIT_TIMEOUT do
begin
Synchronize(Update);
end;
2016,7 → 1577,7
 
procedure TSoundCaptureStreamNotify.Update;
begin
if FCapture.FilledSize > 0 then
if FCapture.FilledSize>0 then
begin
try
FCapture.DoFilledBuffer;
2045,13 → 1606,13
FBufferLength := 1000;
FSupportedFormats := TSoundCaptureFormats.Create;
 
if DXDirectSoundCaptureCreate(GUID, FCapture, nil) <> DS_OK then
if DXDirectSoundCaptureCreate(GUID, FCapture, nil)<>DS_OK then
raise ESoundCaptureStreamError.CreateFmt(SCannotInitialized, [SDirectSoundCapture]);
 
{ The supported format list is acquired. }
for ASamplesPerSec := Low(SamplesPerSecList) to High(SamplesPerSecList) do
for ABitsPerSample := Low(BitsPerSampleList) to High(BitsPerSampleList) do
for AChannels := Low(ChannelsList) to High(ChannelsList) do
for ASamplesPerSec:=Low(SamplesPerSecList) to High(SamplesPerSecList) do
for ABitsPerSample:=Low(BitsPerSampleList) to High(BitsPerSampleList) do
for AChannels:=Low(ChannelsList) to High(ChannelsList) do
begin
{ Test }
MakePCMWaveFormatEx(Format, SamplesPerSecList[ASamplesPerSec], BitsPerSampleList[ABitsPerSample], ChannelsList[AChannels]);
2062,7 → 1623,7
dscbd.lpwfxFormat := @Format;
 
{ If the buffer can be made, the format of present can be used. }
if FCapture.CreateCaptureBuffer(dscbd, TempBuffer, nil) = DS_OK then
if FCapture.CreateCaptureBuffer(dscbd, TempBuffer, nil)=DS_OK then
begin
TempBuffer := nil;
with TSoundCaptureFormat.Create(FSupportedFormats) do
2101,9 → 1662,9
var
CapturePosition, ReadPosition: DWORD;
begin
if FBuffer.GetCurrentPosition(@DWORD(CapturePosition), @DWORD(ReadPosition)) = DS_OK then
if FBuffer.GetCurrentPosition(CapturePosition, ReadPosition)=DS_OK then
begin
if FBufferPos <= ReadPosition then
if FBufferPos<=ReadPosition then
Result := ReadPosition - FBufferPos
else
Result := FBufferSize - FBufferPos + ReadPosition;
2120,23 → 1681,21
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);
if Size > 0 then
Size := Min(Count-Result, GetReadSize);
if Size>0 then
begin
if FBuffer.Lock(FBufferPos, Size, Data1, {$IFNDEF DX7}@{$ENDIF}Data1Size,
Data2, {$IFNDEF DX7}@{$ENDIF}Data2Size, 0) = DS_OK then
if FBuffer.Lock(FBufferPos, Size, Data1, Data1Size, Data2, 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
Move(Data2^, Pointer(Integer(@Buffer) + Result)^, Data2Size);
Move(Data2^, Pointer(Integer(@Buffer)+Result)^, Data2Size);
Result := Result + Integer(Data1Size);
end;
 
2145,17 → 1704,17
end else
Break;
end;
if Result < Count then Sleep(50);
if Result<Count then Sleep(50);
end;
 
case Format^.wBitsPerSample of
8: C := $80;
8: C := $80;
16: C := $00;
else
C := $00;
end;
 
FillChar(Pointer(Integer(@Buffer) + Result)^, Count - Result, C);
FillChar(Pointer(Integer(@Buffer)+Result)^, Count-Result, C);
Result := Count;
end;
 
2178,7 → 1737,7
if Assigned(FOnFilledBuffer) then
begin
FNotifyThread := TSoundCaptureStreamNotify.Create(Self);
FNotifyThread.{$IFDEF VER14UP}Start{$ELSE}Resume{$ENDIF};
FNotifyThread.Resume;
end;
end else
FOnFilledBuffer := Value;
2203,7 → 1762,7
dscbd.dwBufferBytes := FBufferSize;
dscbd.lpwfxFormat := Format;
 
if FCapture.CreateCaptureBuffer(dscbd, FBuffer, nil) <> DS_OK then
if FCapture.CreateCaptureBuffer(dscbd, FBuffer, nil)<>DS_OK then
raise ESoundCaptureStreamError.CreateFmt(SCannotMade, [SDirectSoundCaptureBuffer]);
 
FBufferPos := 0;
2213,7 → 1772,7
if Assigned(FOnFilledBuffer) then
begin
FNotifyThread := TSoundCaptureStreamNotify.Create(Self);
FNotifyThread.{$IFDEF VER14UP}Start{$ELSE}Resume{$ENDIF};
FNotifyThread.Resume;
end;
except
Stop;
2227,7 → 1786,7
begin
FNotifyThread.Free;
FCapturing := False;
if FBuffer <> nil then
if FBuffer<>nil then
FBuffer.Stop;
FBuffer := nil;
end;
2241,6 → 1800,7
FDSound := ADSound;
FEnabled := True;
 
 
FEffectList := TList.Create;
FTimer := TTimer.Create(nil);
FTimer.Interval := 500;
2259,7 → 1819,7
var
i: Integer;
begin
for i := EffectCount - 1 downto 0 do
for i:=EffectCount-1 downto 0 do
Effects[i].Free;
FEffectList.Clear;
end;
2266,9 → 1826,9
 
procedure TSoundEngine.EffectFile(const Filename: string; Loop, Wait: Boolean);
var
Stream: TFileStream;
Stream : TFileStream;
begin
Stream := TFileStream.Create(Filename, fmOpenRead or fmShareDenyWrite);
Stream :=TFileStream.Create(Filename, fmOpenRead);
try
EffectStream(Stream, Loop, Wait);
finally
2334,7 → 1894,7
var
i: Integer;
begin
for i := EffectCount - 1 downto 0 do
for i:=EffectCount-1 downto 0 do
Effects[i].Free;
FEffectList.Clear;
 
2346,7 → 1906,7
var
i: Integer;
begin
for i := EffectCount - 1 downto 0 do
for i:=EffectCount-1 downto 0 do
if not TDirectSoundBuffer(FEffectList[i]).Playing then
begin
TDirectSoundBuffer(FEffectList[i]).Free;
2411,7 → 1971,7
Event: PDXSoundNotifyEvent;
i: Integer;
begin
for i := 0 to FNotifyEventList.Count - 1 do
for i:=0 to FNotifyEventList.Count-1 do
begin
Event := FNotifyEventList[i];
if (TMethod(Event^).Code = TMethod(NotifyEvent).Code) and
2432,7 → 1992,7
var
i: Integer;
begin
for i := FNotifyEventList.Count - 1 downto 0 do
for i:=FNotifyEventList.Count-1 downto 0 do
PDXSoundNotifyEvent(FNotifyEventList[i])^(Self, NotifyType);
end;
 
2440,11 → 2000,11
begin
case Message.Msg of
WM_CREATE:
begin
DefWindowProc(Message);
SetForm(FForm);
Exit;
end;
begin
DefWindowProc(Message);
SetForm(FForm);
Exit;
end;
end;
DefWindowProc(Message);
end;
2497,7 → 2057,7
SetOptions(FOptions);
 
FPrimary.Free; FPrimary := nil;
FDSound.Free; FDSound := nil;
FDSound.Free; FDSound := nil;
end;
end;
end;
2505,8 → 2065,8
procedure TCustomDXSound.Initialize;
const
PrimaryDesc: TDSBufferDesc = (
dwSize: SizeOf(PrimaryDesc);
dwFlags: DSBCAPS_PRIMARYBUFFER);
dwSize: SizeOf (PrimaryDesc);
dwFlags: DSBCAPS_PRIMARYBUFFER);
var
Component: TComponent;
begin
2513,9 → 2073,9
Finalize;
 
Component := Owner;
while (Component <> nil) and (not (Component is TCustomForm)) do
while (Component<>nil) and (not (Component is TCustomForm)) do
Component := Component.Owner;
if Component = nil then
if Component=nil then
raise EDXSoundError.Create(SNoForm);
 
NotifyEventList(dsntInitializing);
2559,7 → 2119,7
Initialize;
except
on E: EDirectSoundError do ;
else raise;
else raise;
end;
end;
end;
2663,40 → 2223,13
 
if PrevInitialized then
Restore;
end
else
end else
inherited Assign(Source);
end;
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;
end;
2713,7 → 2246,7
if not FInitialized then Exit;
FInitialized := False;
 
for i := 0 to FBufferList.Count - 1 do
for i:=0 to FBufferList.Count-1 do
TDirectSoundBuffer(FBufferList[i]).Free;
FBufferList.Clear;
FBuffer.Free; FBuffer := nil;
2728,7 → 2261,7
function TWaveCollectionItem.CreateBuffer: TDirectSoundBuffer;
begin
Result := nil;
if GetBuffer = nil then Exit;
if GetBuffer=nil then Exit;
 
Result := TDirectSoundBuffer.Create(WaveCollection.DXSound.DSound);
try
2751,39 → 2284,36
GetBuffer.Stop;
GetBuffer.Position := 0;
GetBuffer.Play(True);
end
else
end 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
NewBuffer := FBufferList[i];
Break;
end;
 
if NewBuffer = nil then
if NewBuffer=nil then
begin
if FMaxPlayingCount = 0 then
if FMaxPlayingCount=0 then
begin
NewBuffer := CreateBuffer;
if NewBuffer = nil then Exit;
if NewBuffer=nil then Exit;
 
FBufferList.Add(NewBuffer);
end
else
end 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
else
end else
begin
NewBuffer := FBufferList[0];
FBufferList.Move(0, FBufferList.Count - 1);
FBufferList.Move(0, FBufferList.Count-1);
end;
end;
end;
2805,7 → 2335,7
 
procedure TWaveCollectionItem.Restore;
begin
if FWave.Size = 0 then Exit;
if FWave.Size=0 then Exit;
 
if not FInitialized then
begin
2814,7 → 2344,7
if not FInitialized then Exit;
end;
 
if FBuffer = nil then
if FBuffer=nil then
FBuffer := TDirectSoundBuffer.Create(WaveCollection.DXSound.DSound);
 
FBuffer.LoadFromWave(FWave);
2830,7 → 2360,7
if not FInitialized then Exit;
 
FBuffer.Stop;
for i := 0 to FBufferList.Count - 1 do
for i:=0 to FBufferList.Count-1 do
TDirectSoundBuffer(FBufferList[i]).Stop;
end;
 
2843,7 → 2373,7
 
procedure TWaveCollectionItem.SetLooped(Value: Boolean);
begin
if FLooped <> Value then
if FLooped<>Value then
begin
Stop;
FLooped := Value;
2854,15 → 2384,15
var
i: Integer;
begin
if Value < 0 then Value := 0;
if Value<0 then Value := 0;
 
if FMaxPlayingCount <> Value then
if FMaxPlayingCount<>Value then
begin
FMaxPlayingCount := Value;
 
if FInitialized then
begin
for i := 0 to FBufferList.Count - 1 do
for i:=0 to FBufferList.Count-1 do
TDirectSoundBuffer(FBufferList[i]).Free;
FBufferList.Clear;
end;
2911,7 → 2441,7
i: Integer;
begin
i := IndexOf(Name);
if i = -1 then
if i=-1 then
raise EWaveCollectionError.CreateFmt(SWaveNotFound, [Name]);
Result := Items[i];
end;
2920,7 → 2450,7
var
i: Integer;
begin
for i := 0 to Count - 1 do
for i:=0 to Count-1 do
Items[i].Finalize;
FDXSound := nil;
end;
2931,13 → 2461,13
begin
Finalize;
FDXSound := DXSound;
for i := 0 to Count - 1 do
for i:=0 to Count-1 do
Items[i].Initialize;
end;
 
function TWaveCollection.Initialized: Boolean;
begin
Result := (FDXSound <> nil) and (FDXSound.Initialized);
Result := (FDXSound<>nil) and (FDXSound.Initialized);
end;
 
procedure TWaveCollection.Restore;
2944,7 → 2474,7
var
i: Integer;
begin
for i := 0 to Count - 1 do
for i:=0 to Count-1 do
Items[i].Restore;
end;
 
3031,7 → 2561,7
procedure TCustomDXWaveList.Notification(AComponent: TComponent; Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
if (Operation = opRemove) and (DXSound = AComponent) then
if (Operation=opRemove) and (DXSound=AComponent) then
DXSound := nil;
end;
 
3041,19 → 2571,19
case NotifyType of
dsntDestroying: DXSound := nil;
dsntInitialize: FItems.Initialize(Sender);
dsntFinalize: FItems.Finalize;
dsntRestore: FItems.Restore;
dsntFinalize : FItems.Finalize;
dsntRestore : FItems.Restore;
end;
end;
 
procedure TCustomDXWaveList.SetDXSound(Value: TCustomDXSound);
begin
if FDXSound <> nil then
if FDXSound<>nil then
FDXSound.UnRegisterNotifyEvent(DXSoundNotifyEvent);
 
FDXSound := Value;
 
if FDXSound <> nil then
if FDXSound<>nil then
FDXSound.RegisterNotifyEvent(DXSoundNotifyEvent);
end;
 
3062,379 → 2592,6
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; BakFileMode: integer;
begin
BakFileMode := FileMode;
FileMode := 1; // Read/Write
try
AssignFile(F, MidiFileName);
Rewrite(F, 1);
try
BlockWrite(F, FMusicDataProp.FMusicData[1], Length(FMusicDataProp.FMusicData));
finally
CloseFile(F);
end;
finally
FileMode := BakFileMode;
end;
end;
 
procedure TMusicListCollectionItem.LoadFromFile(const MidiFileName: string);
var F: file; S: string; I: Integer; BakFileMode: integer;
begin
BakFileMode := FileMode;
FileMode := 0; // Read only
try
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);
finally
FileMode := BakFileMode;
end;
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;