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
;
34 procedure ShowSpectrum();
37 property SetResource
: String read FSetResource write FSetResource
;
41 AddSoundForm
: TAddSoundForm
;
46 BinEditor
, WADEDITOR
, e_log
, f_main
, g_language
, g_resources
47 {$IFNDEF NOSOUND}, fmod
, fmodtypes
, fmoderrors
;{$ELSE};{$ENDIF}
57 FMOD_SYSTEM
= Pointer;
58 FMOD_CHANNEL
= Pointer;
60 FMOD_CREATESOUNDEXINFO
= Pointer;
61 FMOD_RESULT
= Integer;
65 F_System
: FMOD_SYSTEM
;
66 SoundData
: Pointer = nil;
67 Sound
: FMOD_SOUND
= nil;
68 Channel
: FMOD_CHANNEL
= nil;
69 Playing
: Boolean = False;
71 procedure TAddSoundForm
.FormCreate(Sender
: TObject
);
83 res
:= FMOD_System_Create(F_System
);
84 if res
<> FMOD_OK
then
85 raise Exception
.Create('FMOD_System_Create failed!');
87 res
:= FMOD_System_GetVersion(F_System
, ver
);
88 if res
<> FMOD_OK
then
89 raise Exception
.Create('FMOD_System_GetVersion failed!');
91 if ver
< FMOD_VERSION
then
92 raise Exception
.Create('FMOD version is too old! Need '+IntToStr(FMOD_VERSION
));
94 res
:= FMOD_System_SetOutput(F_System
, FMOD_OUTPUTTYPE_WINMM
);
95 if res
<> FMOD_OK
then
96 raise Exception
.Create('FMOD_System_SetOutput failed!');
98 res
:= FMOD_System_SetSoftwareFormat(F_System
, 48000,
99 FMOD_SOUND_FORMAT_PCM16
, 0, 0, FMOD_DSP_RESAMPLER_LINEAR
);
100 if res
<> FMOD_OK
then
101 raise Exception
.Create('FMOD_System_SetSoftwareFormat failed!');
103 res
:= FMOD_System_Init(F_System
, 64, FMOD_INIT_NORMAL
, nil);
104 if res
<> FMOD_OK
then
105 raise Exception
.Create('FMOD_System_Init failed!');
108 Application
.MessageBox(FMOD_ErrorString(res
), 'Initialization', MB_OK
or MB_ICONHAND
);
113 FSpectrum
:= TMiniSpectrum
.Create(pSpectrum
);
114 FSpectrum
.Align
:= alClient
;
115 FSpectrum
.Enabled
:= True;
116 FSpectrum
.Style
:= ssBlock
;
119 function CreateSoundWAD(Resource
: String): Boolean;
121 FileName
, SectionName
, ResourceName
: String;
124 soundExInfo
: FMOD_CREATESOUNDEXINFO
;
133 g_ProcessResourceStr(Resource
, FileName
, SectionName
, ResourceName
);
134 g_ReadResource(FileName
, SectionName
, ResourceName
, SoundData
, ResLength
);
136 if SoundData
<> nil then
138 sz
:= SizeOf(FMOD_CREATESOUNDEXINFO
);
139 FillMemory(@soundExInfo
, sz
, 0);
140 soundExInfo
.cbsize
:= sz
;
141 soundExInfo
.length
:= LongWord(ResLength
);
143 res
:= FMOD_System_CreateStream(F_System
, SoundData
,
144 FMOD_LOOP_OFF
or FMOD_2D
or FMOD_OPENMEMORY
,
145 @soundExInfo
, Sound
);
147 if res
<> FMOD_OK
then
149 e_WriteLog(Format('Error creating sound %s', [Resource
]), MSG_WARNING
);
150 e_WriteLog(FMOD_ErrorString(res
), MSG_WARNING
);
156 e_WriteLog(Format('Error loading sound %s', [Resource
]), MSG_WARNING
);
157 //e_WriteLog(Format('WAD Reader error: %s', [WAD.GetLastErrorStr]), MSG_WARNING);
165 procedure TAddSoundForm
.bbPlayClick(Sender
: TObject
);
172 if FResourceSelected
then
177 if not CreateSoundWAD(FFullResourceName
) then
180 res
:= FMOD_System_PlaySound(F_System
, FMOD_CHANNEL_FREE
,
181 Sound
, False, Channel
);
182 if res
<> FMOD_OK
then
184 Application
.MessageBox(FMOD_ErrorString(res
),
185 PChar(_lc
[I_MSG_SOUND_ERROR
]),
186 MB_OK
or MB_ICONHAND
);
192 FMOD_Channel_SetVolume(Channel
, 1.0);
194 FSpectrum
.SetChannel(Channel
);
199 procedure TAddSoundForm
.ShowSpectrum
;
201 if FSpectrum
.Enabled
then
205 procedure TAddSoundForm
.TimerTimer(Sender
: TObject
);
213 FMOD_System_Update(F_System
);
217 res
:= FMOD_Channel_IsPlaying(Channel
, b
);
218 if (res
<> FMOD_OK
) or (not b
) then
223 procedure TAddSoundForm
.FormDestroy(Sender
: TObject
);
232 res
:= FMOD_System_Close(F_System
);
233 if res
<> FMOD_OK
then
235 e_WriteLog('Error closing FMOD system!', MSG_FATALERROR
);
236 e_WriteLog(FMOD_ErrorString(res
), MSG_FATALERROR
);
240 res
:= FMOD_System_Release(F_System
);
241 if res
<> FMOD_OK
then
243 e_WriteLog('Error releasing FMOD system!', MSG_FATALERROR
);
244 e_WriteLog(FMOD_ErrorString(res
), MSG_FATALERROR
);
249 procedure Sound_StopRelease();
253 if Channel
<> nil then
254 FMOD_Channel_Stop(Channel
);
257 FMOD_Sound_Release(Sound
);
259 if SoundData
<> nil then
267 procedure TAddSoundForm
.FormClose(Sender
: TObject
;
268 var Action
: TCloseAction
);
272 Timer
.Enabled
:= False;
274 FSpectrum
.SetChannel(nil);
278 procedure TAddSoundForm
.bbStopClick(Sender
: TObject
);
282 FSpectrum
.SetChannel(nil);
286 procedure TAddSoundForm
.FormActivate(Sender
: TObject
);
288 FileName
, SectionName
, ResourceName
: String;
294 Timer
.Enabled
:= True;
296 // Уже есть выбранный ресурс:
297 if FSetResource
<> '' then
299 g_ProcessResourceStr(FSetResource
, FileName
, SectionName
, ResourceName
);
301 if FileName
= '' then
302 FileName
:= _lc
[I_WAD_SPECIAL_MAP
];
304 if SectionName
= '' then
308 a
:= cbWADList
.Items
.IndexOf(FileName
);
311 cbWADList
.ItemIndex
:= a
;
312 cbWADList
.OnChange(nil);
316 a
:= cbSectionsList
.Items
.IndexOf(SectionName
);
319 cbSectionsList
.ItemIndex
:= a
;
320 cbSectionsList
.OnChange(nil);
324 a
:= lbResourcesList
.Items
.IndexOf(ResourceName
);
327 lbResourcesList
.ItemIndex
:= a
;
328 lbResourcesList
.OnClick(nil);
333 procedure TAddSoundForm
.bOKClick(Sender
: TObject
);
340 procedure TAddSoundForm
.bEmptyClick(Sender
: TObject
);