1 unit f_addresource_sound
;
8 LCLIntf
, LCLType
, LMessages
, SysUtils
, Variants
, Classes
,
9 Graphics
, Controls
, Forms
, Dialogs
, f_addresource
,
10 ExtCtrls
, StdCtrls
, spectrum
, Buttons
, ComCtrls
;
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
, fmod
, fmodtypes
, fmoderrors
, WADEDITOR
, e_log
, f_main
,
52 F_System
: FMOD_SYSTEM
;
53 SoundData
: Pointer = nil;
54 Sound
: FMOD_SOUND
= nil;
55 Channel
: FMOD_CHANNEL
= nil;
56 Playing
: Boolean = False;
58 procedure TAddSoundForm
.FormCreate(Sender
: TObject
);
69 res
:= FMOD_System_Create(F_System
);
70 if res
<> FMOD_OK
then
71 raise Exception
.Create('FMOD_System_Create failed!');
73 res
:= FMOD_System_GetVersion(F_System
, ver
);
74 if res
<> FMOD_OK
then
75 raise Exception
.Create('FMOD_System_GetVersion failed!');
77 if ver
< FMOD_VERSION
then
78 raise Exception
.Create('FMOD version is too old! Need '+IntToStr(FMOD_VERSION
));
80 res
:= FMOD_System_SetOutput(F_System
, FMOD_OUTPUTTYPE_WINMM
);
81 if res
<> FMOD_OK
then
82 raise Exception
.Create('FMOD_System_SetOutput failed!');
84 res
:= FMOD_System_SetSoftwareFormat(F_System
, 48000,
85 FMOD_SOUND_FORMAT_PCM16
, 0, 0, FMOD_DSP_RESAMPLER_LINEAR
);
86 if res
<> FMOD_OK
then
87 raise Exception
.Create('FMOD_System_SetSoftwareFormat failed!');
89 res
:= FMOD_System_Init(F_System
, 64, FMOD_INIT_NORMAL
, nil);
90 if res
<> FMOD_OK
then
91 raise Exception
.Create('FMOD_System_Init failed!');
94 Application
.MessageBox(FMOD_ErrorString(res
), 'Initialization', MB_OK
or MB_ICONHAND
);
98 FSpectrum
:= TMiniSpectrum
.Create(pSpectrum
);
99 FSpectrum
.Align
:= alClient
;
100 FSpectrum
.Enabled
:= True;
101 FSpectrum
.Style
:= ssBlock
;
104 function CreateSoundWAD(Resource
: String): Boolean;
107 FileName
, SectionName
, ResourceName
: String;
110 soundExInfo
: FMOD_CREATESOUNDEXINFO
;
120 g_ProcessResourceStr(Resource
, FileName
, SectionName
, ResourceName
);
122 WAD
:= TWADEditor_1
.Create
;
123 WAD
.ReadFile(FileName
);
125 if WAD
.GetResource(SectionName
, ResourceName
, SoundData
, ResLength
) then
127 sz
:= SizeOf(FMOD_CREATESOUNDEXINFO
);
128 FillMemory(@soundExInfo
, sz
, 0);
129 soundExInfo
.cbsize
:= sz
;
130 soundExInfo
.length
:= LongWord(ResLength
);
132 res
:= FMOD_System_CreateStream(F_System
, SoundData
,
133 FMOD_LOOP_OFF
or FMOD_2D
or FMOD_OPENMEMORY
,
134 @soundExInfo
, Sound
);
136 if res
<> FMOD_OK
then
138 e_WriteLog(Format('Error creating sound %s', [Resource
]), MSG_WARNING
);
139 e_WriteLog(FMOD_ErrorString(res
), MSG_WARNING
);
146 e_WriteLog(Format('Error loading sound %s', [Resource
]), MSG_WARNING
);
147 e_WriteLog(Format('WAD Reader error: %s', [WAD
.GetLastErrorStr
]), MSG_WARNING
);
156 procedure TAddSoundForm
.bbPlayClick(Sender
: TObject
);
163 if FResourceSelected
then
168 if not CreateSoundWAD(FFullResourceName
) then
171 res
:= FMOD_System_PlaySound(F_System
, FMOD_CHANNEL_FREE
,
172 Sound
, False, Channel
);
173 if res
<> FMOD_OK
then
175 Application
.MessageBox(FMOD_ErrorString(res
),
176 PChar(_lc
[I_MSG_SOUND_ERROR
]),
177 MB_OK
or MB_ICONHAND
);
183 FMOD_Channel_SetVolume(Channel
, 1.0);
185 FSpectrum
.SetChannel(Channel
);
189 procedure TAddSoundForm
.ShowSpectrum
;
191 if FSpectrum
.Enabled
then
195 procedure TAddSoundForm
.TimerTimer(Sender
: TObject
);
203 FMOD_System_Update(F_System
);
207 res
:= FMOD_Channel_IsPlaying(Channel
, b
);
208 if (res
<> FMOD_OK
) or (not b
) then
212 procedure TAddSoundForm
.FormDestroy(Sender
: TObject
);
221 res
:= FMOD_System_Close(F_System
);
222 if res
<> FMOD_OK
then
224 e_WriteLog('Error closing FMOD system!', MSG_FATALERROR
);
225 e_WriteLog(FMOD_ErrorString(res
), MSG_FATALERROR
);
229 res
:= FMOD_System_Release(F_System
);
230 if res
<> FMOD_OK
then
232 e_WriteLog('Error releasing FMOD system!', MSG_FATALERROR
);
233 e_WriteLog(FMOD_ErrorString(res
), MSG_FATALERROR
);
237 procedure Sound_StopRelease();
241 if Channel
<> nil then
242 FMOD_Channel_Stop(Channel
);
245 FMOD_Sound_Release(Sound
);
247 if SoundData
<> nil then
255 procedure TAddSoundForm
.FormClose(Sender
: TObject
;
256 var Action
: TCloseAction
);
260 Timer
.Enabled
:= False;
262 FSpectrum
.SetChannel(nil);
266 procedure TAddSoundForm
.bbStopClick(Sender
: TObject
);
270 FSpectrum
.SetChannel(nil);
274 procedure TAddSoundForm
.FormActivate(Sender
: TObject
);
276 FileName
, SectionName
, ResourceName
: String;
282 Timer
.Enabled
:= True;
284 // Уже есть выбранный ресурс:
285 if FSetResource
<> '' then
287 g_ProcessResourceStr(FSetResource
, FileName
, SectionName
, ResourceName
);
289 if FileName
= '' then
290 FileName
:= _lc
[I_WAD_SPECIAL_MAP
];
292 if SectionName
= '' then
296 a
:= cbWADList
.Items
.IndexOf(FileName
);
299 cbWADList
.ItemIndex
:= a
;
300 cbWADList
.OnChange(nil);
304 a
:= cbSectionsList
.Items
.IndexOf(SectionName
);
307 cbSectionsList
.ItemIndex
:= a
;
308 cbSectionsList
.OnChange(nil);
312 a
:= lbResourcesList
.Items
.IndexOf(ResourceName
);
315 lbResourcesList
.ItemIndex
:= a
;
316 lbResourcesList
.OnClick(nil);
321 procedure TAddSoundForm
.bOKClick(Sender
: TObject
);
328 procedure TAddSoundForm
.bEmptyClick(Sender
: TObject
);