1 unit f_addresource_sound
;
3 {$INCLUDE ../shared/a_modes.inc}
8 LCLIntf
, LCLType
, LMessages
, SysUtils
, Variants
, Classes
,
9 Graphics
, Controls
, Forms
, Dialogs
, f_addresource
,
10 ExtCtrls
, StdCtrls
, spectrum
, Buttons
, ComCtrls
, utils
;
13 TAddSoundForm
= class (TAddResourceForm
)
20 procedure FormCreate(Sender
: TObject
);
21 procedure bbPlayClick(Sender
: TObject
);
22 procedure TimerTimer(Sender
: TObject
);
23 procedure FormDestroy(Sender
: TObject
);
24 procedure FormClose(Sender
: TObject
; var Action
: TCloseAction
);
25 procedure bbStopClick(Sender
: TObject
);
26 procedure FormActivate(Sender
: TObject
);
27 procedure bOKClick(Sender
: TObject
);
28 procedure bEmptyClick(Sender
: TObject
);
31 FSpectrum
: TMiniSpectrum
;
33 FSoundEnabled
: Boolean;
35 procedure ShowSpectrum();
36 function CreateSoundWAD(Resource
: String): Boolean;
39 property SetResource
: String read FSetResource write FSetResource
;
43 AddSoundForm
: TAddSoundForm
;
48 BinEditor
, WADEDITOR
, e_log
, f_main
, g_language
, g_resources
49 {$IFNDEF NOSOUND}, fmod
, fmodtypes
, fmoderrors
;{$ELSE};{$ENDIF}
59 FMOD_SYSTEM
= Pointer;
60 FMOD_CHANNEL
= Pointer;
62 FMOD_CREATESOUNDEXINFO
= Pointer;
63 FMOD_RESULT
= Integer;
67 F_System
: FMOD_SYSTEM
;
68 SoundData
: Pointer = nil;
69 Sound
: FMOD_SOUND
= nil;
70 Channel
: FMOD_CHANNEL
= nil;
71 Playing
: Boolean = False;
73 procedure TAddSoundForm
.FormCreate(Sender
: TObject
);
82 FSoundEnabled
:= False;
86 res
:= FMOD_System_Create(F_System
);
87 if res
<> FMOD_OK
then
88 raise Exception
.Create('FMOD_System_Create failed!');
90 res
:= FMOD_System_GetVersion(F_System
, ver
);
91 if res
<> FMOD_OK
then
92 raise Exception
.Create('FMOD_System_GetVersion failed!');
94 if ver
< FMOD_VERSION
then
95 raise Exception
.Create('FMOD version is too old! Need '+IntToStr(FMOD_VERSION
));
97 res
:= FMOD_System_SetOutput(F_System
, FMOD_OUTPUTTYPE_WINMM
);
98 if res
<> FMOD_OK
then
99 raise Exception
.Create('FMOD_System_SetOutput failed!');
101 res
:= FMOD_System_SetSoftwareFormat(F_System
, 48000,
102 FMOD_SOUND_FORMAT_PCM16
, 0, 0, FMOD_DSP_RESAMPLER_LINEAR
);
103 if res
<> FMOD_OK
then
104 raise Exception
.Create('FMOD_System_SetSoftwareFormat failed!');
106 res
:= FMOD_System_Init(F_System
, 64, FMOD_INIT_NORMAL
, nil);
107 if res
<> FMOD_OK
then
108 raise Exception
.Create('FMOD_System_Init failed!');
110 FSoundEnabled
:= True;
112 Application
.MessageBox('Sound was disabled. Reason: ' + FMOD_ErrorString(res
), 'FMOD Error', MB_OK
or MB_ICONWARNING
);
116 FSpectrum
:= TMiniSpectrum
.Create(pSpectrum
);
117 FSpectrum
.Align
:= alClient
;
118 FSpectrum
.Enabled
:= True;
119 FSpectrum
.Style
:= ssBlock
;
122 function TAddSoundForm
.CreateSoundWAD(Resource
: String): Boolean;
124 FileName
, SectionName
, ResourceName
: String;
127 soundExInfo
: FMOD_CREATESOUNDEXINFO
;
136 if FSoundEnabled
= False then
140 g_ProcessResourceStr(Resource
, FileName
, SectionName
, ResourceName
);
141 g_ReadResource(FileName
, SectionName
, ResourceName
, SoundData
, ResLength
);
143 if SoundData
<> nil then
145 sz
:= SizeOf(FMOD_CREATESOUNDEXINFO
);
146 FillMemory(@soundExInfo
, sz
, 0);
147 soundExInfo
.cbsize
:= sz
;
148 soundExInfo
.length
:= LongWord(ResLength
);
150 res
:= FMOD_System_CreateStream(F_System
, SoundData
,
151 FMOD_LOOP_OFF
or FMOD_2D
or FMOD_OPENMEMORY
,
152 @soundExInfo
, Sound
);
154 if res
<> FMOD_OK
then
156 e_WriteLog(Format('Error creating sound %s', [Resource
]), MSG_WARNING
);
157 e_WriteLog(FMOD_ErrorString(res
), MSG_WARNING
);
163 e_WriteLog(Format('Error loading sound %s', [Resource
]), MSG_WARNING
);
164 //e_WriteLog(Format('WAD Reader error: %s', [WAD.GetLastErrorStr]), MSG_WARNING);
172 procedure TAddSoundForm
.bbPlayClick(Sender
: TObject
);
179 if FResourceSelected
then
184 if FSoundEnabled
= False then
187 if not CreateSoundWAD(FFullResourceName
) then
191 res
:= FMOD_System_PlaySound(F_System
, FMOD_CHANNEL_FREE
,
192 Sound
, False, Channel
);
193 if res
<> FMOD_OK
then
195 Application
.MessageBox(FMOD_ErrorString(res
),
196 PChar(MsgMsgSoundError
),
197 MB_OK
or MB_ICONHAND
);
203 FMOD_Channel_SetVolume(Channel
, 1.0);
205 FSpectrum
.SetChannel(Channel
);
210 procedure TAddSoundForm
.ShowSpectrum
;
212 if FSpectrum
.Enabled
then
216 procedure TAddSoundForm
.TimerTimer(Sender
: TObject
);
224 if FSoundEnabled
= False then
228 FMOD_System_Update(F_System
);
232 res
:= FMOD_Channel_IsPlaying(Channel
, b
);
233 if (res
<> FMOD_OK
) or (not b
) then
238 procedure TAddSoundForm
.FormDestroy(Sender
: TObject
);
247 if FSoundEnabled
= False then
251 res
:= FMOD_System_Close(F_System
);
252 if res
<> FMOD_OK
then
254 e_WriteLog('Error closing FMOD system!', MSG_FATALERROR
);
255 e_WriteLog(FMOD_ErrorString(res
), MSG_FATALERROR
);
259 res
:= FMOD_System_Release(F_System
);
260 if res
<> FMOD_OK
then
262 e_WriteLog('Error releasing FMOD system!', MSG_FATALERROR
);
263 e_WriteLog(FMOD_ErrorString(res
), MSG_FATALERROR
);
268 procedure Sound_StopRelease();
272 if Channel
<> nil then
273 FMOD_Channel_Stop(Channel
);
276 FMOD_Sound_Release(Sound
);
278 if SoundData
<> nil then
286 procedure TAddSoundForm
.FormClose(Sender
: TObject
;
287 var Action
: TCloseAction
);
291 Timer
.Enabled
:= False;
293 FSpectrum
.SetChannel(nil);
297 procedure TAddSoundForm
.bbStopClick(Sender
: TObject
);
301 FSpectrum
.SetChannel(nil);
305 procedure TAddSoundForm
.FormActivate(Sender
: TObject
);
307 FileName
, SectionName
, ResourceName
: String;
313 Timer
.Enabled
:= True;
315 // Уже есть выбранный ресурс:
316 if FSetResource
<> '' then
318 g_ProcessResourceStr(FSetResource
, FileName
, SectionName
, ResourceName
);
320 if FileName
= '' then
321 FileName
:= MsgWadSpecialMap
;
323 if SectionName
= '' then
327 a
:= cbWADList
.Items
.IndexOf(FileName
);
330 cbWADList
.ItemIndex
:= a
;
331 cbWADList
.OnChange(nil);
335 a
:= cbSectionsList
.Items
.IndexOf(SectionName
);
338 cbSectionsList
.ItemIndex
:= a
;
339 cbSectionsList
.OnChange(nil);
343 a
:= lbResourcesList
.Items
.IndexOf(ResourceName
);
346 lbResourcesList
.ItemIndex
:= a
;
347 lbResourcesList
.OnClick(nil);
352 procedure TAddSoundForm
.bOKClick(Sender
: TObject
);
359 procedure TAddSoundForm
.bEmptyClick(Sender
: TObject
);