<font color="DarkGreen"><b>эта процедура задает звучание фоновой музыки</b></font>
procedure
PlayFile (
const
Filename:
string
) ;
var
FFileName:
PChar
;
begin
if
not
FileExists(FileName)
then
Exit;
FFileName:=
PChar
(Filename);
if
Channel <>
0
then
begin
BASS_ChannelStop(Channel);
BASS_StreamFree(Channel);
channel:=
0
;
end
;
Channel:=BASS_StreamCreateFile(
False
,FFileName,
0
,
0
,
0
);
BASS_ChannelPlay(Channel,
False
);
ChannelEndSync,
nil
);
if
Channel=
0
then
MessageBox(
0
,
'ошибка загрузки медиа'
,
0
,MB_OK
or
MB_ICONSTOP);
if
not
(BASS_ChannelPlay(Channel,
False
))
then
MessageBox(
0
,
'ошибка воспроизведения медиа'
,
0
,MB_OK
or
MB_ICONSTOP);
end
;
<font color="DarkGreen"><b>эта процедура создает звучание звука</b></font>
procedure
PlayFile1 (
const
Filename:
string
) ;
var
FFileName:
PChar
;
begin
if
not
FileExists(FileName)
then
Exit;
FFileName:=
PChar
(Filename);
if
Channel2 <>
0
then
begin
BASS_ChannelStop(Channel2);
BASS_StreamFree(Channel2);
channel2:=
0
;
end
;
Channel2:=BASS_StreamCreateFile(
False
,FFileName,
0
,
0
,
0
);
BASS_ChannelPlay(Channel2,
True
);
if
Channel2=
0
then
MessageBox(
0
,
'ошибка загрузки медиа'
,
0
,MB_OK
or
MB_ICONSTOP);
if
not
(BASS_ChannelPlay(Channel2,
False
))
then
MessageBox(
0
,
'ошибка воспроизведения медиа'
,
0
,MB_OK
or
MB_ICONSTOP);
end
;
<font color="DarkRed"> <b>далее идет код типа</b> </font>
case
Key
of
'q'
,
'Q'
:
begin
img1
.
picture
.
LoadFromFile(
'images/1.jpg'
);
PlayFile1(
'sounds/1.wav'
);
lbl1
.
Caption:=
'ВОРОНА'
;
end
;
'w'
,
'W'
:
begin
img1
.
picture
.
LoadFromFile(
'images/2.jpg'
);
PlayFile1(
'sounds/2.wav'
);
lbl1
.
Caption:=
'ПЕТУХ'
;
end
;
<font color="Blue">...и так далее</font>
<font color="DarkGreen"><b>здесь - события при загрузке формы</b></font>
procedure
TForm1
.
FormCreate(Sender: TObject);
var
i, b :
0..255
;
begin
form1
.
AlphaBlendValue:=
0
;
Randomize;
lst1
.
ItemIndex:=
0
;
lst1
.
Items
.
LoadFromFile(
'lst.minik'
);
lst2
.
ItemIndex:=
0
;
lst2
.
Items
.
LoadFromFile(
'animalsimg.minik'
);
windows
.
SetFocus(
1
);
ActivateKeyboardLayout(LoadKeyboardLayout(
'00000409'
,
0
),
0
);
trckbr1
.
Position:=
20
;
BASS_SetVolume(
100
);
if
not
BASS_Init(-
1
,
44100
,
0
,Handle,
nil
)
then
Halt;
BASS_ChannelSetAttributes(channel,
41400
,trckbr1
.
Position,-
101
); <font color="DarkSlateBlue"><b>для фоновой музыки громкость устанавливается из тракбара</b></font>
BASS_ChannelSetAttributes(channel2,
41400
,
100
,-
101
); <font color="DarkSlateBlue"><b>для звука громкость на максимуме</b></font>
end
;
<font color="DarkGreen"><b>здесь выбор громкости для фоновой музыки</b></font>
procedure
TForm1
.
trckbr1Change(Sender: TObject);
begin
form1
.
SetFocus;
BASS_ChannelSetAttributes(channel,
41400
,trckbr1
.
position,-
101
);
end
;
<font color="DarkGreen"><b>здесь простая визуализация - децибелы правого и левого каналов(ЗЫ. пробовал эту тему вообще удалить - проблема осталась)</b></font>
procedure
TForm1
.
tmr1Timer(Sender: TObject);
var
L,R,L1,R1:
Integer
;
level: DWORD;
begin
if
BASS_ChannelIsActive(Channel) <> BASS_active_playing
then
Exit;
level:= BASS_ChannelGetLevel(Channel);
L:=HiWord(level);
R:=HiWord(level);
pb1
.
Canvas
.
Brush
.
Color:=clRED;
pb1
.
Canvas
.
FillRect(pb1
.
Canvas
.
ClipRect);
pb2
.
Canvas
.
Brush
.
Color:=clred;
pb2
.
Canvas
.
FillRect(pb2
.
Canvas
.
ClipRect);
L1:=Round(L/(
32768
/pb1
.
Height));
R1:=Round(R/(
32768
/pb2
.
Height));
pb1
.
Canvas
.
Brush
.
Color:=clAqua;
pb2
.
Canvas
.
Brush
.
Color:=clLime;
pb1
.
Canvas
.
Rectangle(
0
,pb1
.
height-L1,pb1
.
Width,pb1
.
Height);
pb2
.
Canvas
.
Rectangle(
0
,pb2
.
height-R1,pb2
.
Width,pb2
.
Height);
end
;
<font color="DarkGreen"><b>здесь тупо добавление файла в плейлист</b></font>
procedure
TForm1
.
btn1Click(Sender: TObject);
var
v,s:
string
;
begin
if
dlgOpen1
.
Execute
then
lst1
.
additem(dlgOpen1
.
FileName,
nil
);
end
;
<font color="DarkGreen"><b>здесь событие по двойному щелчку по выбранному в плейлисте</b></font>
procedure
TForm1
.
lst1DblClick(Sender: TObject);
begin
PlayFile(lst1
.
Items
.
Strings[lst1
.
itemindex]);
BASS_ChannelPlay(Channel,
True
);
BASS_ChannelSetAttributes(channel,
41400
,trckbr1
.
position,-
101
);
end
;
<font color="DarkGreen"><b>этот таймер включает следующую песню в плейлисте, после того как закончилась предыдущая</b></font>
procedure
TForm1
.
tmr3Timer(Sender: TObject);
var
a:
Integer
;
begin
if
BASS_ChannelIsActive(Channel)=BASS_ACTIVE_STOPPED
then
begin
lst1
.
ItemIndex:=lst1
.
ItemIndex+
1
;
a:=lst1
.
Items
.
Count-
1
;
BASS_ChannelSetAttributes(channel,
41400
,trckbr1
.
position,-
101
);
PlayFile(lst1
.
Items
.
Strings[lst1
.
itemindex]);
BASS_ChannelPlay(Channel,
True
);
end
;
end
;