Rev 16 | Go to most recent revision | Details | Compare with Previous | Last modification | View Log | RSS feed
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 | |||
16 | daniel-mar | 639 | function DXDirectSoundEnumerate(lpCallback: {$IFDEF UNICODE}TDSEnumCallbackW{$ELSE}TDSEnumCallbackA{$ENDIF}; |
4 | daniel-mar | 640 | lpContext: Pointer): HRESULT; |
1 | daniel-mar | 641 | type |
16 | daniel-mar | 642 | TDirectSoundEnumerate = function(lpCallback: {$IFDEF UNICODE}TDSEnumCallbackW{$ELSE}TDSEnumCallbackA{$ENDIF}; |
1 | daniel-mar | 643 | lpContext: Pointer): HRESULT; stdcall; |
644 | begin |
||
16 | daniel-mar | 645 | Result := TDirectSoundEnumerate(DXLoadLibrary('DSound.dll', {$IFDEF UNICODE}'DirectSoundEnumerateW'{$ELSE}'DirectSoundEnumerateA'{$ENDIF})) |
1 | daniel-mar | 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 |
||
16 | daniel-mar | 670 | Result := TDirectSoundCaptureEnumerate(DXLoadLibrary('DSound.dll', {$IFDEF UNICODE}'DirectSoundCaptureEnumerateW'{$ELSE}'DirectSoundCaptureEnumerateA'{$ENDIF})) |
1 | daniel-mar | 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); |
||
16 | daniel-mar | 2181 | FNotifyThread.{$IFDEF VER14UP}Start{$ELSE}Resume{$ENDIF}; |
1 | daniel-mar | 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); |
||
16 | daniel-mar | 2216 | FNotifyThread.{$IFDEF VER14UP}Start{$ELSE}Resume{$ENDIF}; |
1 | daniel-mar | 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); |
||
57 | daniel-mar | 3246 | var F: file; BakFileMode: integer; |
4 | daniel-mar | 3247 | begin |
57 | daniel-mar | 3248 | BakFileMode := FileMode; |
3249 | FileMode := 1; // Read/Write |
||
4 | daniel-mar | 3250 | try |
57 | daniel-mar | 3251 | AssignFile(F, MidiFileName); |
3252 | Rewrite(F, 1); |
||
3253 | try |
||
3254 | BlockWrite(F, FMusicDataProp.FMusicData[1], Length(FMusicDataProp.FMusicData)); |
||
3255 | finally |
||
3256 | CloseFile(F); |
||
3257 | end; |
||
4 | daniel-mar | 3258 | finally |
57 | daniel-mar | 3259 | FileMode := BakFileMode; |
4 | daniel-mar | 3260 | end; |
3261 | end; |
||
3262 | |||
3263 | procedure TMusicListCollectionItem.LoadFromFile(const MidiFileName: string); |
||
57 | daniel-mar | 3264 | var F: file; S: string; I: Integer; BakFileMode: integer; |
4 | daniel-mar | 3265 | begin |
57 | daniel-mar | 3266 | BakFileMode := FileMode; |
3267 | FileMode := 0; // Read only |
||
4 | daniel-mar | 3268 | try |
57 | daniel-mar | 3269 | AssignFile(F, MidiFileName); |
3270 | Reset(F, 1); |
||
3271 | try |
||
3272 | SetLength(FMusicDataProp.FMusicData, FileSize(F)); |
||
3273 | BlockRead(F, FMusicDataProp.FMusicData[1], FileSize(F)); |
||
3274 | S := ExtractFileName(MidiFileName); |
||
3275 | I := Pos(ExtractFileExt(S), S); |
||
3276 | if I > 0 then S := Copy(S, 1, I - 1); |
||
3277 | FMusicDataProp.Midiname := S; |
||
3278 | finally |
||
3279 | CloseFile(F); |
||
3280 | end; |
||
3281 | Name := ExtractFileName(MidiFileName); |
||
4 | daniel-mar | 3282 | finally |
57 | daniel-mar | 3283 | FileMode := BakFileMode; |
4 | daniel-mar | 3284 | end; |
3285 | end; |
||
3286 | |||
3287 | function TMusicListCollectionItem.Size: Integer; |
||
3288 | begin |
||
3289 | Result := Length(FMusicDataProp.FMusicData); |
||
3290 | end; |
||
3291 | |||
3292 | { TMusicListCollection } |
||
3293 | |||
3294 | constructor TMusicListCollection.Create(AOwner: TComponent); |
||
3295 | begin |
||
3296 | inherited Create(TMusicListCollectionItem); |
||
3297 | FOwner := AOwner; |
||
3298 | end; |
||
3299 | |||
3300 | function TMusicListCollection.Add: TMusicListCollectionItem; |
||
3301 | begin |
||
3302 | Result := TMusicListCollectionItem(inherited Add); |
||
3303 | Result.FDirectSound := Self.FDirectSound; |
||
3304 | end; |
||
3305 | |||
3306 | function TMusicListCollection.GetItem(Index: Integer): TMusicListCollectionItem; |
||
3307 | begin |
||
3308 | Result := TMusicListCollectionItem(inherited GetItem(Index)); |
||
3309 | end; |
||
3310 | |||
3311 | procedure TMusicListCollection.SetItem(Index: Integer; |
||
3312 | Value: TMusicListCollectionItem); |
||
3313 | begin |
||
3314 | inherited SetItem(Index, Value); |
||
3315 | end; |
||
3316 | |||
3317 | procedure TMusicListCollection.Update(Item: TCollectionItem); |
||
3318 | begin |
||
3319 | inherited Update(Item); |
||
3320 | end; |
||
3321 | |||
3322 | function TMusicListCollection.Find( |
||
3323 | const Name: string): TMusicListCollectionItem; |
||
3324 | var |
||
3325 | i: Integer; |
||
3326 | begin |
||
3327 | i := IndexOf(Name); |
||
3328 | if i = -1 then |
||
3329 | raise EDXMusicError.CreateFmt('The midi document does not exist: %s.', [Name]); |
||
3330 | Result := Items[i]; |
||
3331 | end; |
||
3332 | |||
3333 | {$IFDEF VER4UP} |
||
3334 | function TMusicListCollection.Insert(Index: Integer): TMusicListCollectionItem; |
||
3335 | begin |
||
3336 | Result := TMusicListCollectionItem(inherited Insert(Index)); |
||
3337 | end; |
||
3338 | {$ENDIF} |
||
3339 | |||
3340 | function TMusicListCollection.GetOwner: TPersistent; |
||
3341 | begin |
||
3342 | Result := FOwner; |
||
3343 | end; |
||
3344 | |||
3345 | procedure TMusicListCollection.Restore; |
||
3346 | begin |
||
3347 | |||
3348 | end; |
||
3349 | |||
3350 | procedure TMusicListCollection.SaveToFile(const FileName: string); |
||
3351 | var |
||
3352 | Stream: TFileStream; |
||
3353 | begin |
||
3354 | Stream := TFileStream.Create(FileName, fmCreate); |
||
3355 | try |
||
3356 | SaveToStream(Stream); |
||
3357 | finally |
||
3358 | Stream.Free; |
||
3359 | end; |
||
3360 | end; |
||
3361 | |||
3362 | procedure TMusicListCollection.LoadFromFile(const FileName: string); |
||
3363 | var |
||
3364 | Stream: TFileStream; |
||
3365 | begin |
||
3366 | Stream := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite); |
||
3367 | try |
||
3368 | LoadFromStream(Stream); |
||
3369 | finally |
||
3370 | Stream.Free; |
||
3371 | end; |
||
3372 | end; |
||
3373 | |||
3374 | type |
||
3375 | TMidiCollectionComponent = class(TComponent) |
||
3376 | private |
||
3377 | FList: TMusicListCollection; |
||
3378 | published |
||
3379 | property List: TMusicListCollection read FList write FList; |
||
3380 | end; |
||
3381 | |||
3382 | procedure TMusicListCollection.SaveToStream(Stream: TStream); |
||
3383 | var |
||
3384 | Component: TMidiCollectionComponent; |
||
3385 | begin |
||
3386 | Component := TMidiCollectionComponent.Create(nil); |
||
3387 | try |
||
3388 | Component.FList := Self; |
||
3389 | Stream.WriteComponentRes('DelphiXMidiCollection', Component); |
||
3390 | finally |
||
3391 | Component.Free; |
||
3392 | end; |
||
3393 | end; |
||
3394 | |||
3395 | procedure TMusicListCollection.LoadFromStream(Stream: TStream); |
||
3396 | var |
||
3397 | Component: TMidiCollectionComponent; |
||
3398 | begin |
||
3399 | Clear; |
||
3400 | Component := TMidiCollectionComponent.Create(nil); |
||
3401 | try |
||
3402 | Component.FList := Self; |
||
3403 | Stream.ReadComponentRes(Component); |
||
3404 | Restore; |
||
3405 | finally |
||
3406 | Component.Free; |
||
3407 | end; |
||
3408 | end; |
||
3409 | |||
3410 | { TDXMusic } |
||
3411 | |||
3412 | constructor TDXMusic.Create(AOwner: TComponent); |
||
3413 | begin |
||
3414 | inherited Create(AOwner); |
||
3415 | FMidis := TMusicListCollection.Create(Self); |
||
3416 | if Assigned(FDXSound) then |
||
3417 | FMidis.FDirectSound := FDXSound.DSound.IDSound; |
||
3418 | end; |
||
3419 | |||
3420 | procedure TDXMusic.SetMidis(const value: TMusicListCollection); |
||
3421 | begin |
||
3422 | FMidis.Assign(Value); |
||
3423 | end; |
||
3424 | |||
3425 | destructor TDXMusic.Destroy; |
||
3426 | begin |
||
3427 | FMidis.Free; |
||
3428 | inherited Destroy; |
||
3429 | end; |
||
3430 | |||
3431 | procedure TDXMusic.SetDXSound(const Value: TDXSound); |
||
3432 | begin |
||
3433 | FDXSound := Value; |
||
3434 | if Assigned(FDXSound) then |
||
3435 | FMidis.FDirectSound := FDXSound.DSound.IDSound; |
||
3436 | end; |
||
3437 | |||
1 | daniel-mar | 3438 | initialization |
3439 | finalization |
||
3440 | DirectSoundDrivers.Free; |
||
3441 | DirectSoundCaptureDrivers.Free; |
||
3442 | end. |