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

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

Subversion Repositories spacemission

spacemission/VCL_DELPHIX_D6/DXSounds.pas – Rev 4