Rev 4 | Go to most recent revision | Details | 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 |
||
8 | Windows, Messages, SysUtils, Classes, Controls, Forms, ExtCtrls, MMSystem, |
||
9 | DirectX, DXClass, Wave; |
||
10 | |||
11 | type |
||
12 | |||
13 | { EDirectSoundError } |
||
14 | |||
15 | EDirectSoundError = class(EDirectXError); |
||
16 | EDirectSoundBufferError = class(EDirectSoundError); |
||
17 | |||
18 | { TDirectSound } |
||
19 | |||
20 | TDirectSoundBuffer = class; |
||
21 | |||
22 | TDirectSound = class(TDirectX) |
||
23 | private |
||
24 | FBufferList: TList; |
||
25 | FGlobalFocus: Boolean; |
||
26 | FIDSound: IDirectSound; |
||
27 | FInRestoreBuffer: Boolean; |
||
28 | FStickyFocus: Boolean; |
||
29 | function GetBuffer(Index: Integer): TDirectSoundBuffer; |
||
30 | function GetBufferCount: Integer; |
||
31 | function GetIDSound: IDirectSound; |
||
32 | function GetISound: IDirectSound; |
||
33 | protected |
||
34 | procedure CheckBuffer(Buffer: TDirectSoundBuffer); |
||
35 | procedure DoRestoreBuffer; virtual; |
||
36 | public |
||
37 | constructor Create(GUID: PGUID); |
||
38 | destructor Destroy; override; |
||
39 | class function Drivers: TDirectXDrivers; |
||
40 | property BufferCount: Integer read GetBufferCount; |
||
41 | property Buffers[Index: Integer]: TDirectSoundBuffer read GetBuffer; |
||
42 | property IDSound: IDirectSound read GetIDSound; |
||
43 | property ISound: IDirectSound read GetISound; |
||
44 | end; |
||
45 | |||
46 | { TDirectSoundBuffer } |
||
47 | |||
48 | TDirectSoundBuffer = class(TDirectX) |
||
49 | private |
||
50 | FDSound: TDirectSound; |
||
51 | FIDSBuffer: IDirectSoundBuffer; |
||
52 | FCaps: TDSBCaps; |
||
53 | FFormat: PWaveFormatEx; |
||
54 | FFormatSize: Integer; |
||
55 | FLockAudioPtr1, FLockAudioPtr2: array[0..0] of Pointer; |
||
56 | FLockAudioSize1, FLockAudioSize2: array[0..0] of DWORD; |
||
57 | FLockCount: Integer; |
||
58 | function GetBitCount: Longint; |
||
59 | function GetFormat: PWaveFormatEx; |
||
60 | function GetFrequency: Integer; |
||
61 | function GetIDSBuffer: IDirectSoundBuffer; |
||
62 | function GetIBuffer: IDirectSoundBuffer; |
||
63 | function GetPlaying: Boolean; |
||
64 | function GetPan: Integer; |
||
65 | function GetPosition: Longint; |
||
66 | function GetSize: Integer; |
||
67 | function GetStatus: Integer; |
||
68 | function GetVolume: Integer; |
||
69 | procedure SetFrequency(Value: Integer); |
||
70 | procedure SetIDSBuffer(Value: IDirectSoundBuffer); |
||
71 | procedure SetPan(Value: Integer); |
||
72 | procedure SetPosition(Value: Longint); |
||
73 | procedure SetVolume(Value: Integer); |
||
74 | protected |
||
75 | procedure Check; override; |
||
76 | public |
||
77 | constructor Create(ADirectSound: TDirectSound); |
||
78 | destructor Destroy; override; |
||
79 | procedure Assign(Source: TPersistent); override; |
||
80 | function CreateBuffer(const BufferDesc: TDSBufferDesc): Boolean; |
||
81 | procedure LoadFromFile(const FileName: string); |
||
82 | procedure LoadFromMemory(const Format: TWaveFormatEx; |
||
83 | Data: Pointer; Size: Integer); |
||
84 | procedure LoadFromStream(Stream: TStream); |
||
85 | procedure LoadFromWave(Wave: TWave); |
||
86 | function Lock(LockPosition, LockSize: Longint; |
||
87 | var AudioPtr1: Pointer; var AudioSize1: Longint; |
||
88 | var AudioPtr2: Pointer; var AudioSize2: Longint): Boolean; |
||
89 | function Play(Loop: Boolean{$IFNDEF VER100}=False{$ENDIF}): Boolean; |
||
90 | function Restore: Boolean; |
||
91 | function SetFormat(const Format: TWaveFormatEx): Boolean; |
||
92 | procedure SetSize(const Format: TWaveFormatEx; Size: Integer); |
||
93 | procedure Stop; |
||
94 | procedure UnLock; |
||
95 | property BitCount: Longint read GetBitCount; |
||
96 | property DSound: TDirectSound read FDSound; |
||
97 | property Format: PWaveFormatEx read GetFormat; |
||
98 | property FormatSize: Integer read FFormatSize; |
||
99 | property Frequency: Integer read GetFrequency write SetFrequency; |
||
100 | property IBuffer: IDirectSoundBuffer read GetIBuffer; |
||
101 | property IDSBuffer: IDirectSoundBuffer read GetIDSBuffer write SetIDSBuffer; |
||
102 | property Playing: Boolean read GetPlaying; |
||
103 | property Pan: Integer read GetPan write SetPan; |
||
104 | property Position: Longint read GetPosition write SetPosition; |
||
105 | property Size: Integer read GetSize; |
||
106 | property Volume: Integer read GetVolume write SetVolume; |
||
107 | end; |
||
108 | |||
109 | { EAudioStreamError } |
||
110 | |||
111 | EAudioStreamError = class(Exception); |
||
112 | |||
113 | { TAudioStream } |
||
114 | |||
115 | TAudioStream = class |
||
116 | private |
||
117 | FAutoUpdate: Boolean; |
||
118 | FBuffer: TDirectSoundBuffer; |
||
119 | FBufferLength: Integer; |
||
120 | FBufferPos: DWORD; |
||
121 | FPlayBufferPos: DWORD; |
||
122 | FBufferSize: DWORD; |
||
123 | FDSound: TDirectSound; |
||
124 | FLooped: Boolean; |
||
125 | FPlayedSize: Integer; |
||
126 | FPlaying: Boolean; |
||
127 | FPosition: Integer; |
||
128 | FWaveStream: TCustomWaveStream; |
||
129 | FWritePosition: Integer; |
||
130 | FNotifyEvent: THandle; |
||
131 | FNotifyThread: TThread; |
||
132 | function GetFormat: PWaveFormatEX; |
||
133 | function GetFormatSize: Integer; |
||
134 | function GetFrequency: Integer; |
||
135 | function GetPan: Integer; |
||
136 | function GetPlayedSize: Integer; |
||
137 | function GetSize: Integer; |
||
138 | function GetVolume: Integer; |
||
139 | function GetWriteSize: Integer; |
||
140 | procedure SetAutoUpdate(Value: Boolean); |
||
141 | procedure SetBufferLength(Value: Integer); |
||
142 | procedure SetFrequency(Value: Integer); |
||
143 | procedure SetLooped(Value: Boolean); |
||
144 | procedure SetPan(Value: Integer); |
||
145 | procedure SetPlayedSize(Value: Integer); |
||
146 | procedure SetPosition(Value: Integer); |
||
147 | procedure SetVolume(Value: Integer); |
||
148 | procedure SetWaveStream(Value: TCustomWaveStream); |
||
149 | procedure Update2(InThread: Boolean); |
||
150 | procedure UpdatePlayedSize; |
||
151 | function WriteWave(WriteSize: Integer): Integer; |
||
152 | public |
||
153 | constructor Create(ADirectSound: TDirectSound); |
||
154 | destructor Destroy; override; |
||
155 | procedure Play; |
||
156 | procedure RecreateBuf; |
||
157 | procedure Stop; |
||
158 | procedure Update; |
||
159 | property AutoUpdate: Boolean read FAutoUpdate write SetAutoUpdate; |
||
160 | property BufferLength: Integer read FBufferLength write SetBufferLength; |
||
161 | property Format: PWaveFormatEx read GetFormat; |
||
162 | property FormatSize: Integer read GetFormatSize; |
||
163 | property Frequency: Integer read GetFrequency write SetFrequency; |
||
164 | property Pan: Integer read GetPan write SetPan; |
||
165 | property PlayedSize: Integer read GetPlayedSize write SetPlayedSize; |
||
166 | property Playing: Boolean read FPlaying; |
||
167 | property Position: Integer read FPosition write SetPosition; |
||
168 | property Looped: Boolean read FLooped write SetLooped; |
||
169 | property Size: Integer read GetSize; |
||
170 | property Volume: Integer read GetVolume write SetVolume; |
||
171 | property WaveStream: TCustomWaveStream read FWaveStream write SetWaveStream; |
||
172 | end; |
||
173 | |||
174 | { TAudioFileStream } |
||
175 | |||
176 | TAudioFileStream = class(TAudioStream) |
||
177 | private |
||
178 | FFileName: string; |
||
179 | FWaveFileStream: TWaveFileStream; |
||
180 | procedure SetFileName(const Value: string); |
||
181 | public |
||
182 | destructor Destroy; override; |
||
183 | property FileName: string read FFileName write SetFileName; |
||
184 | end; |
||
185 | |||
186 | { TSoundCaptureFormat } |
||
187 | |||
188 | TSoundCaptureFormat = class(TCollectionItem) |
||
189 | private |
||
190 | FBitsPerSample: Integer; |
||
191 | FChannels: Integer; |
||
192 | FSamplesPerSec: Integer; |
||
193 | public |
||
194 | property BitsPerSample: Integer read FBitsPerSample; |
||
195 | property Channels: Integer read FChannels; |
||
196 | property SamplesPerSec: Integer read FSamplesPerSec; |
||
197 | end; |
||
198 | |||
199 | { TSoundCaptureFormats } |
||
200 | |||
201 | TSoundCaptureFormats = class(TCollection) |
||
202 | private |
||
203 | function GetItem(Index: Integer): TSoundCaptureFormat; |
||
204 | public |
||
205 | constructor Create; |
||
206 | function IndexOf(ASamplesPerSec, ABitsPerSample, AChannels: Integer): Integer; |
||
207 | property Items[Index: Integer]: TSoundCaptureFormat read GetItem; default; |
||
208 | end; |
||
209 | |||
210 | { TSoundCaptureStream } |
||
211 | |||
212 | ESoundCaptureStreamError = class(EWaveStreamError); |
||
213 | |||
214 | TSoundCaptureStream = class(TCustomWaveStream2) |
||
215 | private |
||
216 | FBuffer: IDirectSoundCaptureBuffer; |
||
217 | FBufferLength: Integer; |
||
218 | FBufferPos: DWORD; |
||
219 | FBufferSize: DWORD; |
||
220 | FCapture: IDirectSoundCapture; |
||
221 | FCaptureFormat: Integer; |
||
222 | FCapturing: Boolean; |
||
223 | FNotifyEvent: THandle; |
||
224 | FNotifyThread: TThread; |
||
225 | FOnFilledBuffer: TNotifyEvent; |
||
226 | FSupportedFormats: TSoundCaptureFormats; |
||
227 | function GetReadSize: Integer; |
||
228 | procedure SetBufferLength(Value: Integer); |
||
229 | procedure SetOnFilledBuffer(Value: TNotifyEvent); |
||
230 | protected |
||
231 | procedure DoFilledBuffer; virtual; |
||
232 | function GetFilledSize: Integer; override; |
||
233 | function ReadWave(var Buffer; Count: Integer): Integer; override; |
||
234 | public |
||
235 | constructor Create(GUID: PGUID); |
||
236 | destructor Destroy; override; |
||
237 | class function Drivers: TDirectXDrivers; |
||
238 | procedure Start; |
||
239 | procedure Stop; |
||
240 | property BufferLength: Integer read FBufferLength write SetBufferLength; |
||
241 | property CaptureFormat: Integer read FCaptureFormat write FCaptureFormat; |
||
242 | property Capturing: Boolean read FCapturing; |
||
243 | property OnFilledBuffer: TNotifyEvent read FOnFilledBuffer write SetOnFilledBuffer; |
||
244 | property SupportedFormats: TSoundCaptureFormats read FSupportedFormats; |
||
245 | end; |
||
246 | |||
247 | { TSoundEngine } |
||
248 | |||
249 | TSoundEngine = class |
||
250 | private |
||
251 | FDSound: TDirectSound; |
||
252 | FEffectList: TList; |
||
253 | FEnabled: Boolean; |
||
254 | FTimer: TTimer; |
||
255 | function GetEffect(Index: Integer): TDirectSoundBuffer; |
||
256 | function GetEffectCount: Integer; |
||
257 | procedure SetEnabled(Value: Boolean); |
||
258 | procedure TimerEvent(Sender: TObject); |
||
259 | public |
||
260 | constructor Create(ADSound: TDirectSound); |
||
261 | destructor Destroy; override; |
||
262 | procedure Clear; |
||
263 | procedure EffectFile(const Filename: string; Loop, Wait: Boolean); |
||
264 | procedure EffectStream(Stream: TStream; Loop, Wait: Boolean); |
||
265 | procedure EffectWave(Wave: TWave; Loop, Wait: Boolean); |
||
266 | property EffectCount: Integer read GetEffectCount; |
||
267 | property Effects[Index: Integer]: TDirectSoundBuffer read GetEffect; |
||
268 | property Enabled: Boolean read FEnabled write SetEnabled; |
||
269 | end; |
||
270 | |||
271 | { EDXSoundError } |
||
272 | |||
273 | EDXSoundError = class(Exception); |
||
274 | |||
275 | { TCustomDXSound } |
||
276 | |||
277 | TCustomDXSound = class; |
||
278 | |||
279 | TDXSoundOption = (soGlobalFocus, soStickyFocus, soExclusive); |
||
280 | TDXSoundOptions = set of TDXSoundOption; |
||
281 | |||
282 | TDXSoundNotifyType = (dsntDestroying, dsntInitializing, dsntInitialize, dsntFinalize, dsntRestore); |
||
283 | TDXSoundNotifyEvent = procedure(Sender: TCustomDXSound; NotifyType: TDXSoundNotifyType) of object; |
||
284 | |||
285 | TCustomDXSound = class(TComponent) |
||
286 | private |
||
287 | FAutoInitialize: Boolean; |
||
288 | FCalledDoInitialize: Boolean; |
||
289 | FDriver: PGUID; |
||
290 | FDriverGUID: TGUID; |
||
291 | FDSound: TDirectSound; |
||
292 | FForm: TCustomForm; |
||
293 | FInitialized: Boolean; |
||
294 | FInternalInitialized: Boolean; |
||
295 | FNotifyEventList: TList; |
||
296 | FNowOptions: TDXSoundOptions; |
||
297 | FOnFinalize: TNotifyEvent; |
||
298 | FOnInitialize: TNotifyEvent; |
||
299 | FOnInitializing: TNotifyEvent; |
||
300 | FOnRestore: TNotifyEvent; |
||
301 | FOptions: TDXSoundOptions; |
||
302 | FPrimary: TDirectSoundBuffer; |
||
303 | FSubClass: TControlSubClass; |
||
304 | procedure FormWndProc(var Message: TMessage; DefWindowProc: TWndMethod); |
||
305 | procedure NotifyEventList(NotifyType: TDXSoundNotifyType); |
||
306 | procedure SetDriver(Value: PGUID); |
||
307 | procedure SetForm(Value: TCustomForm); |
||
308 | procedure SetOptions(Value: TDXSoundOptions); |
||
309 | protected |
||
310 | procedure DoFinalize; virtual; |
||
311 | procedure DoInitialize; virtual; |
||
312 | procedure DoInitializing; virtual; |
||
313 | procedure DoRestore; virtual; |
||
314 | procedure Loaded; override; |
||
315 | public |
||
316 | constructor Create(AOwner: TComponent); override; |
||
317 | destructor Destroy; override; |
||
318 | class function Drivers: TDirectXDrivers; |
||
319 | procedure Finalize; |
||
320 | procedure Initialize; |
||
321 | procedure Restore; |
||
322 | procedure RegisterNotifyEvent(NotifyEvent: TDXSoundNotifyEvent); |
||
323 | procedure UnRegisterNotifyEvent(NotifyEvent: TDXSoundNotifyEvent); |
||
324 | |||
325 | property AutoInitialize: Boolean read FAutoInitialize write FAutoInitialize; |
||
326 | property Driver: PGUID read FDriver write SetDriver; |
||
327 | property DSound: TDirectSound read FDSound; |
||
328 | property Initialized: Boolean read FInitialized; |
||
329 | property NowOptions: TDXSoundOptions read FNowOptions; |
||
330 | property Primary: TDirectSoundBuffer read FPrimary; |
||
331 | property OnFinalize: TNotifyEvent read FOnFinalize write FOnFinalize; |
||
332 | property OnInitialize: TNotifyEvent read FOnInitialize write FOnInitialize; |
||
333 | property OnInitializing: TNotifyEvent read FOnInitializing write FOnInitializing; |
||
334 | property OnRestore: TNotifyEvent read FOnRestore write FOnRestore; |
||
335 | property Options: TDXSoundOptions read FOptions write SetOptions; |
||
336 | end; |
||
337 | |||
338 | { TDXSound } |
||
339 | |||
340 | TDXSound = class(TCustomDXSound) |
||
341 | published |
||
342 | property AutoInitialize; |
||
343 | property Options; |
||
344 | property OnFinalize; |
||
345 | property OnInitialize; |
||
346 | property OnInitializing; |
||
347 | property OnRestore; |
||
348 | end; |
||
349 | |||
350 | { EWaveCollectionError } |
||
351 | |||
352 | EWaveCollectionError = class(Exception); |
||
353 | |||
354 | { TWaveCollectionItem } |
||
355 | |||
356 | TWaveCollection = class; |
||
357 | |||
358 | TWaveCollectionItem = class(THashCollectionItem) |
||
359 | private |
||
360 | FBuffer: TDirectSoundBuffer; |
||
361 | FBufferList: TList; |
||
362 | FFrequency: Integer; |
||
363 | FInitialized: Boolean; |
||
364 | FLooped: Boolean; |
||
365 | FMaxPlayingCount: Integer; |
||
366 | FPan: Integer; |
||
367 | FVolume: Integer; |
||
368 | FWave: TWave; |
||
369 | function CreateBuffer: TDirectSoundBuffer; |
||
370 | procedure Finalize; |
||
371 | procedure Initialize; |
||
372 | function GetBuffer: TDirectSoundBuffer; |
||
373 | function GetWaveCollection: TWaveCollection; |
||
374 | procedure SetFrequency(Value: Integer); |
||
375 | procedure SetLooped(Value: Boolean); |
||
376 | procedure SetMaxPlayingCount(Value: Integer); |
||
377 | procedure SetPan(Value: Integer); |
||
378 | procedure SetVolume(Value: Integer); |
||
379 | procedure SetWave(Value: TWave); |
||
380 | public |
||
381 | constructor Create(Collection: TCollection); override; |
||
382 | destructor Destroy; override; |
||
383 | procedure Assign(Source: TPersistent); override; |
||
384 | procedure Play(Wait: Boolean); |
||
385 | procedure Restore; |
||
386 | procedure Stop; |
||
387 | property Frequency: Integer read FFrequency write SetFrequency; |
||
388 | property Initialized: Boolean read FInitialized; |
||
389 | property Pan: Integer read FPan write SetPan; |
||
390 | property Volume: Integer read FVolume write SetVolume; |
||
391 | property WaveCollection: TWaveCollection read GetWaveCollection; |
||
392 | published |
||
393 | property Looped: Boolean read FLooped write SetLooped; |
||
394 | property MaxPlayingCount: Integer read FMaxPlayingCount write SetMaxPlayingCount; |
||
395 | property Wave: TWave read FWave write SetWave; |
||
396 | end; |
||
397 | |||
398 | { TWaveCollection } |
||
399 | |||
400 | TWaveCollection = class(THashCollection) |
||
401 | private |
||
402 | FDXSound: TCustomDXSound; |
||
403 | FOwner: TPersistent; |
||
404 | function GetItem(Index: Integer): TWaveCollectionItem; |
||
405 | function Initialized: Boolean; |
||
406 | protected |
||
407 | function GetOwner: TPersistent; override; |
||
408 | public |
||
409 | constructor Create(AOwner: TPersistent); |
||
410 | function Find(const Name: string): TWaveCollectionItem; |
||
411 | procedure Finalize; |
||
412 | procedure Initialize(DXSound: TCustomDXSound); |
||
413 | procedure Restore; |
||
414 | procedure LoadFromFile(const FileName: string); |
||
415 | procedure LoadFromStream(Stream: TStream); |
||
416 | procedure SaveToFile(const FileName: string); |
||
417 | procedure SaveToStream(Stream: TStream); |
||
418 | property DXSound: TCustomDXSound read FDXSound; |
||
419 | property Items[Index: Integer]: TWaveCollectionItem read GetItem; default; |
||
420 | end; |
||
421 | |||
422 | { TCustomDXWaveList } |
||
423 | |||
424 | TCustomDXWaveList = class(TComponent) |
||
425 | private |
||
426 | FDXSound: TCustomDXSound; |
||
427 | FItems: TWaveCollection; |
||
428 | procedure DXSoundNotifyEvent(Sender: TCustomDXSound; NotifyType: TDXSoundNotifyType); |
||
429 | procedure SetDXSound(Value: TCustomDXSound); |
||
430 | procedure SetItems(Value: TWaveCollection); |
||
431 | protected |
||
432 | procedure Notification(AComponent: TComponent; Operation: TOperation); override; |
||
433 | public |
||
434 | constructor Create(AOwner: TComponent); override; |
||
435 | destructor Destroy; override; |
||
436 | property DXSound: TCustomDXSound read FDXSound write SetDXSound; |
||
437 | property Items: TWaveCollection read FItems write SetItems; |
||
438 | end; |
||
439 | |||
440 | { TDXWaveList } |
||
441 | |||
442 | TDXWaveList = class(TCustomDXWaveList) |
||
443 | published |
||
444 | property DXSound; |
||
445 | property Items; |
||
446 | end; |
||
447 | |||
448 | implementation |
||
449 | |||
450 | uses DXConsts; |
||
451 | |||
452 | function DXDirectSoundCreate(lpGUID: PGUID; out lpDS: IDirectSound; |
||
453 | pUnkOuter: IUnknown): HRESULT; |
||
454 | type |
||
455 | TDirectSoundCreate = function(lpGUID: PGUID; out lplpDD: IDirectSound; |
||
456 | pUnkOuter: IUnknown): HRESULT; stdcall; |
||
457 | begin |
||
458 | Result := TDirectSoundCreate(DXLoadLibrary('DSound.dll', 'DirectSoundCreate')) |
||
459 | (lpGUID, lpDS, pUnkOuter); |
||
460 | end; |
||
461 | |||
462 | function DXDirectSoundEnumerate(lpCallback: TDSEnumCallbackA; |
||
463 | lpContext: Pointer): HRESULT; |
||
464 | type |
||
465 | TDirectSoundEnumerate = function(lpCallback: TDSEnumCallbackA; |
||
466 | lpContext: Pointer): HRESULT; stdcall; |
||
467 | begin |
||
468 | Result := TDirectSoundEnumerate(DXLoadLibrary('DSound.dll', 'DirectSoundEnumerateA')) |
||
469 | (lpCallback, lpContext); |
||
470 | end; |
||
471 | |||
472 | function DXDirectSoundCaptureCreate(lpGUID: PGUID; out lplpDSC: IDirectSoundCapture; |
||
473 | pUnkOuter: IUnknown): HRESULT; |
||
474 | type |
||
475 | TDirectSoundCaptureCreate = function(lpGUID: PGUID; out lplpDD: IDirectSoundCapture; |
||
476 | pUnkOuter: IUnknown): HRESULT; stdcall; |
||
477 | begin |
||
478 | try |
||
479 | Result := TDirectSoundCaptureCreate(DXLoadLibrary('DSound.dll', 'DirectSoundCaptureCreate')) |
||
480 | (lpGUID, lplpDSC, pUnkOuter); |
||
481 | except |
||
482 | raise EDirectXError.Create(SSinceDirectX5); |
||
483 | end; |
||
484 | end; |
||
485 | |||
486 | function DXDirectSoundCaptureEnumerate(lpCallback: TDSEnumCallbackA; |
||
487 | lpContext: Pointer): HRESULT; |
||
488 | type |
||
489 | TDirectSoundCaptureEnumerate = function(lpCallback: TDSEnumCallbackA; |
||
490 | lpContext: Pointer): HRESULT; stdcall; |
||
491 | begin |
||
492 | try |
||
493 | Result := TDirectSoundCaptureEnumerate(DXLoadLibrary('DSound.dll', 'DirectSoundCaptureEnumerateA')) |
||
494 | (lpCallback, lpContext); |
||
495 | except |
||
496 | raise EDirectXError.Create(SSinceDirectX5); |
||
497 | end; |
||
498 | end; |
||
499 | |||
500 | var |
||
501 | DirectSoundDrivers: TDirectXDrivers; |
||
502 | DirectSoundCaptureDrivers: TDirectXDrivers; |
||
503 | |||
504 | function EnumDirectSoundDrivers_DSENUMCALLBACK(lpGuid: PGUID; lpstrDescription: LPCSTR; |
||
505 | lpstrModule: LPCSTR; lpContext: Pointer): BOOL; stdcall; |
||
506 | begin |
||
507 | Result := True; |
||
508 | with TDirectXDriver.Create(TDirectXDrivers(lpContext)) do |
||
509 | begin |
||
510 | Guid := lpGuid; |
||
511 | Description := lpstrDescription; |
||
512 | DriverName := lpstrModule; |
||
513 | end; |
||
514 | end; |
||
515 | |||
516 | function EnumDirectSoundDrivers: TDirectXDrivers; |
||
517 | begin |
||
518 | if DirectSoundDrivers=nil then |
||
519 | begin |
||
520 | DirectSoundDrivers := TDirectXDrivers.Create; |
||
521 | try |
||
522 | DXDirectSoundEnumerate(@EnumDirectSoundDrivers_DSENUMCALLBACK, DirectSoundDrivers); |
||
523 | except |
||
524 | DirectSoundDrivers.Free; |
||
525 | raise; |
||
526 | end; |
||
527 | end; |
||
528 | |||
529 | Result := DirectSoundDrivers; |
||
530 | end; |
||
531 | |||
532 | function EnumDirectSoundCaptureDrivers: TDirectXDrivers; |
||
533 | begin |
||
534 | if DirectSoundCaptureDrivers=nil then |
||
535 | begin |
||
536 | DirectSoundCaptureDrivers := TDirectXDrivers.Create; |
||
537 | try |
||
538 | DXDirectSoundCaptureEnumerate(@EnumDirectSoundDrivers_DSENUMCALLBACK, DirectSoundCaptureDrivers); |
||
539 | except |
||
540 | DirectSoundCaptureDrivers.Free; |
||
541 | raise; |
||
542 | end; |
||
543 | end; |
||
544 | |||
545 | Result := DirectSoundCaptureDrivers; |
||
546 | end; |
||
547 | |||
548 | { TDirectSound } |
||
549 | |||
550 | constructor TDirectSound.Create(GUID: PGUID); |
||
551 | begin |
||
552 | inherited Create; |
||
553 | FBufferList := TList.Create; |
||
554 | |||
555 | if DXDirectSoundCreate(GUID, FIDSound, nil)<>DS_OK then |
||
556 | raise EDirectSoundError.CreateFmt(SCannotInitialized, [SDirectSound]); |
||
557 | end; |
||
558 | |||
559 | destructor TDirectSound.Destroy; |
||
560 | begin |
||
561 | while BufferCount>0 do |
||
562 | Buffers[BufferCount-1].Free; |
||
563 | FBufferList.Free; |
||
564 | |||
565 | FIDSound := nil; |
||
566 | inherited Destroy; |
||
567 | end; |
||
568 | |||
569 | class function TDirectSound.Drivers: TDirectXDrivers; |
||
570 | begin |
||
571 | Result := EnumDirectSoundDrivers; |
||
572 | end; |
||
573 | |||
574 | procedure TDirectSound.CheckBuffer(Buffer: TDirectSoundBuffer); |
||
575 | begin |
||
576 | case Buffer.DXResult of |
||
577 | DSERR_BUFFERLOST: |
||
578 | begin |
||
579 | if not FInRestoreBuffer then |
||
580 | begin |
||
581 | FInRestoreBuffer := True; |
||
582 | try |
||
583 | DoRestoreBuffer; |
||
584 | finally |
||
585 | FInRestoreBuffer := False; |
||
586 | end; |
||
587 | end; |
||
588 | end; |
||
589 | end; |
||
590 | end; |
||
591 | |||
592 | procedure TDirectSound.DoRestoreBuffer; |
||
593 | begin |
||
594 | end; |
||
595 | |||
596 | function TDirectSound.GetBuffer(Index: Integer): TDirectSoundBuffer; |
||
597 | begin |
||
598 | Result := FBufferList[Index]; |
||
599 | end; |
||
600 | |||
601 | function TDirectSound.GetBufferCount: Integer; |
||
602 | begin |
||
603 | Result := FBufferList.Count; |
||
604 | end; |
||
605 | |||
606 | function TDirectSound.GetIDSound: IDirectSound; |
||
607 | begin |
||
608 | if Self<>nil then |
||
609 | Result := FIDSound |
||
610 | else |
||
611 | Result := nil; |
||
612 | end; |
||
613 | |||
614 | function TDirectSound.GetISound: IDirectSound; |
||
615 | begin |
||
616 | Result := IDSound; |
||
617 | if Result=nil then |
||
618 | raise EDirectSoundError.CreateFmt(SNotMade, ['IDirectSound']); |
||
619 | end; |
||
620 | |||
621 | { TDirectSoundBuffer } |
||
622 | |||
623 | constructor TDirectSoundBuffer.Create(ADirectSound: TDirectSound); |
||
624 | begin |
||
625 | inherited Create; |
||
626 | FDSound := ADirectSound; |
||
627 | FDSound.FBufferList.Add(Self); |
||
628 | end; |
||
629 | |||
630 | destructor TDirectSoundBuffer.Destroy; |
||
631 | begin |
||
632 | IDSBuffer := nil; |
||
633 | FDSound.FBufferList.Remove(Self); |
||
634 | inherited Destroy; |
||
635 | end; |
||
636 | |||
637 | procedure TDirectSoundBuffer.Assign(Source: TPersistent); |
||
638 | var |
||
639 | TempBuffer: IDirectSoundBuffer; |
||
640 | begin |
||
641 | if Source=nil then |
||
642 | IDSBuffer := nil |
||
643 | else if Source is TWave then |
||
644 | LoadFromWave(TWave(Source)) |
||
645 | else if Source is TDirectSoundBuffer then |
||
646 | begin |
||
647 | if TDirectSoundBuffer(Source).IDSBuffer=nil then |
||
648 | IDSBuffer := nil |
||
649 | else begin |
||
650 | FDSound.DXResult := FDSound.ISound.DuplicateSoundBuffer(TDirectSoundBuffer(Source).IDSBuffer, |
||
651 | TempBuffer); |
||
652 | if FDSound.DXResult=0 then |
||
653 | begin |
||
654 | IDSBuffer := TempBuffer; |
||
655 | end; |
||
656 | end; |
||
657 | end else |
||
658 | inherited Assign(Source); |
||
659 | end; |
||
660 | |||
661 | procedure TDirectSoundBuffer.Check; |
||
662 | begin |
||
663 | FDSound.CheckBuffer(Self); |
||
664 | end; |
||
665 | |||
666 | function TDirectSoundBuffer.CreateBuffer(const BufferDesc: TDSBufferDesc): Boolean; |
||
667 | var |
||
668 | TempBuffer: IDirectSoundBuffer; |
||
669 | begin |
||
670 | IDSBuffer := nil; |
||
671 | |||
672 | FDSound.DXResult := FDSound.ISound.CreateSoundBuffer(BufferDesc, TempBuffer, nil); |
||
673 | FDXResult := FDSound.DXResult; |
||
674 | Result := DXResult=DS_OK; |
||
675 | if Result then |
||
676 | IDSBuffer := TempBuffer; |
||
677 | end; |
||
678 | |||
679 | function TDirectSoundBuffer.GetBitCount: Longint; |
||
680 | begin |
||
681 | Result := Format.wBitsPerSample; |
||
682 | end; |
||
683 | |||
684 | function TDirectSoundBuffer.GetFormat: PWaveFormatEx; |
||
685 | begin |
||
686 | GetIBuffer; |
||
687 | Result := FFormat; |
||
688 | end; |
||
689 | |||
690 | function TDirectSoundBuffer.GetFrequency: Integer; |
||
691 | begin |
||
692 | DXResult := IBuffer.GetFrequency(DWORD(Result)); |
||
693 | end; |
||
694 | |||
695 | function TDirectSoundBuffer.GetIDSBuffer: IDirectSoundBuffer; |
||
696 | begin |
||
697 | if Self<>nil then |
||
698 | Result := FIDSBuffer |
||
699 | else |
||
700 | Result := nil; |
||
701 | end; |
||
702 | |||
703 | function TDirectSoundBuffer.GetIBuffer: IDirectSoundBuffer; |
||
704 | begin |
||
705 | Result := IDSBuffer; |
||
706 | if Result=nil then |
||
707 | raise EDirectSoundBufferError.CreateFmt(SNotMade, ['IDirectSoundBuffer']); |
||
708 | end; |
||
709 | |||
710 | function TDirectSoundBuffer.GetPlaying: Boolean; |
||
711 | begin |
||
712 | Result := (GetStatus and (DSBSTATUS_PLAYING or DSBSTATUS_LOOPING))<>0; |
||
713 | end; |
||
714 | |||
715 | function TDirectSoundBuffer.GetPan: Integer; |
||
716 | begin |
||
717 | DXResult := IBuffer.GetPan(Longint(Result)); |
||
718 | end; |
||
719 | |||
720 | function TDirectSoundBuffer.GetPosition: Longint; |
||
721 | var |
||
722 | dwCurrentWriteCursor: Longint; |
||
723 | begin |
||
724 | IBuffer.GetCurrentPosition(DWORD(Result), DWORD(dwCurrentWriteCursor)); |
||
725 | end; |
||
726 | |||
727 | function TDirectSoundBuffer.GetSize: Integer; |
||
728 | begin |
||
729 | Result := FCaps.dwBufferBytes; |
||
730 | end; |
||
731 | |||
732 | function TDirectSoundBuffer.GetStatus: Integer; |
||
733 | begin |
||
734 | DXResult := IBuffer.GetStatus(DWORD(Result)); |
||
735 | end; |
||
736 | |||
737 | function TDirectSoundBuffer.GetVolume: Integer; |
||
738 | begin |
||
739 | DXResult := IBuffer.GetVolume(Longint(Result)); |
||
740 | end; |
||
741 | |||
742 | procedure TDirectSoundBuffer.LoadFromFile(const FileName: string); |
||
743 | var |
||
744 | Stream : TFileStream; |
||
745 | begin |
||
746 | Stream := TFileStream.Create(FileName, fmOpenRead); |
||
747 | try |
||
748 | LoadFromStream(Stream); |
||
749 | finally |
||
750 | Stream.Free; |
||
751 | end; |
||
752 | end; |
||
753 | |||
754 | procedure TDirectSoundBuffer.LoadFromMemory(const Format: TWaveFormatEx; |
||
755 | Data: Pointer; Size: Integer); |
||
756 | var |
||
757 | Data1, Data2: Pointer; |
||
758 | Data1Size, Data2Size: Longint; |
||
759 | begin |
||
760 | SetSize(Format, Size); |
||
761 | |||
762 | if Data<>nil then |
||
763 | begin |
||
764 | if Lock(0, Size, Data1, Data1Size, Data2, Data2Size) then |
||
765 | begin |
||
766 | try |
||
767 | Move(Data^, Data1^, Data1Size); |
||
768 | if Data2<>nil then |
||
769 | Move(Pointer(Longint(Data)+Data1Size)^, Data2^, Data2Size); |
||
770 | finally |
||
771 | UnLock; |
||
772 | end; |
||
773 | end else |
||
774 | begin |
||
775 | FIDSBuffer := nil; |
||
776 | raise EDirectSoundBufferError.CreateFmt(SCannotLock, [SDirectSoundBuffer]); |
||
777 | end; |
||
778 | end; |
||
779 | end; |
||
780 | |||
781 | procedure TDirectSoundBuffer.LoadFromStream(Stream: TStream); |
||
782 | var |
||
783 | Wave: TWave; |
||
784 | begin |
||
785 | Wave := TWave.Create; |
||
786 | try |
||
787 | Wave.LoadFromStream(Stream); |
||
788 | LoadFromWave(Wave); |
||
789 | finally |
||
790 | Wave.Free; |
||
791 | end; |
||
792 | end; |
||
793 | |||
794 | procedure TDirectSoundBuffer.LoadFromWave(Wave: TWave); |
||
795 | begin |
||
796 | LoadFromMemory(Wave.Format^, Wave.Data, Wave.Size); |
||
797 | end; |
||
798 | |||
799 | function TDirectSoundBuffer.Lock(LockPosition, LockSize: Longint; |
||
800 | var AudioPtr1: Pointer; var AudioSize1: Longint; |
||
801 | var AudioPtr2: Pointer; var AudioSize2: Longint): Boolean; |
||
802 | begin |
||
803 | Result := False; |
||
804 | if IDSBuffer=nil then Exit; |
||
805 | |||
806 | if FLockCount>High(FLockAudioPtr1) then Exit; |
||
807 | |||
808 | DXResult := IBuffer.Lock(LockPosition, LockSize, |
||
809 | FLockAudioPtr1[FLockCount], FLockAudioSize1[FLockCount], |
||
810 | FLockAudioPtr2[FLockCount], FLockAudioSize2[FLockCount], 0); |
||
811 | Result := DXResult=DS_OK; |
||
812 | |||
813 | if Result then |
||
814 | begin |
||
815 | AudioPtr1 := FLockAudioPtr1[FLockCount]; |
||
816 | AudioPtr2 := FLockAudioPtr2[FLockCount]; |
||
817 | AudioSize1 := FLockAudioSize1[FLockCount]; |
||
818 | AudioSize2 := FLockAudioSize2[FLockCount]; |
||
819 | Inc(FLockCount); |
||
820 | end; |
||
821 | end; |
||
822 | |||
823 | function TDirectSoundBuffer.Play(Loop: Boolean): Boolean; |
||
824 | begin |
||
825 | if Loop then |
||
826 | DXResult := IBuffer.Play(0, 0, DSBPLAY_LOOPING) |
||
827 | else |
||
828 | DXResult := IBuffer.Play(0, 0, 0); |
||
829 | Result := DXResult=DS_OK; |
||
830 | end; |
||
831 | |||
832 | function TDirectSoundBuffer.Restore: Boolean; |
||
833 | begin |
||
834 | DXResult := IBuffer.Restore; |
||
835 | Result := DXResult=DS_OK; |
||
836 | end; |
||
837 | |||
838 | function TDirectSoundBuffer.SetFormat(const Format: TWaveFormatEx): Boolean; |
||
839 | begin |
||
840 | DXResult := IBuffer.SetFormat(Format); |
||
841 | Result := DXResult=DS_OK; |
||
842 | |||
843 | if Result then |
||
844 | begin |
||
845 | FreeMem(FFormat); |
||
846 | FFormat := nil; |
||
847 | FFormatSize := 0; |
||
848 | if IBuffer.GetFormat(PWaveFormatEx(nil)^, 0, DWORD(FFormatSize))=DS_OK then |
||
849 | begin |
||
850 | GetMem(FFormat, FFormatSize); |
||
851 | IBuffer.GetFormat(FFormat^, FFormatSize, PDWORD(nil)^); |
||
852 | end; |
||
853 | end; |
||
854 | end; |
||
855 | |||
856 | procedure TDirectSoundBuffer.SetFrequency(Value: Integer); |
||
857 | begin |
||
858 | DXResult := IBuffer.SetFrequency(Value); |
||
859 | end; |
||
860 | |||
861 | procedure TDirectSoundBuffer.SetIDSBuffer(Value: IDirectSoundBuffer); |
||
862 | begin |
||
863 | if FIDSBuffer=Value then Exit; |
||
864 | |||
865 | FIDSBuffer := Value; |
||
866 | FillChar(FCaps, SizeOf(FCaps), 0); |
||
867 | FreeMem(FFormat); |
||
868 | FFormat := nil; |
||
869 | FFormatSize := 0; |
||
870 | FLockCount := 0; |
||
871 | |||
872 | if FIDSBuffer<>nil then |
||
873 | begin |
||
874 | FCaps.dwSize := SizeOf(FCaps); |
||
875 | IBuffer.GetCaps(FCaps); |
||
876 | |||
877 | if IBuffer.GetFormat(PWaveFormatEx(nil)^, 0, DWORD(FFormatSize))=DS_OK then |
||
878 | begin |
||
879 | GetMem(FFormat, FFormatSize); |
||
880 | IBuffer.GetFormat(FFormat^, FFormatSize, PDWORD(nil)^); |
||
881 | end; |
||
882 | end; |
||
883 | end; |
||
884 | |||
885 | procedure TDirectSoundBuffer.SetPan(Value: Integer); |
||
886 | begin |
||
887 | DXResult := IBuffer.SetPan(Value); |
||
888 | end; |
||
889 | |||
890 | procedure TDirectSoundBuffer.SetPosition(Value: Longint); |
||
891 | begin |
||
892 | DXResult := IBuffer.SetCurrentPosition(Value); |
||
893 | end; |
||
894 | |||
895 | procedure TDirectSoundBuffer.SetSize(const Format: TWaveFormatEx; Size: Integer); |
||
896 | var |
||
897 | BufferDesc: TDSBufferDesc; |
||
898 | begin |
||
899 | { IDirectSoundBuffer made. } |
||
900 | FillChar(BufferDesc, SizeOf(BufferDesc), 0); |
||
901 | |||
902 | with BufferDesc do |
||
903 | begin |
||
904 | dwSize := SizeOf(TDSBufferDesc); |
||
905 | dwFlags := DSBCAPS_CTRLDEFAULT; |
||
906 | if DSound.FStickyFocus then |
||
907 | dwFlags := dwFlags or DSBCAPS_STICKYFOCUS |
||
908 | else if DSound.FGlobalFocus then |
||
909 | dwFlags := dwFlags or DSBCAPS_GLOBALFOCUS; |
||
910 | dwBufferBytes := Size; |
||
911 | lpwfxFormat := @Format; |
||
912 | end; |
||
913 | |||
914 | if not CreateBuffer(BufferDesc) then |
||
915 | raise EDirectSoundBufferError.CreateFmt(SCannotMade, [SDirectSoundBuffer]); |
||
916 | end; |
||
917 | |||
918 | procedure TDirectSoundBuffer.SetVolume(Value: Integer); |
||
919 | begin |
||
920 | DXResult := IBuffer.SetVolume(Value); |
||
921 | end; |
||
922 | |||
923 | procedure TDirectSoundBuffer.Stop; |
||
924 | begin |
||
925 | DXResult := IBuffer.Stop; |
||
926 | end; |
||
927 | |||
928 | procedure TDirectSoundBuffer.Unlock; |
||
929 | begin |
||
930 | if IDSBuffer=nil then Exit; |
||
931 | if FLockCount=0 then Exit; |
||
932 | |||
933 | Dec(FLockCount); |
||
934 | DXResult := IBuffer.UnLock(FLockAudioPtr1[FLockCount], FLockAudioSize1[FLockCount], |
||
935 | FLockAudioPtr2[FLockCount], FLockAudioSize2[FLockCount]); |
||
936 | end; |
||
937 | |||
938 | { TAudioStream } |
||
939 | |||
940 | type |
||
941 | TAudioStreamNotify = class(TThread) |
||
942 | private |
||
943 | FAudio: TAudioStream; |
||
944 | FSleepTime: Integer; |
||
945 | FStopOnTerminate: Boolean; |
||
946 | constructor Create(Audio: TAudioStream); |
||
947 | destructor Destroy; override; |
||
948 | procedure Execute; override; |
||
949 | procedure Update; |
||
950 | procedure ThreadTerminate(Sender: TObject); |
||
951 | end; |
||
952 | |||
953 | constructor TAudioStreamNotify.Create(Audio: TAudioStream); |
||
954 | begin |
||
955 | FAudio := Audio; |
||
956 | |||
957 | OnTerminate := ThreadTerminate; |
||
958 | |||
959 | FAudio.FNotifyEvent := CreateEvent(nil, False, False, nil); |
||
960 | FAudio.FNotifyThread := Self; |
||
961 | |||
962 | FSleepTime := Min(FAudio.FBufferLength div 4, 1000 div 20); |
||
963 | FStopOnTerminate := True; |
||
964 | |||
965 | FreeOnTerminate := True; |
||
966 | inherited Create(False); |
||
967 | end; |
||
968 | |||
969 | destructor TAudioStreamNotify.Destroy; |
||
970 | begin |
||
971 | FreeOnTerminate := False; |
||
972 | |||
973 | SetEvent(FAudio.FNotifyEvent); |
||
974 | inherited Destroy; |
||
975 | CloseHandle(FAudio.FNotifyEvent); |
||
976 | |||
977 | FAudio.FNotifyThread := nil; |
||
978 | end; |
||
979 | |||
980 | procedure TAudioStreamNotify.ThreadTerminate(Sender: TObject); |
||
981 | begin |
||
982 | FAudio.FNotifyThread := nil; |
||
983 | if FStopOnTerminate then FAudio.Stop; |
||
984 | end; |
||
985 | |||
986 | procedure TAudioStreamNotify.Execute; |
||
987 | begin |
||
988 | while WaitForSingleObject(FAudio.FNotifyEvent, FSleepTime)=WAIT_TIMEOUT do |
||
989 | Synchronize(Update); |
||
990 | end; |
||
991 | |||
992 | procedure TAudioStreamNotify.Update; |
||
993 | begin |
||
994 | if not FAudio.Playing then |
||
995 | begin |
||
996 | SetEvent(FAudio.FNotifyEvent); |
||
997 | EXit; |
||
998 | end; |
||
999 | |||
1000 | try |
||
1001 | FAudio.Update2(True); |
||
1002 | except |
||
1003 | on E: Exception do |
||
1004 | begin |
||
1005 | Application.HandleException(E); |
||
1006 | SetEvent(FAudio.FNotifyEvent); |
||
1007 | end; |
||
1008 | end; |
||
1009 | end; |
||
1010 | |||
1011 | constructor TAudioStream.Create(ADirectSound: TDirectSound); |
||
1012 | begin |
||
1013 | inherited Create; |
||
1014 | FDSound := ADirectSound; |
||
1015 | FAutoUpdate := True; |
||
1016 | FBuffer := TDirectSoundBuffer.Create(FDSound); |
||
1017 | FBufferLength := 1000; |
||
1018 | end; |
||
1019 | |||
1020 | destructor TAudioStream.Destroy; |
||
1021 | begin |
||
1022 | Stop; |
||
1023 | WaveStream := nil; |
||
1024 | FBuffer.Free; |
||
1025 | inherited Destroy; |
||
1026 | end; |
||
1027 | |||
1028 | function TAudioStream.GetFormat: PWaveFormatEX; |
||
1029 | begin |
||
1030 | if WaveStream=nil then |
||
1031 | raise EAudioStreamError.Create(SWaveStreamNotSet); |
||
1032 | Result := WaveStream.Format; |
||
1033 | end; |
||
1034 | |||
1035 | function TAudioStream.GetFormatSize: Integer; |
||
1036 | begin |
||
1037 | if WaveStream=nil then |
||
1038 | raise EAudioStreamError.Create(SWaveStreamNotSet); |
||
1039 | Result := WaveStream.FormatSize; |
||
1040 | end; |
||
1041 | |||
1042 | function TAudioStream.GetFrequency: Integer; |
||
1043 | begin |
||
1044 | Result := FBuffer.Frequency; |
||
1045 | end; |
||
1046 | |||
1047 | function TAudioStream.GetPan: Integer; |
||
1048 | begin |
||
1049 | Result := FBuffer.Pan; |
||
1050 | end; |
||
1051 | |||
1052 | function TAudioStream.GetPlayedSize: Integer; |
||
1053 | begin |
||
1054 | if Playing then UpdatePlayedSize; |
||
1055 | Result := FPlayedSize; |
||
1056 | end; |
||
1057 | |||
1058 | function TAudioStream.GetSize: Integer; |
||
1059 | begin |
||
1060 | if WaveStream<>nil then |
||
1061 | Result := WaveStream.Size |
||
1062 | else |
||
1063 | Result := 0; |
||
1064 | end; |
||
1065 | |||
1066 | function TAudioStream.GetVolume: Integer; |
||
1067 | begin |
||
1068 | Result := FBuffer.Volume; |
||
1069 | end; |
||
1070 | |||
1071 | procedure TAudioStream.UpdatePlayedSize; |
||
1072 | var |
||
1073 | PlayPosition, PlayedSize: DWORD; |
||
1074 | begin |
||
1075 | PlayPosition := FBuffer.Position; |
||
1076 | |||
1077 | if FPlayBufferPos <= PlayPosition then |
||
1078 | begin |
||
1079 | PlayedSize := PlayPosition - FPlayBufferPos |
||
1080 | end else |
||
1081 | begin |
||
1082 | PlayedSize := PlayPosition + (FBufferSize - FPlayBufferPos); |
||
1083 | end; |
||
1084 | |||
1085 | Inc(FPlayedSize, PlayedSize); |
||
1086 | |||
1087 | FPlayBufferPos := PlayPosition; |
||
1088 | end; |
||
1089 | |||
1090 | function TAudioStream.GetWriteSize: Integer; |
||
1091 | var |
||
1092 | PlayPosition: DWORD; |
||
1093 | i: Integer; |
||
1094 | begin |
||
1095 | PlayPosition := FBuffer.Position; |
||
1096 | |||
1097 | if FBufferPos <= PlayPosition then |
||
1098 | begin |
||
1099 | Result := PlayPosition - FBufferPos |
||
1100 | end else |
||
1101 | begin |
||
1102 | Result := PlayPosition + (FBufferSize - FBufferPos); |
||
1103 | end; |
||
1104 | |||
1105 | i := WaveStream.FilledSize; |
||
1106 | if i>=0 then Result := Min(Result, i); |
||
1107 | end; |
||
1108 | |||
1109 | procedure TAudioStream.Play; |
||
1110 | begin |
||
1111 | if not FPlaying then |
||
1112 | begin |
||
1113 | if WaveStream=nil then |
||
1114 | raise EAudioStreamError.Create(SWaveStreamNotSet); |
||
1115 | |||
1116 | if Size=0 then Exit; |
||
1117 | |||
1118 | FPlaying := True; |
||
1119 | try |
||
1120 | SetPosition(FPosition); |
||
1121 | if FAutoUpdate then |
||
1122 | FNotifyThread := TAudioStreamNotify.Create(Self); |
||
1123 | except |
||
1124 | Stop; |
||
1125 | raise; |
||
1126 | end; |
||
1127 | end; |
||
1128 | end; |
||
1129 | |||
1130 | procedure TAudioStream.RecreateBuf; |
||
1131 | var |
||
1132 | APlaying: Boolean; |
||
1133 | APosition: Integer; |
||
1134 | AFrequency: Integer; |
||
1135 | APan: Integer; |
||
1136 | AVolume: Integer; |
||
1137 | begin |
||
1138 | APlaying := Playing; |
||
1139 | |||
1140 | APosition := Position; |
||
1141 | AFrequency := Frequency; |
||
1142 | APan := Pan; |
||
1143 | AVolume := Volume; |
||
1144 | |||
1145 | SetWaveStream(WaveStream); |
||
1146 | |||
1147 | Position := APosition; |
||
1148 | Frequency := AFrequency; |
||
1149 | Pan := APan; |
||
1150 | Volume := AVolume; |
||
1151 | |||
1152 | if APlaying then Play; |
||
1153 | end; |
||
1154 | |||
1155 | procedure TAudioStream.SetAutoUpdate(Value: Boolean); |
||
1156 | begin |
||
1157 | if FAutoUpdate<>Value then |
||
1158 | begin |
||
1159 | FAutoUpdate := Value; |
||
1160 | if FPlaying then |
||
1161 | begin |
||
1162 | if FNotifyThread<>nil then |
||
1163 | begin |
||
1164 | (FNotifyThread as TAudioStreamNotify).FStopOnTerminate := False; |
||
1165 | FNotifyThread.Free; |
||
1166 | end; |
||
1167 | |||
1168 | if FAutoUpdate then |
||
1169 | FNotifyThread := TAudioStreamNotify.Create(Self); |
||
1170 | end; |
||
1171 | end; |
||
1172 | end; |
||
1173 | |||
1174 | procedure TAudioStream.SetBufferLength(Value: Integer); |
||
1175 | begin |
||
1176 | if Value<10 then Value := 10; |
||
1177 | if FBufferLength<>Value then |
||
1178 | begin |
||
1179 | FBufferLength := Value; |
||
1180 | if WaveStream<>nil then RecreateBuf; |
||
1181 | end; |
||
1182 | end; |
||
1183 | |||
1184 | procedure TAudioStream.SetFrequency(Value: Integer); |
||
1185 | begin |
||
1186 | FBuffer.Frequency := Value; |
||
1187 | end; |
||
1188 | |||
1189 | procedure TAudioStream.SetLooped(Value: Boolean); |
||
1190 | begin |
||
1191 | if FLooped<>Value then |
||
1192 | begin |
||
1193 | FLooped := Value; |
||
1194 | Position := Position; |
||
1195 | end; |
||
1196 | end; |
||
1197 | |||
1198 | procedure TAudioStream.SetPan(Value: Integer); |
||
1199 | begin |
||
1200 | FBuffer.Pan := Value; |
||
1201 | end; |
||
1202 | |||
1203 | procedure TAudioStream.SetPlayedSize(Value: Integer); |
||
1204 | begin |
||
1205 | if Playing then UpdatePlayedSize; |
||
1206 | FPlayedSize := Value; |
||
1207 | end; |
||
1208 | |||
1209 | procedure TAudioStream.SetPosition(Value: Integer); |
||
1210 | begin |
||
1211 | if WaveStream=nil then |
||
1212 | raise EAudioStreamError.Create(SWaveStreamNotSet); |
||
1213 | |||
1214 | Value := Max(Min(Value, Size-1), 0); |
||
1215 | Value := Value div Format^.nBlockAlign * Format^.nBlockAlign; |
||
1216 | |||
1217 | FPosition := Value; |
||
1218 | |||
1219 | if Playing then |
||
1220 | begin |
||
1221 | try |
||
1222 | FBuffer.Stop; |
||
1223 | |||
1224 | FBufferPos := 0; |
||
1225 | FPlayBufferPos := 0; |
||
1226 | FWritePosition := Value; |
||
1227 | |||
1228 | WriteWave(FBufferSize); |
||
1229 | |||
1230 | FBuffer.Position := 0; |
||
1231 | FBuffer.Play(True); |
||
1232 | except |
||
1233 | Stop; |
||
1234 | raise; |
||
1235 | end; |
||
1236 | end; |
||
1237 | end; |
||
1238 | |||
1239 | procedure TAudioStream.SetVolume(Value: Integer); |
||
1240 | begin |
||
1241 | FBuffer.Volume := Value; |
||
1242 | end; |
||
1243 | |||
1244 | procedure TAudioStream.SetWaveStream(Value: TCustomWaveStream); |
||
1245 | var |
||
1246 | BufferDesc: TDSBufferDesc; |
||
1247 | begin |
||
1248 | Stop; |
||
1249 | |||
1250 | FWaveStream := nil; |
||
1251 | FBufferPos := 0; |
||
1252 | FPosition := 0; |
||
1253 | FWritePosition := 0; |
||
1254 | |||
1255 | if (Value<>nil) and (FBufferLength>0) then |
||
1256 | begin |
||
1257 | FBufferSize := FBufferLength * Integer(Value.Format^.nAvgBytesPerSec) div 1000; |
||
1258 | |||
1259 | FillChar(BufferDesc, SizeOf(BufferDesc), 0); |
||
1260 | with BufferDesc do |
||
1261 | begin |
||
1262 | dwSize := SizeOf(TDSBufferDesc); |
||
1263 | dwFlags := DSBCAPS_CTRLDEFAULT or DSBCAPS_GETCURRENTPOSITION2; |
||
1264 | if FDSound.FStickyFocus then |
||
1265 | dwFlags := dwFlags or DSBCAPS_STICKYFOCUS |
||
1266 | else if FDSound.FGlobalFocus then |
||
1267 | dwFlags := dwFlags or DSBCAPS_GLOBALFOCUS; |
||
1268 | dwBufferBytes := FBufferSize; |
||
1269 | lpwfxFormat := Value.Format; |
||
1270 | end; |
||
1271 | |||
1272 | if not FBuffer.CreateBuffer(BufferDesc) then |
||
1273 | raise EDirectSoundBufferError.CreateFmt(SCannotMade, [SDirectSoundBuffer]); |
||
1274 | end else |
||
1275 | begin |
||
1276 | FBuffer.IDSBuffer := nil; |
||
1277 | FBufferSize := 0; |
||
1278 | end; |
||
1279 | |||
1280 | FWaveStream := Value; |
||
1281 | end; |
||
1282 | |||
1283 | procedure TAudioStream.Stop; |
||
1284 | begin |
||
1285 | if FPlaying then |
||
1286 | begin |
||
1287 | FPlaying := False; |
||
1288 | FBuffer.Stop; |
||
1289 | FNotifyThread.Free; |
||
1290 | end; |
||
1291 | end; |
||
1292 | |||
1293 | procedure TAudioStream.Update; |
||
1294 | begin |
||
1295 | Update2(False); |
||
1296 | end; |
||
1297 | |||
1298 | procedure TAudioStream.Update2(InThread: Boolean); |
||
1299 | var |
||
1300 | WriteSize: Integer; |
||
1301 | begin |
||
1302 | if not FPlaying then Exit; |
||
1303 | |||
1304 | try |
||
1305 | UpdatePlayedSize; |
||
1306 | |||
1307 | if Size<0 then |
||
1308 | begin |
||
1309 | WriteSize := GetWriteSize; |
||
1310 | if WriteSize>0 then |
||
1311 | begin |
||
1312 | WriteSize := WriteWave(WriteSize); |
||
1313 | FPosition := FPosition + WriteSize; |
||
1314 | end; |
||
1315 | end else |
||
1316 | begin |
||
1317 | if FLooped then |
||
1318 | begin |
||
1319 | WriteSize := GetWriteSize; |
||
1320 | if WriteSize>0 then |
||
1321 | begin |
||
1322 | WriteWave(WriteSize); |
||
1323 | FPosition := (FPosition + WriteSize) mod Size; |
||
1324 | end; |
||
1325 | end else |
||
1326 | begin |
||
1327 | if FPosition<Size then |
||
1328 | begin |
||
1329 | WriteSize := GetWriteSize; |
||
1330 | if WriteSize>0 then |
||
1331 | begin |
||
1332 | WriteWave(WriteSize); |
||
1333 | FPosition := FPosition + WriteSize; |
||
1334 | if FPosition>Size then FPosition := Size; |
||
1335 | end; |
||
1336 | end else |
||
1337 | begin |
||
1338 | if InThread then |
||
1339 | SetEvent(FNotifyEvent) |
||
1340 | else |
||
1341 | Stop; |
||
1342 | end; |
||
1343 | end; |
||
1344 | end; |
||
1345 | except |
||
1346 | if InThread then |
||
1347 | SetEvent(FNotifyEvent) |
||
1348 | else |
||
1349 | Stop; |
||
1350 | raise; |
||
1351 | end; |
||
1352 | end; |
||
1353 | |||
1354 | function TAudioStream.WriteWave(WriteSize: Integer): Integer; |
||
1355 | |||
1356 | procedure WriteData(Size: Integer); |
||
1357 | var |
||
1358 | Data1, Data2: Pointer; |
||
1359 | Data1Size, Data2Size: Longint; |
||
1360 | begin |
||
1361 | if FBuffer.Lock(FBufferPos, Size, Data1, Data1Size, Data2, Data2Size) then |
||
1362 | begin |
||
1363 | try |
||
1364 | FWaveStream.Position := FWritePosition; |
||
1365 | FWaveStream.ReadBuffer(Data1^, Data1Size); |
||
1366 | FWritePosition := FWritePosition + Data1Size; |
||
1367 | |||
1368 | if Data2<>nil then |
||
1369 | begin |
||
1370 | FWaveStream.ReadBuffer(Data2^, Data2Size); |
||
1371 | FWritePosition := FWritePosition + Data2Size; |
||
1372 | end; |
||
1373 | |||
1374 | FBufferPos := (FBufferPos + DWORD(Data1Size) + DWORD(Data2Size)) mod FBufferSize; |
||
1375 | finally |
||
1376 | FBuffer.UnLock; |
||
1377 | end; |
||
1378 | end; |
||
1379 | end; |
||
1380 | |||
1381 | procedure WriteData2(Size: Integer); |
||
1382 | var |
||
1383 | Data1, Data2: Pointer; |
||
1384 | Data1Size, Data2Size, s1, s2: Longint; |
||
1385 | begin |
||
1386 | if FBuffer.Lock(FBufferPos, Size, Data1, Data1Size, Data2, Data2Size) then |
||
1387 | begin |
||
1388 | try |
||
1389 | FWaveStream.Position := FWritePosition; |
||
1390 | s1 := FWaveStream.Read(Data1^, Data1Size); |
||
1391 | FWritePosition := FWritePosition + s1; |
||
1392 | FBufferPos := (FBufferPos + DWORD(s1)) mod FBufferSize; |
||
1393 | Inc(Result, s1); |
||
1394 | |||
1395 | if (Data2<>nil) and (s1=Data1Size) then |
||
1396 | begin |
||
1397 | s2 := FWaveStream.Read(Data2^, Data2Size); |
||
1398 | FWritePosition := FWritePosition + s2; |
||
1399 | FBufferPos := (FBufferPos + DWORD(s2)) mod FBufferSize; |
||
1400 | Inc(Result, s2); |
||
1401 | end; |
||
1402 | finally |
||
1403 | FBuffer.UnLock; |
||
1404 | end; |
||
1405 | end; |
||
1406 | end; |
||
1407 | |||
1408 | procedure WriteSilence(Size: Integer); |
||
1409 | var |
||
1410 | C: Byte; |
||
1411 | Data1, Data2: Pointer; |
||
1412 | Data1Size, Data2Size: Longint; |
||
1413 | begin |
||
1414 | if Format^.wBitsPerSample=8 then C := $80 else C := 0; |
||
1415 | |||
1416 | if FBuffer.Lock(FBufferPos, Size, Data1, Data1Size, Data2, Data2Size) then |
||
1417 | begin |
||
1418 | try |
||
1419 | FillChar(Data1^, Data1Size, C); |
||
1420 | |||
1421 | if Data2<>nil then |
||
1422 | FillChar(Data2^, Data2Size, C); |
||
1423 | finally |
||
1424 | FBuffer.UnLock; |
||
1425 | end; |
||
1426 | FBufferPos := (FBufferPos + DWORD(Data1Size) + DWORD(Data2Size)) mod FBufferSize; |
||
1427 | FWritePosition := FWritePosition + Data1Size + Data2Size; |
||
1428 | end; |
||
1429 | end; |
||
1430 | |||
1431 | var |
||
1432 | DataSize: Integer; |
||
1433 | begin |
||
1434 | if Size>=0 then |
||
1435 | begin |
||
1436 | Result := WriteSize; |
||
1437 | if FLooped then |
||
1438 | begin |
||
1439 | while WriteSize>0 do |
||
1440 | begin |
||
1441 | DataSize := Min(Size-FWritePosition, WriteSize); |
||
1442 | |||
1443 | WriteData(DataSize); |
||
1444 | FWritePosition := FWritePosition mod Size; |
||
1445 | |||
1446 | Dec(WriteSize, DataSize); |
||
1447 | end; |
||
1448 | end else |
||
1449 | begin |
||
1450 | DataSize := Size-FWritePosition; |
||
1451 | |||
1452 | if DataSize<=0 then |
||
1453 | begin |
||
1454 | WriteSilence(WriteSize); |
||
1455 | end else |
||
1456 | if DataSize>=WriteSize then |
||
1457 | begin |
||
1458 | WriteData(WriteSize); |
||
1459 | end else |
||
1460 | begin |
||
1461 | WriteData(DataSize); |
||
1462 | WriteSilence(WriteSize-DataSize); |
||
1463 | end; |
||
1464 | end; |
||
1465 | end else |
||
1466 | begin |
||
1467 | Result := 0; |
||
1468 | WriteData2(WriteSize); |
||
1469 | end; |
||
1470 | end; |
||
1471 | |||
1472 | { TAudioFileStream } |
||
1473 | |||
1474 | destructor TAudioFileStream.Destroy; |
||
1475 | begin |
||
1476 | inherited Destroy; |
||
1477 | FWaveFileStream.Free; |
||
1478 | end; |
||
1479 | |||
1480 | procedure TAudioFileStream.SetFileName(const Value: string); |
||
1481 | begin |
||
1482 | if FFileName=Value then Exit; |
||
1483 | |||
1484 | FFileName := Value; |
||
1485 | |||
1486 | if FWaveFileStream<>nil then |
||
1487 | begin |
||
1488 | WaveStream := nil; |
||
1489 | FWaveFileStream.Free; |
||
1490 | FWaveFileStream := nil; |
||
1491 | end; |
||
1492 | |||
1493 | if Value<>'' then |
||
1494 | begin |
||
1495 | try |
||
1496 | FWaveFileStream := TWaveFileStream.Create(Value, fmOpenRead or fmShareDenyWrite); |
||
1497 | FWaveFileStream.Open(False); |
||
1498 | WaveStream := FWaveFileStream; |
||
1499 | except |
||
1500 | WaveStream := nil; |
||
1501 | FFileName := ''; |
||
1502 | raise; |
||
1503 | end; |
||
1504 | end; |
||
1505 | end; |
||
1506 | |||
1507 | { TSoundCaptureFormats } |
||
1508 | |||
1509 | constructor TSoundCaptureFormats.Create; |
||
1510 | begin |
||
1511 | inherited Create(TSoundCaptureFormat); |
||
1512 | end; |
||
1513 | |||
1514 | function TSoundCaptureFormats.GetItem(Index: Integer): TSoundCaptureFormat; |
||
1515 | begin |
||
1516 | Result := TSoundCaptureFormat(inherited Items[Index]); |
||
1517 | end; |
||
1518 | |||
1519 | function TSoundCaptureFormats.IndexOf(ASamplesPerSec, ABitsPerSample, AChannels: Integer): Integer; |
||
1520 | var |
||
1521 | i: Integer; |
||
1522 | begin |
||
1523 | Result := -1; |
||
1524 | for i:=0 to Count-1 do |
||
1525 | with Items[i] do |
||
1526 | if (FSamplesPerSec=ASamplesPerSec) and (FBitsPerSample=ABitsPerSample) and (FChannels=AChannels) then |
||
1527 | begin |
||
1528 | Result := i; |
||
1529 | Break; |
||
1530 | end; |
||
1531 | end; |
||
1532 | |||
1533 | { TSoundCaptureStream } |
||
1534 | |||
1535 | type |
||
1536 | TSoundCaptureStreamNotify = class(TThread) |
||
1537 | private |
||
1538 | FCapture: TSoundCaptureStream; |
||
1539 | FSleepTime: Integer; |
||
1540 | constructor Create(Capture: TSoundCaptureStream); |
||
1541 | destructor Destroy; override; |
||
1542 | procedure Execute; override; |
||
1543 | procedure Update; |
||
1544 | end; |
||
1545 | |||
1546 | constructor TSoundCaptureStreamNotify.Create(Capture: TSoundCaptureStream); |
||
1547 | begin |
||
1548 | FCapture := Capture; |
||
1549 | |||
1550 | FCapture.FNotifyEvent := CreateEvent(nil, False, False, nil); |
||
1551 | FSleepTime := Min(FCapture.FBufferLength div 4, 1000 div 20); |
||
1552 | |||
1553 | FreeOnTerminate := True; |
||
1554 | inherited Create(True); |
||
1555 | end; |
||
1556 | |||
1557 | destructor TSoundCaptureStreamNotify.Destroy; |
||
1558 | begin |
||
1559 | FreeOnTerminate := False; |
||
1560 | SetEvent(FCapture.FNotifyEvent); |
||
1561 | |||
1562 | inherited Destroy; |
||
1563 | |||
1564 | CloseHandle(FCapture.FNotifyEvent); |
||
1565 | FCapture.FNotifyThread := nil; |
||
1566 | |||
1567 | if Assigned(FCapture.FOnFilledBuffer) then FCapture.Stop; |
||
1568 | end; |
||
1569 | |||
1570 | procedure TSoundCaptureStreamNotify.Execute; |
||
1571 | begin |
||
1572 | while WaitForSingleObject(FCapture.FNotifyEvent, FSleepTime)=WAIT_TIMEOUT do |
||
1573 | begin |
||
1574 | Synchronize(Update); |
||
1575 | end; |
||
1576 | end; |
||
1577 | |||
1578 | procedure TSoundCaptureStreamNotify.Update; |
||
1579 | begin |
||
1580 | if FCapture.FilledSize>0 then |
||
1581 | begin |
||
1582 | try |
||
1583 | FCapture.DoFilledBuffer; |
||
1584 | except |
||
1585 | on E: Exception do |
||
1586 | begin |
||
1587 | Application.HandleException(E); |
||
1588 | SetEvent(FCapture.FNotifyEvent); |
||
1589 | end; |
||
1590 | end; |
||
1591 | end; |
||
1592 | end; |
||
1593 | |||
1594 | constructor TSoundCaptureStream.Create(GUID: PGUID); |
||
1595 | const |
||
1596 | SamplesPerSecList: array[0..6] of Integer = (8000, 11025, 22050, 33075, 44100, 48000, 96000); |
||
1597 | BitsPerSampleList: array[0..3] of Integer = (8, 16, 24, 32); |
||
1598 | ChannelsList: array[0..1] of Integer = (1, 2); |
||
1599 | var |
||
1600 | ASamplesPerSec, ABitsPerSample, AChannels: Integer; |
||
1601 | dscbd: TDSCBufferDesc; |
||
1602 | TempBuffer: IDirectSoundCaptureBuffer; |
||
1603 | Format: TWaveFormatEx; |
||
1604 | begin |
||
1605 | inherited Create; |
||
1606 | FBufferLength := 1000; |
||
1607 | FSupportedFormats := TSoundCaptureFormats.Create; |
||
1608 | |||
1609 | if DXDirectSoundCaptureCreate(GUID, FCapture, nil)<>DS_OK then |
||
1610 | raise ESoundCaptureStreamError.CreateFmt(SCannotInitialized, [SDirectSoundCapture]); |
||
1611 | |||
1612 | { The supported format list is acquired. } |
||
1613 | for ASamplesPerSec:=Low(SamplesPerSecList) to High(SamplesPerSecList) do |
||
1614 | for ABitsPerSample:=Low(BitsPerSampleList) to High(BitsPerSampleList) do |
||
1615 | for AChannels:=Low(ChannelsList) to High(ChannelsList) do |
||
1616 | begin |
||
1617 | { Test } |
||
1618 | MakePCMWaveFormatEx(Format, SamplesPerSecList[ASamplesPerSec], BitsPerSampleList[ABitsPerSample], ChannelsList[AChannels]); |
||
1619 | |||
1620 | FillChar(dscbd, SizeOf(dscbd), 0); |
||
1621 | dscbd.dwSize := SizeOf(dscbd); |
||
1622 | dscbd.dwBufferBytes := Format.nAvgBytesPerSec; |
||
1623 | dscbd.lpwfxFormat := @Format; |
||
1624 | |||
1625 | { If the buffer can be made, the format of present can be used. } |
||
1626 | if FCapture.CreateCaptureBuffer(dscbd, TempBuffer, nil)=DS_OK then |
||
1627 | begin |
||
1628 | TempBuffer := nil; |
||
1629 | with TSoundCaptureFormat.Create(FSupportedFormats) do |
||
1630 | begin |
||
1631 | FSamplesPerSec := Format.nSamplesPerSec; |
||
1632 | FBitsPerSample := Format.wBitsPerSample; |
||
1633 | FChannels := Format.nChannels; |
||
1634 | end; |
||
1635 | end; |
||
1636 | end; |
||
1637 | end; |
||
1638 | |||
1639 | destructor TSoundCaptureStream.Destroy; |
||
1640 | begin |
||
1641 | Stop; |
||
1642 | FSupportedFormats.Free; |
||
1643 | inherited Destroy; |
||
1644 | end; |
||
1645 | |||
1646 | procedure TSoundCaptureStream.DoFilledBuffer; |
||
1647 | begin |
||
1648 | if Assigned(FOnFilledBuffer) then FOnFilledBuffer(Self); |
||
1649 | end; |
||
1650 | |||
1651 | class function TSoundCaptureStream.Drivers: TDirectXDrivers; |
||
1652 | begin |
||
1653 | Result := EnumDirectSoundCaptureDrivers; |
||
1654 | end; |
||
1655 | |||
1656 | function TSoundCaptureStream.GetFilledSize: Integer; |
||
1657 | begin |
||
1658 | Result := GetReadSize; |
||
1659 | end; |
||
1660 | |||
1661 | function TSoundCaptureStream.GetReadSize: Integer; |
||
1662 | var |
||
1663 | CapturePosition, ReadPosition: DWORD; |
||
1664 | begin |
||
1665 | if FBuffer.GetCurrentPosition(CapturePosition, ReadPosition)=DS_OK then |
||
1666 | begin |
||
1667 | if FBufferPos<=ReadPosition then |
||
1668 | Result := ReadPosition - FBufferPos |
||
1669 | else |
||
1670 | Result := FBufferSize - FBufferPos + ReadPosition; |
||
1671 | end else |
||
1672 | Result := 0; |
||
1673 | end; |
||
1674 | |||
1675 | function TSoundCaptureStream.ReadWave(var Buffer; Count: Integer): Integer; |
||
1676 | var |
||
1677 | Size: Integer; |
||
1678 | Data1, Data2: Pointer; |
||
1679 | Data1Size, Data2Size: DWORD; |
||
1680 | C: Byte; |
||
1681 | begin |
||
1682 | if not FCapturing then |
||
1683 | Start; |
||
1684 | |||
1685 | Result := 0; |
||
1686 | while Result<Count do |
||
1687 | begin |
||
1688 | Size := Min(Count-Result, GetReadSize); |
||
1689 | if Size>0 then |
||
1690 | begin |
||
1691 | if FBuffer.Lock(FBufferPos, Size, Data1, Data1Size, Data2, Data2Size, 0)=DS_OK then |
||
1692 | begin |
||
1693 | Move(Data1^, Pointer(Integer(@Buffer)+Result)^, Data1Size); |
||
1694 | Result := Result + Integer(Data1Size); |
||
1695 | |||
1696 | if Data2<>nil then |
||
1697 | begin |
||
1698 | Move(Data2^, Pointer(Integer(@Buffer)+Result)^, Data2Size); |
||
1699 | Result := Result + Integer(Data1Size); |
||
1700 | end; |
||
1701 | |||
1702 | FBuffer.UnLock(Data1, Data1Size, Data2, Data2Size); |
||
1703 | FBufferPos := (FBufferPos + Data1Size + Data2Size) mod FBufferSize; |
||
1704 | end else |
||
1705 | Break; |
||
1706 | end; |
||
1707 | if Result<Count then Sleep(50); |
||
1708 | end; |
||
1709 | |||
1710 | case Format^.wBitsPerSample of |
||
1711 | 8: C := $80; |
||
1712 | 16: C := $00; |
||
1713 | else |
||
1714 | C := $00; |
||
1715 | end; |
||
1716 | |||
1717 | FillChar(Pointer(Integer(@Buffer)+Result)^, Count-Result, C); |
||
1718 | Result := Count; |
||
1719 | end; |
||
1720 | |||
1721 | procedure TSoundCaptureStream.SetBufferLength(Value: Integer); |
||
1722 | begin |
||
1723 | FBufferLength := Max(Value, 0); |
||
1724 | end; |
||
1725 | |||
1726 | procedure TSoundCaptureStream.SetOnFilledBuffer(Value: TNotifyEvent); |
||
1727 | begin |
||
1728 | if CompareMem(@TMethod(FOnFilledBuffer), @TMethod(Value), SizeOf(TMethod)) then Exit; |
||
1729 | |||
1730 | if FCapturing then |
||
1731 | begin |
||
1732 | if Assigned(FOnFilledBuffer) then |
||
1733 | FNotifyThread.Free; |
||
1734 | |||
1735 | FOnFilledBuffer := Value; |
||
1736 | |||
1737 | if Assigned(FOnFilledBuffer) then |
||
1738 | begin |
||
1739 | FNotifyThread := TSoundCaptureStreamNotify.Create(Self); |
||
1740 | FNotifyThread.Resume; |
||
1741 | end; |
||
1742 | end else |
||
1743 | FOnFilledBuffer := Value; |
||
1744 | end; |
||
1745 | |||
1746 | procedure TSoundCaptureStream.Start; |
||
1747 | var |
||
1748 | dscbd: TDSCBufferDesc; |
||
1749 | begin |
||
1750 | Stop; |
||
1751 | try |
||
1752 | FCapturing := True; |
||
1753 | |||
1754 | FormatSize := SizeOf(TWaveFormatEx); |
||
1755 | with FSupportedFormats[CaptureFormat] do |
||
1756 | MakePCMWaveFormatEx(Format^, SamplesPerSec, BitsPerSample, Channels); |
||
1757 | |||
1758 | FBufferSize := Max(MulDiv(Format^.nAvgBytesPerSec, FBufferLength, 1000), 8000); |
||
1759 | |||
1760 | FillChar(dscbd, SizeOf(dscbd), 0); |
||
1761 | dscbd.dwSize := SizeOf(dscbd); |
||
1762 | dscbd.dwBufferBytes := FBufferSize; |
||
1763 | dscbd.lpwfxFormat := Format; |
||
1764 | |||
1765 | if FCapture.CreateCaptureBuffer(dscbd, FBuffer, nil)<>DS_OK then |
||
1766 | raise ESoundCaptureStreamError.CreateFmt(SCannotMade, [SDirectSoundCaptureBuffer]); |
||
1767 | |||
1768 | FBufferPos := 0; |
||
1769 | |||
1770 | FBuffer.Start(DSCBSTART_LOOPING); |
||
1771 | |||
1772 | if Assigned(FOnFilledBuffer) then |
||
1773 | begin |
||
1774 | FNotifyThread := TSoundCaptureStreamNotify.Create(Self); |
||
1775 | FNotifyThread.Resume; |
||
1776 | end; |
||
1777 | except |
||
1778 | Stop; |
||
1779 | raise; |
||
1780 | end; |
||
1781 | end; |
||
1782 | |||
1783 | procedure TSoundCaptureStream.Stop; |
||
1784 | begin |
||
1785 | if FCapturing then |
||
1786 | begin |
||
1787 | FNotifyThread.Free; |
||
1788 | FCapturing := False; |
||
1789 | if FBuffer<>nil then |
||
1790 | FBuffer.Stop; |
||
1791 | FBuffer := nil; |
||
1792 | end; |
||
1793 | end; |
||
1794 | |||
1795 | { TSoundEngine } |
||
1796 | |||
1797 | constructor TSoundEngine.Create(ADSound: TDirectSound); |
||
1798 | begin |
||
1799 | inherited Create; |
||
1800 | FDSound := ADSound; |
||
1801 | FEnabled := True; |
||
1802 | |||
1803 | |||
1804 | FEffectList := TList.Create; |
||
1805 | FTimer := TTimer.Create(nil); |
||
1806 | FTimer.Interval := 500; |
||
1807 | FTimer.OnTimer := TimerEvent; |
||
1808 | end; |
||
1809 | |||
1810 | destructor TSoundEngine.Destroy; |
||
1811 | begin |
||
1812 | Clear; |
||
1813 | FTimer.Free; |
||
1814 | FEffectList.Free; |
||
1815 | inherited Destroy; |
||
1816 | end; |
||
1817 | |||
1818 | procedure TSoundEngine.Clear; |
||
1819 | var |
||
1820 | i: Integer; |
||
1821 | begin |
||
1822 | for i:=EffectCount-1 downto 0 do |
||
1823 | Effects[i].Free; |
||
1824 | FEffectList.Clear; |
||
1825 | end; |
||
1826 | |||
1827 | procedure TSoundEngine.EffectFile(const Filename: string; Loop, Wait: Boolean); |
||
1828 | var |
||
1829 | Stream : TFileStream; |
||
1830 | begin |
||
1831 | Stream :=TFileStream.Create(Filename, fmOpenRead); |
||
1832 | try |
||
1833 | EffectStream(Stream, Loop, Wait); |
||
1834 | finally |
||
1835 | Stream.Free; |
||
1836 | end; |
||
1837 | end; |
||
1838 | |||
1839 | procedure TSoundEngine.EffectStream(Stream: TStream; Loop, Wait: Boolean); |
||
1840 | var |
||
1841 | Wave: TWave; |
||
1842 | begin |
||
1843 | Wave := TWave.Create; |
||
1844 | try |
||
1845 | Wave.LoadfromStream(Stream); |
||
1846 | EffectWave(Wave, Loop, Wait); |
||
1847 | finally |
||
1848 | Wave.Free; |
||
1849 | end; |
||
1850 | end; |
||
1851 | |||
1852 | procedure TSoundEngine.EffectWave(Wave: TWave; Loop, Wait: Boolean); |
||
1853 | var |
||
1854 | Buffer: TDirectSoundBuffer; |
||
1855 | begin |
||
1856 | if not FEnabled then Exit; |
||
1857 | |||
1858 | if Wait then |
||
1859 | begin |
||
1860 | Buffer := TDirectSoundBuffer.Create(FDSound); |
||
1861 | try |
||
1862 | Buffer.LoadFromWave(Wave); |
||
1863 | Buffer.Play(False); |
||
1864 | while Buffer.Playing do |
||
1865 | Sleep(1); |
||
1866 | finally |
||
1867 | Buffer.Free; |
||
1868 | end; |
||
1869 | end else |
||
1870 | begin |
||
1871 | Buffer := TDirectSoundBuffer.Create(FDSound); |
||
1872 | try |
||
1873 | Buffer.LoadFromWave(Wave); |
||
1874 | Buffer.Play(Loop); |
||
1875 | except |
||
1876 | Buffer.Free; |
||
1877 | raise; |
||
1878 | end; |
||
1879 | FEffectList.Add(Buffer); |
||
1880 | end; |
||
1881 | end; |
||
1882 | |||
1883 | function TSoundEngine.GetEffect(Index: Integer): TDirectSoundBuffer; |
||
1884 | begin |
||
1885 | Result := TDirectSoundBuffer(FEffectList[Index]); |
||
1886 | end; |
||
1887 | |||
1888 | function TSoundEngine.GetEffectCount: Integer; |
||
1889 | begin |
||
1890 | Result := FEffectList.Count; |
||
1891 | end; |
||
1892 | |||
1893 | procedure TSoundEngine.SetEnabled(Value: Boolean); |
||
1894 | var |
||
1895 | i: Integer; |
||
1896 | begin |
||
1897 | for i:=EffectCount-1 downto 0 do |
||
1898 | Effects[i].Free; |
||
1899 | FEffectList.Clear; |
||
1900 | |||
1901 | FEnabled := Value; |
||
1902 | FTimer.Enabled := Value; |
||
1903 | end; |
||
1904 | |||
1905 | procedure TSoundEngine.TimerEvent(Sender: TObject); |
||
1906 | var |
||
1907 | i: Integer; |
||
1908 | begin |
||
1909 | for i:=EffectCount-1 downto 0 do |
||
1910 | if not TDirectSoundBuffer(FEffectList[i]).Playing then |
||
1911 | begin |
||
1912 | TDirectSoundBuffer(FEffectList[i]).Free; |
||
1913 | FEffectList.Delete(i); |
||
1914 | end; |
||
1915 | end; |
||
1916 | |||
1917 | { TCustomDXSound } |
||
1918 | |||
1919 | type |
||
1920 | TDXSoundDirectSound = class(TDirectSound) |
||
1921 | private |
||
1922 | FDXSound: TCustomDXSound; |
||
1923 | protected |
||
1924 | procedure DoRestoreBuffer; override; |
||
1925 | end; |
||
1926 | |||
1927 | procedure TDXSoundDirectSound.DoRestoreBuffer; |
||
1928 | begin |
||
1929 | inherited DoRestoreBuffer; |
||
1930 | FDXSound.Restore; |
||
1931 | end; |
||
1932 | |||
1933 | constructor TCustomDXSound.Create(AOwner: TComponent); |
||
1934 | begin |
||
1935 | FNotifyEventList := TList.Create; |
||
1936 | inherited Create(AOwner); |
||
1937 | FAutoInitialize := True; |
||
1938 | Options := []; |
||
1939 | end; |
||
1940 | |||
1941 | destructor TCustomDXSound.Destroy; |
||
1942 | begin |
||
1943 | Finalize; |
||
1944 | NotifyEventList(dsntDestroying); |
||
1945 | FNotifyEventList.Free; |
||
1946 | inherited Destroy; |
||
1947 | end; |
||
1948 | |||
1949 | type |
||
1950 | PDXSoundNotifyEvent = ^TDXSoundNotifyEvent; |
||
1951 | |||
1952 | procedure TCustomDXSound.RegisterNotifyEvent(NotifyEvent: TDXSoundNotifyEvent); |
||
1953 | var |
||
1954 | Event: PDXSoundNotifyEvent; |
||
1955 | begin |
||
1956 | UnRegisterNotifyEvent(NotifyEvent); |
||
1957 | |||
1958 | New(Event); |
||
1959 | Event^ := NotifyEvent; |
||
1960 | FNotifyEventList.Add(Event); |
||
1961 | |||
1962 | if Initialized then |
||
1963 | begin |
||
1964 | NotifyEvent(Self, dsntInitialize); |
||
1965 | NotifyEvent(Self, dsntRestore); |
||
1966 | end; |
||
1967 | end; |
||
1968 | |||
1969 | procedure TCustomDXSound.UnRegisterNotifyEvent(NotifyEvent: TDXSoundNotifyEvent); |
||
1970 | var |
||
1971 | Event: PDXSoundNotifyEvent; |
||
1972 | i: Integer; |
||
1973 | begin |
||
1974 | for i:=0 to FNotifyEventList.Count-1 do |
||
1975 | begin |
||
1976 | Event := FNotifyEventList[i]; |
||
1977 | if (TMethod(Event^).Code = TMethod(NotifyEvent).Code) and |
||
1978 | (TMethod(Event^).Data = TMethod(NotifyEvent).Data) then |
||
1979 | begin |
||
1980 | Dispose(Event); |
||
1981 | FNotifyEventList.Delete(i); |
||
1982 | |||
1983 | if Initialized then |
||
1984 | NotifyEvent(Self, dsntFinalize); |
||
1985 | |||
1986 | Break; |
||
1987 | end; |
||
1988 | end; |
||
1989 | end; |
||
1990 | |||
1991 | procedure TCustomDXSound.NotifyEventList(NotifyType: TDXSoundNotifyType); |
||
1992 | var |
||
1993 | i: Integer; |
||
1994 | begin |
||
1995 | for i:=FNotifyEventList.Count-1 downto 0 do |
||
1996 | PDXSoundNotifyEvent(FNotifyEventList[i])^(Self, NotifyType); |
||
1997 | end; |
||
1998 | |||
1999 | procedure TCustomDXSound.FormWndProc(var Message: TMessage; DefWindowProc: TWndMethod); |
||
2000 | begin |
||
2001 | case Message.Msg of |
||
2002 | WM_CREATE: |
||
2003 | begin |
||
2004 | DefWindowProc(Message); |
||
2005 | SetForm(FForm); |
||
2006 | Exit; |
||
2007 | end; |
||
2008 | end; |
||
2009 | DefWindowProc(Message); |
||
2010 | end; |
||
2011 | |||
2012 | class function TCustomDXSound.Drivers: TDirectXDrivers; |
||
2013 | begin |
||
2014 | Result := EnumDirectSoundDrivers; |
||
2015 | end; |
||
2016 | |||
2017 | procedure TCustomDXSound.DoFinalize; |
||
2018 | begin |
||
2019 | if Assigned(FOnFinalize) then FOnFinalize(Self); |
||
2020 | end; |
||
2021 | |||
2022 | procedure TCustomDXSound.DoInitialize; |
||
2023 | begin |
||
2024 | if Assigned(FOnInitialize) then FOnInitialize(Self); |
||
2025 | end; |
||
2026 | |||
2027 | procedure TCustomDXSound.DoInitializing; |
||
2028 | begin |
||
2029 | if Assigned(FOnInitializing) then FOnInitializing(Self); |
||
2030 | end; |
||
2031 | |||
2032 | procedure TCustomDXSound.DoRestore; |
||
2033 | begin |
||
2034 | if Assigned(FOnRestore) then FOnRestore(Self); |
||
2035 | end; |
||
2036 | |||
2037 | procedure TCustomDXSound.Finalize; |
||
2038 | begin |
||
2039 | if FInternalInitialized then |
||
2040 | begin |
||
2041 | try |
||
2042 | FSubClass.Free; FSubClass := nil; |
||
2043 | |||
2044 | try |
||
2045 | if FCalledDoInitialize then |
||
2046 | begin |
||
2047 | FCalledDoInitialize := False; |
||
2048 | DoFinalize; |
||
2049 | end; |
||
2050 | finally |
||
2051 | NotifyEventList(dsntFinalize); |
||
2052 | end; |
||
2053 | finally |
||
2054 | FInitialized := False; |
||
2055 | FInternalInitialized := False; |
||
2056 | |||
2057 | SetOptions(FOptions); |
||
2058 | |||
2059 | FPrimary.Free; FPrimary := nil; |
||
2060 | FDSound.Free; FDSound := nil; |
||
2061 | end; |
||
2062 | end; |
||
2063 | end; |
||
2064 | |||
2065 | procedure TCustomDXSound.Initialize; |
||
2066 | const |
||
2067 | PrimaryDesc: TDSBufferDesc = ( |
||
2068 | dwSize: SizeOf (PrimaryDesc); |
||
2069 | dwFlags: DSBCAPS_PRIMARYBUFFER); |
||
2070 | var |
||
2071 | Component: TComponent; |
||
2072 | begin |
||
2073 | Finalize; |
||
2074 | |||
2075 | Component := Owner; |
||
2076 | while (Component<>nil) and (not (Component is TCustomForm)) do |
||
2077 | Component := Component.Owner; |
||
2078 | if Component=nil then |
||
2079 | raise EDXSoundError.Create(SNoForm); |
||
2080 | |||
2081 | NotifyEventList(dsntInitializing); |
||
2082 | DoInitializing; |
||
2083 | |||
2084 | FInternalInitialized := True; |
||
2085 | try |
||
2086 | { DirectSound initialization. } |
||
2087 | FDSound := TDXSoundDirectSound.Create(Driver); |
||
2088 | TDXSoundDirectSound(FDSound).FDXSound := Self; |
||
2089 | |||
2090 | FDSound.FGlobalFocus := soGlobalFocus in FNowOptions; |
||
2091 | |||
2092 | { Primary buffer made. } |
||
2093 | FPrimary := TDirectSoundBuffer.Create(FDSound); |
||
2094 | if not FPrimary.CreateBuffer(PrimaryDesc) then |
||
2095 | raise EDXSoundError.CreateFmt(SCannotMade, [SDirectSoundPrimaryBuffer]); |
||
2096 | |||
2097 | FInitialized := True; |
||
2098 | |||
2099 | SetForm(TCustomForm(Component)); |
||
2100 | except |
||
2101 | Finalize; |
||
2102 | raise; |
||
2103 | end; |
||
2104 | |||
2105 | NotifyEventList(dsntInitialize); |
||
2106 | |||
2107 | FCalledDoInitialize := True; DoInitialize; |
||
2108 | |||
2109 | Restore; |
||
2110 | end; |
||
2111 | |||
2112 | procedure TCustomDXSound.Loaded; |
||
2113 | begin |
||
2114 | inherited Loaded; |
||
2115 | |||
2116 | if FAutoInitialize and (not (csDesigning in ComponentState)) then |
||
2117 | begin |
||
2118 | try |
||
2119 | Initialize; |
||
2120 | except |
||
2121 | on E: EDirectSoundError do ; |
||
2122 | else raise; |
||
2123 | end; |
||
2124 | end; |
||
2125 | end; |
||
2126 | |||
2127 | procedure TCustomDXSound.Restore; |
||
2128 | begin |
||
2129 | if FInitialized then |
||
2130 | begin |
||
2131 | NotifyEventList(dsntRestore); |
||
2132 | DoRestore; |
||
2133 | end; |
||
2134 | end; |
||
2135 | |||
2136 | procedure TCustomDXSound.SetDriver(Value: PGUID); |
||
2137 | begin |
||
2138 | if not IsBadHugeReadPtr(Value, SizeOf(TGUID)) then |
||
2139 | begin |
||
2140 | FDriverGUID := Value^; |
||
2141 | FDriver := @FDriverGUID; |
||
2142 | end else |
||
2143 | FDriver := Value; |
||
2144 | end; |
||
2145 | |||
2146 | procedure TCustomDXSound.SetForm(Value: TCustomForm); |
||
2147 | var |
||
2148 | Level: Integer; |
||
2149 | begin |
||
2150 | FForm := Value; |
||
2151 | |||
2152 | FSubClass.Free; |
||
2153 | FSubClass := TControlSubClass.Create(FForm, FormWndProc); |
||
2154 | |||
2155 | if FInitialized then |
||
2156 | begin |
||
2157 | if soExclusive in FNowOptions then |
||
2158 | Level := DSSCL_EXCLUSIVE |
||
2159 | else |
||
2160 | Level := DSSCL_NORMAL; |
||
2161 | |||
2162 | FDSound.DXResult := FDSound.ISound.SetCooperativeLevel(FForm.Handle, Level); |
||
2163 | end; |
||
2164 | end; |
||
2165 | |||
2166 | procedure TCustomDXSound.SetOptions(Value: TDXSoundOptions); |
||
2167 | const |
||
2168 | DXSoundOptions = [soGlobalFocus, soStickyFocus, soExclusive]; |
||
2169 | InitOptions: TDXSoundOptions = [soExclusive]; |
||
2170 | var |
||
2171 | OldOptions: TDXSoundOptions; |
||
2172 | begin |
||
2173 | FOptions := Value; |
||
2174 | |||
2175 | if Initialized then |
||
2176 | begin |
||
2177 | OldOptions := FNowOptions; |
||
2178 | |||
2179 | FNowOptions := (FNowOptions - (DXSoundOptions - InitOptions)) + |
||
2180 | (Value - InitOptions); |
||
2181 | |||
2182 | FDSound.FGlobalFocus := soGlobalFocus in FNowOptions; |
||
2183 | FDSound.FStickyFocus := soStickyFocus in FNowOptions; |
||
2184 | end else |
||
2185 | FNowOptions := FOptions; |
||
2186 | end; |
||
2187 | |||
2188 | { TWaveCollectionItem } |
||
2189 | |||
2190 | constructor TWaveCollectionItem.Create(Collection: TCollection); |
||
2191 | begin |
||
2192 | inherited Create(Collection); |
||
2193 | FWave := TWave.Create; |
||
2194 | FBufferList := TList.Create; |
||
2195 | end; |
||
2196 | |||
2197 | destructor TWaveCollectionItem.Destroy; |
||
2198 | begin |
||
2199 | Finalize; |
||
2200 | FWave.Free; |
||
2201 | FBufferList.Free; |
||
2202 | inherited Destroy; |
||
2203 | end; |
||
2204 | |||
2205 | procedure TWaveCollectionItem.Assign(Source: TPersistent); |
||
2206 | var |
||
2207 | PrevInitialized: Boolean; |
||
2208 | begin |
||
2209 | if Source is TWaveCollectionItem then |
||
2210 | begin |
||
2211 | PrevInitialized := Initialized; |
||
2212 | Finalize; |
||
2213 | |||
2214 | FLooped := TWaveCollectionItem(Source).FLooped; |
||
2215 | Name := TWaveCollectionItem(Source).Name; |
||
2216 | FMaxPlayingCount := TWaveCollectionItem(Source).FMaxPlayingCount; |
||
2217 | |||
2218 | FFrequency := TWaveCollectionItem(Source).FFrequency; |
||
2219 | FPan := TWaveCollectionItem(Source).FPan; |
||
2220 | FVolume := TWaveCollectionItem(Source).FVolume; |
||
2221 | |||
2222 | FWave.Assign(TWaveCollectionItem(Source).FWave); |
||
2223 | |||
2224 | if PrevInitialized then |
||
2225 | Restore; |
||
2226 | end else |
||
2227 | inherited Assign(Source); |
||
2228 | end; |
||
2229 | |||
2230 | function TWaveCollectionItem.GetBuffer: TDirectSoundBuffer; |
||
2231 | begin |
||
2232 | if FInitialized and (FBuffer=nil) then |
||
2233 | Restore; |
||
2234 | Result := FBuffer; |
||
2235 | end; |
||
2236 | |||
2237 | function TWaveCollectionItem.GetWaveCollection: TWaveCollection; |
||
2238 | begin |
||
2239 | Result := Collection as TWaveCollection; |
||
2240 | end; |
||
2241 | |||
2242 | procedure TWaveCollectionItem.Finalize; |
||
2243 | var |
||
2244 | i: Integer; |
||
2245 | begin |
||
2246 | if not FInitialized then Exit; |
||
2247 | FInitialized := False; |
||
2248 | |||
2249 | for i:=0 to FBufferList.Count-1 do |
||
2250 | TDirectSoundBuffer(FBufferList[i]).Free; |
||
2251 | FBufferList.Clear; |
||
2252 | FBuffer.Free; FBuffer := nil; |
||
2253 | end; |
||
2254 | |||
2255 | procedure TWaveCollectionItem.Initialize; |
||
2256 | begin |
||
2257 | Finalize; |
||
2258 | FInitialized := WaveCollection.Initialized; |
||
2259 | end; |
||
2260 | |||
2261 | function TWaveCollectionItem.CreateBuffer: TDirectSoundBuffer; |
||
2262 | begin |
||
2263 | Result := nil; |
||
2264 | if GetBuffer=nil then Exit; |
||
2265 | |||
2266 | Result := TDirectSoundBuffer.Create(WaveCollection.DXSound.DSound); |
||
2267 | try |
||
2268 | Result.Assign(GetBuffer); |
||
2269 | except |
||
2270 | Result.Free; |
||
2271 | raise; |
||
2272 | end; |
||
2273 | end; |
||
2274 | |||
2275 | procedure TWaveCollectionItem.Play(Wait: Boolean); |
||
2276 | var |
||
2277 | NewBuffer: TDirectSoundBuffer; |
||
2278 | i: Integer; |
||
2279 | begin |
||
2280 | if not FInitialized then Exit; |
||
2281 | |||
2282 | if FLooped then |
||
2283 | begin |
||
2284 | GetBuffer.Stop; |
||
2285 | GetBuffer.Position := 0; |
||
2286 | GetBuffer.Play(True); |
||
2287 | end else |
||
2288 | begin |
||
2289 | NewBuffer := nil; |
||
2290 | for i:=0 to FBufferList.Count-1 do |
||
2291 | if not TDirectSoundBuffer(FBufferList[i]).Playing then |
||
2292 | begin |
||
2293 | NewBuffer := FBufferList[i]; |
||
2294 | Break; |
||
2295 | end; |
||
2296 | |||
2297 | if NewBuffer=nil then |
||
2298 | begin |
||
2299 | if FMaxPlayingCount=0 then |
||
2300 | begin |
||
2301 | NewBuffer := CreateBuffer; |
||
2302 | if NewBuffer=nil then Exit; |
||
2303 | |||
2304 | FBufferList.Add(NewBuffer); |
||
2305 | end else |
||
2306 | begin |
||
2307 | if FBufferList.Count<FMaxPlayingCount then |
||
2308 | begin |
||
2309 | NewBuffer := CreateBuffer; |
||
2310 | if NewBuffer=nil then Exit; |
||
2311 | |||
2312 | FBufferList.Add(NewBuffer); |
||
2313 | end else |
||
2314 | begin |
||
2315 | NewBuffer := FBufferList[0]; |
||
2316 | FBufferList.Move(0, FBufferList.Count-1); |
||
2317 | end; |
||
2318 | end; |
||
2319 | end; |
||
2320 | |||
2321 | NewBuffer.Stop; |
||
2322 | NewBuffer.Position := 0; |
||
2323 | NewBuffer.Frequency := FFrequency; |
||
2324 | NewBuffer.Pan := FPan; |
||
2325 | NewBuffer.Volume := FVolume; |
||
2326 | NewBuffer.Play(False); |
||
2327 | |||
2328 | if Wait then |
||
2329 | begin |
||
2330 | while NewBuffer.Playing do |
||
2331 | Sleep(10); |
||
2332 | end; |
||
2333 | end; |
||
2334 | end; |
||
2335 | |||
2336 | procedure TWaveCollectionItem.Restore; |
||
2337 | begin |
||
2338 | if FWave.Size=0 then Exit; |
||
2339 | |||
2340 | if not FInitialized then |
||
2341 | begin |
||
2342 | if WaveCollection.Initialized then |
||
2343 | Initialize; |
||
2344 | if not FInitialized then Exit; |
||
2345 | end; |
||
2346 | |||
2347 | if FBuffer=nil then |
||
2348 | FBuffer := TDirectSoundBuffer.Create(WaveCollection.DXSound.DSound); |
||
2349 | |||
2350 | FBuffer.LoadFromWave(FWave); |
||
2351 | FBuffer.Frequency := FFrequency; |
||
2352 | FBuffer.Pan := FPan; |
||
2353 | FBuffer.Volume := FVolume; |
||
2354 | end; |
||
2355 | |||
2356 | procedure TWaveCollectionItem.Stop; |
||
2357 | var |
||
2358 | i: Integer; |
||
2359 | begin |
||
2360 | if not FInitialized then Exit; |
||
2361 | |||
2362 | FBuffer.Stop; |
||
2363 | for i:=0 to FBufferList.Count-1 do |
||
2364 | TDirectSoundBuffer(FBufferList[i]).Stop; |
||
2365 | end; |
||
2366 | |||
2367 | procedure TWaveCollectionItem.SetFrequency(Value: Integer); |
||
2368 | begin |
||
2369 | FFrequency := Value; |
||
2370 | if FInitialized then |
||
2371 | GetBuffer.Frequency := Value; |
||
2372 | end; |
||
2373 | |||
2374 | procedure TWaveCollectionItem.SetLooped(Value: Boolean); |
||
2375 | begin |
||
2376 | if FLooped<>Value then |
||
2377 | begin |
||
2378 | Stop; |
||
2379 | FLooped := Value; |
||
2380 | end; |
||
2381 | end; |
||
2382 | |||
2383 | procedure TWaveCollectionItem.SetMaxPlayingCount(Value: Integer); |
||
2384 | var |
||
2385 | i: Integer; |
||
2386 | begin |
||
2387 | if Value<0 then Value := 0; |
||
2388 | |||
2389 | if FMaxPlayingCount<>Value then |
||
2390 | begin |
||
2391 | FMaxPlayingCount := Value; |
||
2392 | |||
2393 | if FInitialized then |
||
2394 | begin |
||
2395 | for i:=0 to FBufferList.Count-1 do |
||
2396 | TDirectSoundBuffer(FBufferList[i]).Free; |
||
2397 | FBufferList.Clear; |
||
2398 | end; |
||
2399 | end; |
||
2400 | end; |
||
2401 | |||
2402 | procedure TWaveCollectionItem.SetPan(Value: Integer); |
||
2403 | begin |
||
2404 | FPan := Value; |
||
2405 | if FInitialized then |
||
2406 | GetBuffer.Pan := Value; |
||
2407 | end; |
||
2408 | |||
2409 | procedure TWaveCollectionItem.SetVolume(Value: Integer); |
||
2410 | begin |
||
2411 | FVolume := Value; |
||
2412 | if FInitialized then |
||
2413 | GetBuffer.Volume := Value; |
||
2414 | end; |
||
2415 | |||
2416 | procedure TWaveCollectionItem.SetWave(Value: TWave); |
||
2417 | begin |
||
2418 | FWave.Assign(Value); |
||
2419 | end; |
||
2420 | |||
2421 | { TWaveCollection } |
||
2422 | |||
2423 | constructor TWaveCollection.Create(AOwner: TPersistent); |
||
2424 | begin |
||
2425 | inherited Create(TWaveCollectionItem); |
||
2426 | FOwner := AOwner; |
||
2427 | end; |
||
2428 | |||
2429 | function TWaveCollection.GetItem(Index: Integer): TWaveCollectionItem; |
||
2430 | begin |
||
2431 | Result := TWaveCollectionItem(inherited Items[Index]); |
||
2432 | end; |
||
2433 | |||
2434 | function TWaveCollection.GetOwner: TPersistent; |
||
2435 | begin |
||
2436 | Result := FOwner; |
||
2437 | end; |
||
2438 | |||
2439 | function TWaveCollection.Find(const Name: string): TWaveCollectionItem; |
||
2440 | var |
||
2441 | i: Integer; |
||
2442 | begin |
||
2443 | i := IndexOf(Name); |
||
2444 | if i=-1 then |
||
2445 | raise EWaveCollectionError.CreateFmt(SWaveNotFound, [Name]); |
||
2446 | Result := Items[i]; |
||
2447 | end; |
||
2448 | |||
2449 | procedure TWaveCollection.Finalize; |
||
2450 | var |
||
2451 | i: Integer; |
||
2452 | begin |
||
2453 | for i:=0 to Count-1 do |
||
2454 | Items[i].Finalize; |
||
2455 | FDXSound := nil; |
||
2456 | end; |
||
2457 | |||
2458 | procedure TWaveCollection.Initialize(DXSound: TCustomDXSound); |
||
2459 | var |
||
2460 | i: Integer; |
||
2461 | begin |
||
2462 | Finalize; |
||
2463 | FDXSound := DXSound; |
||
2464 | for i:=0 to Count-1 do |
||
2465 | Items[i].Initialize; |
||
2466 | end; |
||
2467 | |||
2468 | function TWaveCollection.Initialized: Boolean; |
||
2469 | begin |
||
2470 | Result := (FDXSound<>nil) and (FDXSound.Initialized); |
||
2471 | end; |
||
2472 | |||
2473 | procedure TWaveCollection.Restore; |
||
2474 | var |
||
2475 | i: Integer; |
||
2476 | begin |
||
2477 | for i:=0 to Count-1 do |
||
2478 | Items[i].Restore; |
||
2479 | end; |
||
2480 | |||
2481 | type |
||
2482 | TWaveCollectionComponent = class(TComponent) |
||
2483 | private |
||
2484 | FList: TWaveCollection; |
||
2485 | published |
||
2486 | property List: TWaveCollection read FList write FList; |
||
2487 | end; |
||
2488 | |||
2489 | procedure TWaveCollection.LoadFromFile(const FileName: string); |
||
2490 | var |
||
2491 | Stream: TFileStream; |
||
2492 | begin |
||
2493 | Stream := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite); |
||
2494 | try |
||
2495 | LoadFromStream(Stream); |
||
2496 | finally |
||
2497 | Stream.Free; |
||
2498 | end; |
||
2499 | end; |
||
2500 | |||
2501 | procedure TWaveCollection.LoadFromStream(Stream: TStream); |
||
2502 | var |
||
2503 | Component: TWaveCollectionComponent; |
||
2504 | begin |
||
2505 | Clear; |
||
2506 | Component := TWaveCollectionComponent.Create(nil); |
||
2507 | try |
||
2508 | Component.FList := Self; |
||
2509 | Stream.ReadComponentRes(Component); |
||
2510 | |||
2511 | if Initialized then |
||
2512 | begin |
||
2513 | Initialize(FDXSound); |
||
2514 | Restore; |
||
2515 | end; |
||
2516 | finally |
||
2517 | Component.Free; |
||
2518 | end; |
||
2519 | end; |
||
2520 | |||
2521 | procedure TWaveCollection.SaveToFile(const FileName: string); |
||
2522 | var |
||
2523 | Stream: TFileStream; |
||
2524 | begin |
||
2525 | Stream := TFileStream.Create(FileName, fmCreate); |
||
2526 | try |
||
2527 | SaveToStream(Stream); |
||
2528 | finally |
||
2529 | Stream.Free; |
||
2530 | end; |
||
2531 | end; |
||
2532 | |||
2533 | procedure TWaveCollection.SaveToStream(Stream: TStream); |
||
2534 | var |
||
2535 | Component: TWaveCollectionComponent; |
||
2536 | begin |
||
2537 | Component := TWaveCollectionComponent.Create(nil); |
||
2538 | try |
||
2539 | Component.FList := Self; |
||
2540 | Stream.WriteComponentRes('DelphiXWaveCollection', Component); |
||
2541 | finally |
||
2542 | Component.Free; |
||
2543 | end; |
||
2544 | end; |
||
2545 | |||
2546 | { TCustomDXWaveList } |
||
2547 | |||
2548 | constructor TCustomDXWaveList.Create(AOwner: TComponent); |
||
2549 | begin |
||
2550 | inherited Create(AOwner); |
||
2551 | FItems := TWaveCollection.Create(Self); |
||
2552 | end; |
||
2553 | |||
2554 | destructor TCustomDXWaveList.Destroy; |
||
2555 | begin |
||
2556 | DXSound := nil; |
||
2557 | FItems.Free; |
||
2558 | inherited Destroy; |
||
2559 | end; |
||
2560 | |||
2561 | procedure TCustomDXWaveList.Notification(AComponent: TComponent; Operation: TOperation); |
||
2562 | begin |
||
2563 | inherited Notification(AComponent, Operation); |
||
2564 | if (Operation=opRemove) and (DXSound=AComponent) then |
||
2565 | DXSound := nil; |
||
2566 | end; |
||
2567 | |||
2568 | procedure TCustomDXWaveList.DXSoundNotifyEvent(Sender: TCustomDXSound; |
||
2569 | NotifyType: TDXSoundNotifyType); |
||
2570 | begin |
||
2571 | case NotifyType of |
||
2572 | dsntDestroying: DXSound := nil; |
||
2573 | dsntInitialize: FItems.Initialize(Sender); |
||
2574 | dsntFinalize : FItems.Finalize; |
||
2575 | dsntRestore : FItems.Restore; |
||
2576 | end; |
||
2577 | end; |
||
2578 | |||
2579 | procedure TCustomDXWaveList.SetDXSound(Value: TCustomDXSound); |
||
2580 | begin |
||
2581 | if FDXSound<>nil then |
||
2582 | FDXSound.UnRegisterNotifyEvent(DXSoundNotifyEvent); |
||
2583 | |||
2584 | FDXSound := Value; |
||
2585 | |||
2586 | if FDXSound<>nil then |
||
2587 | FDXSound.RegisterNotifyEvent(DXSoundNotifyEvent); |
||
2588 | end; |
||
2589 | |||
2590 | procedure TCustomDXWaveList.SetItems(Value: TWaveCollection); |
||
2591 | begin |
||
2592 | FItems.Assign(Value); |
||
2593 | end; |
||
2594 | |||
2595 | initialization |
||
2596 | finalization |
||
2597 | DirectSoundDrivers.Free; |
||
2598 | DirectSoundCaptureDrivers.Free; |
||
2599 | end. |