эта процедура задает звучание фоновой музыки
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;
эта процедура создает звучание звука
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;
далее идет код типа
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;
...и так далее
здесь - события при загрузке формы
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); для фоновой музыки громкость устанавливается из тракбара
BASS_ChannelSetAttributes(channel2,41400,100,-101); для звука громкость на максимуме
end;
здесь выбор громкости для фоновой музыки
procedure TForm1.trckbr1Change(Sender: TObject);
begin
form1.SetFocus;
BASS_ChannelSetAttributes(channel,41400,trckbr1.position,-101);
end;
здесь простая визуализация - децибелы правого и левого каналов(ЗЫ. пробовал эту тему вообще удалить - проблема осталась)
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;
здесь тупо добавление файла в плейлист
procedure TForm1.btn1Click(Sender: TObject);
var v,s: string;
begin
if dlgOpen1.Execute then lst1.additem(dlgOpen1.FileName,nil);
end;
здесь событие по двойному щелчку по выбранному в плейлисте
procedure TForm1.lst1DblClick(Sender: TObject);
begin
PlayFile(lst1.Items.Strings[lst1.itemindex]);
BASS_ChannelPlay(Channel,True);
BASS_ChannelSetAttributes(channel,41400,trckbr1.position,-101);
end;
этот таймер включает следующую песню в плейлисте, после того как закончилась предыдущая
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;