Subversion Repositories spacemission

Compare Revisions

Regard 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
 
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
144,7 → 89,7
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;
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};
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;
 
667,7 → 490,7
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
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;
820,35 → 640,21
begin
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
IDSBuffer := nil
else
else begin
FDSound.DXResult := FDSound.ISound.DuplicateSoundBuffer(TDirectSoundBuffer(Source).IDSBuffer,
TempBuffer);
if FDSound.DXResult=0 then
begin
FDSound.DXResult := FDSound.ISound.DuplicateSoundBuffer(TDirectSoundBuffer(Source).IDSBuffer, TempBuffer);
if FDSound.DXResult = DS_OK 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;
 
886,14 → 692,6
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
923,7 → 721,7
var
dwCurrentWriteCursor: Longint;
begin
IBuffer.GetCurrentPosition(@DWORD(Result), @DWORD(dwCurrentWriteCursor));
IBuffer.GetCurrentPosition(DWORD(Result), DWORD(dwCurrentWriteCursor));
end;
 
function TDirectSoundBuffer.GetSize: Integer;
959,7 → 757,7
Data1, Data2: Pointer;
Data1Size, Data2Size: Longint;
begin
SetSize(Format, Size, FIsD3D);
SetSize(Format, Size);
 
if Data <> nil then
begin
972,11 → 770,9
finally
UnLock;
end;
end
else
end else
begin
FIDSBuffer := nil;
FIDS3DBuffer := nil;
raise EDirectSoundBufferError.CreateFmt(SCannotLock, [SDirectSoundBuffer]);
end;
end;
1008,9 → 804,10
if IDSBuffer = nil 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);
FLockAudioPtr1[FLockCount], FLockAudioSize1[FLockCount],
FLockAudioPtr2[FLockCount], FLockAudioSize2[FLockCount], 0);
Result := DXResult = DS_OK;
 
if Result then
1038,14 → 835,9
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});
DXResult := IBuffer.SetFormat(Format);
Result := DXResult = DS_OK;
 
if Result then
1053,10 → 845,10
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);
IBuffer.GetFormat(FFormat^, FFormatSize, PDWORD(nil)^);
end;
end;
end;
1066,30 → 858,6
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;
1106,10 → 874,10
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);
IBuffer.GetFormat(FFormat^, FFormatSize, PDWORD(nil)^);
end;
end;
end;
1123,12 → 891,8
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
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;
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
2101,7 → 1662,7
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
Result := ReadPosition - FBufferPos
2120,8 → 1681,7
begin
if not FCapturing then
Start;
Data1 := nil;
Data2 := nil;
 
Result := 0;
while Result < Count do
begin
2128,8 → 1688,7
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);
Result := Result + Integer(Data1Size);
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;
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;
2241,6 → 1800,7
FDSound := ADSound;
FEnabled := True;
 
 
FEffectList := TList.Create;
FTimer := TTimer.Create(nil);
FTimer.Interval := 500;
2663,37 → 2223,10
 
if PrevInitialized then
Restore;
end
else
end 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
2751,8 → 2284,7
GetBuffer.Stop;
GetBuffer.Position := 0;
GetBuffer.Play(True);
end
else
end else
begin
NewBuffer := nil;
for i := 0 to FBufferList.Count - 1 do
2770,8 → 2302,7
if NewBuffer = nil then Exit;
 
FBufferList.Add(NewBuffer);
end
else
end else
begin
if FBufferList.Count < FMaxPlayingCount then
begin
2779,8 → 2310,7
if NewBuffer = nil then Exit;
 
FBufferList.Add(NewBuffer);
end
else
end else
begin
NewBuffer := FBufferList[0];
FBufferList.Move(0, FBufferList.Count - 1);
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;