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;
108 ResLength
, sz
: Integer;
109 soundExInfo
: FMOD_CREATESOUNDEXINFO
;
119 g_ProcessResourceStr(Resource
, FileName
, SectionName
, ResourceName
);
121 WAD
:= TWADEditor_1
.Create
;
122 WAD
.ReadFile(FileName
);
124 if WAD
.GetResource(SectionName
, ResourceName
, SoundData
, ResLength
) then
126 sz
:= SizeOf(FMOD_CREATESOUNDEXINFO
);
127 FillMemory(@soundExInfo
, sz
, 0);
128 soundExInfo
.cbsize
:= sz
;
129 soundExInfo
.length
:= ResLength
;
131 res
:= FMOD_System_CreateStream(F_System
, SoundData
,
132 FMOD_LOOP_OFF
+ FMOD_2D
+ FMOD_SOFTWARE
+ FMOD_OPENMEMORY
,
133 @soundExInfo
, Sound
);
135 if res
<> FMOD_OK
then
137 e_WriteLog(Format('Error creating sound %s', [Resource
]), MSG_WARNING
);
138 e_WriteLog(FMOD_ErrorString(res
), MSG_WARNING
);
145 e_WriteLog(Format('Error loading sound %s', [Resource
]), MSG_WARNING
);
146 e_WriteLog(Format('WAD Reader error: %s', [WAD
.GetLastErrorStr
]), MSG_WARNING
);
155 procedure TAddSoundForm
.bbPlayClick(Sender
: TObject
);
162 if FResourceSelected
then
167 if not CreateSoundWAD(FFullResourceName
) then
170 res
:= FMOD_System_PlaySound(F_System
, FMOD_CHANNEL_FREE
,
171 Sound
, False, Channel
);
172 if res
<> FMOD_OK
then
174 Application
.MessageBox(FMOD_ErrorString(res
),
175 PChar(_lc
[I_MSG_SOUND_ERROR
]),
176 MB_OK
or MB_ICONHAND
);
182 FMOD_Channel_SetVolume(Channel
, 1.0);
184 FSpectrum
.SetChannel(Channel
);
188 procedure TAddSoundForm
.ShowSpectrum
;
190 if FSpectrum
.Enabled
then
194 procedure TAddSoundForm
.TimerTimer(Sender
: TObject
);
202 FMOD_System_Update(F_System
);
206 res
:= FMOD_Channel_IsPlaying(Channel
, b
);
207 if (res
<> FMOD_OK
) or (not b
) then
211 procedure TAddSoundForm
.FormDestroy(Sender
: TObject
);
220 res
:= FMOD_System_Close(F_System
);
221 if res
<> FMOD_OK
then
223 e_WriteLog('Error closing FMOD system!', MSG_FATALERROR
);
224 e_WriteLog(FMOD_ErrorString(res
), MSG_FATALERROR
);
228 res
:= FMOD_System_Release(F_System
);
229 if res
<> FMOD_OK
then
231 e_WriteLog('Error releasing FMOD system!', MSG_FATALERROR
);
232 e_WriteLog(FMOD_ErrorString(res
), MSG_FATALERROR
);
236 procedure Sound_StopRelease();
240 if Channel
<> nil then
241 FMOD_Channel_Stop(Channel
);
244 FMOD_Sound_Release(Sound
);
246 if SoundData
<> nil then
254 procedure TAddSoundForm
.FormClose(Sender
: TObject
;
255 var Action
: TCloseAction
);
259 Timer
.Enabled
:= False;
261 FSpectrum
.SetChannel(nil);
265 procedure TAddSoundForm
.bbStopClick(Sender
: TObject
);
269 FSpectrum
.SetChannel(nil);
273 procedure TAddSoundForm
.FormActivate(Sender
: TObject
);
275 FileName
, SectionName
, ResourceName
: String;
281 Timer
.Enabled
:= True;
283 // Уже есть выбранный ресурс:
284 if FSetResource
<> '' then
286 g_ProcessResourceStr(FSetResource
, FileName
, SectionName
, ResourceName
);
288 if FileName
= '' then
289 FileName
:= _lc
[I_WAD_SPECIAL_MAP
];
291 if SectionName
= '' then
295 a
:= cbWADList
.Items
.IndexOf(FileName
);
298 cbWADList
.ItemIndex
:= a
;
299 cbWADList
.OnChange(nil);
303 a
:= cbSectionsList
.Items
.IndexOf(SectionName
);
306 cbSectionsList
.ItemIndex
:= a
;
307 cbSectionsList
.OnChange(nil);
311 a
:= lbResourcesList
.Items
.IndexOf(ResourceName
);
314 lbResourcesList
.ItemIndex
:= a
;
315 lbResourcesList
.OnClick(nil);
320 procedure TAddSoundForm
.bOKClick(Sender
: TObject
);
327 procedure TAddSoundForm
.bEmptyClick(Sender
: TObject
);