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; |