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
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(PChar('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;
125 FileName
, SectionName
, ResourceName
: String;
128 soundExInfo
: FMOD_CREATESOUNDEXINFO
;
137 if FSoundEnabled
= False then
141 g_ProcessResourceStr(Resource
, FileName
, SectionName
, ResourceName
);
143 WAD
:= TWADEditor_1
.Create
;
144 WAD
.ReadFile(FileName
);
146 if WAD
.GetResource(utf2win(SectionName
), utf2win(ResourceName
), SoundData
, ResLength
) then
148 sz
:= SizeOf(FMOD_CREATESOUNDEXINFO
);
149 FillMemory(@soundExInfo
, sz
, 0);
150 soundExInfo
.cbsize
:= sz
;
151 soundExInfo
.length
:= LongWord(ResLength
);
153 res
:= FMOD_System_CreateStream(F_System
, SoundData
,
154 FMOD_LOOP_OFF
or FMOD_2D
or FMOD_OPENMEMORY
,
155 @soundExInfo
, Sound
);
157 if res
<> FMOD_OK
then
159 e_WriteLog(Format('Error creating sound %s', [Resource
]), MSG_WARNING
);
160 e_WriteLog(FMOD_ErrorString(res
), MSG_WARNING
);
167 e_WriteLog(Format('Error loading sound %s', [Resource
]), MSG_WARNING
);
168 e_WriteLog(Format('WAD Reader error: %s', [WAD
.GetLastErrorStr
]), MSG_WARNING
);
178 procedure TAddSoundForm
.bbPlayClick(Sender
: TObject
);
185 if FResourceSelected
then
190 if FSoundEnabled
= False then
193 if not CreateSoundWAD(FFullResourceName
) then
197 res
:= FMOD_System_PlaySound(F_System
, FMOD_CHANNEL_FREE
,
198 Sound
, False, Channel
);
199 if res
<> FMOD_OK
then
201 Application
.MessageBox(FMOD_ErrorString(res
),
202 PChar(MsgMsgSoundError
),
203 MB_OK
or MB_ICONHAND
);
209 FMOD_Channel_SetVolume(Channel
, 1.0);
211 FSpectrum
.SetChannel(Channel
);
216 procedure TAddSoundForm
.ShowSpectrum
;
218 if FSpectrum
.Enabled
then
222 procedure TAddSoundForm
.TimerTimer(Sender
: TObject
);
230 if FSoundEnabled
= False then
234 FMOD_System_Update(F_System
);
238 res
:= FMOD_Channel_IsPlaying(Channel
, b
);
239 if (res
<> FMOD_OK
) or (not b
) then
244 procedure TAddSoundForm
.FormDestroy(Sender
: TObject
);
253 if FSoundEnabled
= False then
257 res
:= FMOD_System_Close(F_System
);
258 if res
<> FMOD_OK
then
260 e_WriteLog('Error closing FMOD system!', MSG_FATALERROR
);
261 e_WriteLog(FMOD_ErrorString(res
), MSG_FATALERROR
);
265 res
:= FMOD_System_Release(F_System
);
266 if res
<> FMOD_OK
then
268 e_WriteLog('Error releasing FMOD system!', MSG_FATALERROR
);
269 e_WriteLog(FMOD_ErrorString(res
), MSG_FATALERROR
);
274 procedure Sound_StopRelease();
278 if Channel
<> nil then
279 FMOD_Channel_Stop(Channel
);
282 FMOD_Sound_Release(Sound
);
284 if SoundData
<> nil then
292 procedure TAddSoundForm
.FormClose(Sender
: TObject
;
293 var Action
: TCloseAction
);
297 Timer
.Enabled
:= False;
299 FSpectrum
.SetChannel(nil);
303 procedure TAddSoundForm
.bbStopClick(Sender
: TObject
);
307 FSpectrum
.SetChannel(nil);
311 procedure TAddSoundForm
.FormActivate(Sender
: TObject
);
313 FileName
, SectionName
, ResourceName
: String;
319 Timer
.Enabled
:= True;
321 // Уже есть выбранный ресурс:
322 if FSetResource
<> '' then
324 g_ProcessResourceStr(FSetResource
, FileName
, SectionName
, ResourceName
);
326 if FileName
= '' then
327 FileName
:= MsgWadSpecialMap
;
329 if SectionName
= '' then
333 a
:= cbWADList
.Items
.IndexOf(FileName
);
336 cbWADList
.ItemIndex
:= a
;
337 cbWADList
.OnChange(nil);
341 a
:= cbSectionsList
.Items
.IndexOf(SectionName
);
344 cbSectionsList
.ItemIndex
:= a
;
345 cbSectionsList
.OnChange(nil);
349 a
:= lbResourcesList
.Items
.IndexOf(ResourceName
);
352 lbResourcesList
.ItemIndex
:= a
;
353 lbResourcesList
.OnClick(nil);
358 procedure TAddSoundForm
.bOKClick(Sender
: TObject
);
365 procedure TAddSoundForm
.bEmptyClick(Sender
: TObject
);