Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Мультимедиа в Delphi
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 26.01.2012, 17:09   #1
sariman
Пользователь
 
Регистрация: 06.01.2012
Сообщений: 58
По умолчанию Проблема с затуханием звука BASS

Все воспроизводится, затухание происходит, вот только музыка играет только 3 секунды, FadeTime - это время через которое звук должен возрастать до 100.
Помогите плз)
Вот код:
Код:
procedure PlayStreamSync(handle: HSYNC; Stream, data: DWORD; user: Pointer); stdcall;
begin
BASS_ChannelRemoveSync(Stream,Handle);
BASS_StreamFree(Channel);
Channel:=Buffer;
Buffer:=0;
end;

procedure TForm1.FreeStream(var Stream: HStream);
begin
  BASS_ChannelStop(Stream);
  BASS_StreamFree(Stream);
end;

procedure TForm1.PlayStream;
begin
  if Buffer=0 then Exit;
  if Channel=0 then begin
    Channel:=Buffer;
    Play;
  end else
  if BASS_ChannelIsActive(Channel)=Bass_Active_Stopped then begin
  FreeStream(Channel);
  Channel:=Buffer;
  Play;
  end else begin
  BASS_ChannelSlideAttribute(Channel,BASS_ATTRIB_VOL,0,FadeTimer);
  BASS_ChannelSetAttribute(Buffer,BASS_ATTRIB_VOL,0);
  BASS_ChannelPlay(Buffer,False);
  end;
PlaySync:=BASS_ChannelSetSync(Buffer,BASS_SYNC_SLIDE,0,@PlayStreamSync,nil);
BASS_ChannelSlideAttribute(Buffer,BASS_ATTRIB_VOL,Volume / 100,FadeTimer)
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
if bass_init(-1, 44100,0, handle,nil)=false then
showmessage('Îøèáêà');
Channel:=0;
Buffer:=0;
FadeTimer:=3000;
Volume:=100;
end;

procedure TForm1.Play;
begin
if Channel=0 then Exit;
BASS_ChannelSetAttribute(Channel,BASS_ATTRIB_VOL,0);
BASS_ChannelPlay(Channel,False);
BASS_ChannelSlideAttribute(Channel,BASS_ATTRIB_VOL,Volume / 100,FadeTimer)
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
bass_free();
end;

procedure TForm1.btn1Click(Sender: TObject);
begin
if Open.Execute=false then
exit;
LoadStream(Open.FileName);
end;

procedure TForm1.sButton1Click(Sender: TObject);
begin
LoadStream('D:\MuZa\Aksent\Aksent - Hood Boy.mp3');
PlayStream;
end;

procedure TForm1.btn3Click(Sender: TObject);
begin
bass_channelplay(Channel, false);
end;

procedure TForm1.LoadStream(FileName: string);
begin
if Buffer<>0 then Buffer:=0;
Buffer:=Bass_StreamCreateFile(False,PChar(FileName),0,0,0);
end;

procedure TForm1.sButton3Click(Sender: TObject);
begin
LoadStream('D:\MuZa\Adidas\Adidas - New Hit.mp3');
PlayStream;
end;
sariman вне форума Ответить с цитированием
Старый 26.01.2012, 20:24   #2
sariman
Пользователь
 
Регистрация: 06.01.2012
Сообщений: 58
По умолчанию

ну помогите плиииз!!!)
sariman вне форума Ответить с цитированием
Старый 28.01.2012, 18:10   #3
sariman
Пользователь
 
Регистрация: 06.01.2012
Сообщений: 58
По умолчанию

помощи не от кого не дождался, сделал сам, кому нужно, вот:
Код:
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, bass, StdCtrls, ComCtrls, sDialogs, sListBox;

type
  TForm1 = class(TForm)
    btn1: TButton;
    btn2: TButton;
    ListBox: TsListBox;
    sOpenDialog1: TsOpenDialog;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure btn1Click(Sender: TObject);
    procedure ListBoxDblClick(Sender: TObject);
  private
    { Private declarations }
  public
    procedure PlayStream;
    procedure Play;
    procedure FreeStream(var Stream: HStream);
    function  LoadStream(FileName : String) : Boolean;
  end;

var
  Form1         : TForm1;
  Channel,
  Channel2      : HSTREAM;
  Volume,
  FadeTimer     : Integer;
  PlaySync      : HSYNC;
  Dir           : String;
  Timer		: DWORD;

implementation

{$R *.dfm}

procedure PlayStreamSync(handle: HSYNC; Stream, data: DWORD; user: Pointer); stdcall;
begin
BASS_ChannelRemoveSync(Stream,Handle);
Channel:=Channel2;
Channel2:=0;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  if BASS_Init(-1, 44100, 0, Handle, NIL) = False then
    ShowMessage('Îøèáêà');
  GetDir(0, Dir);
  Channel:=0;
  FadeTimer:=3000;
  Volume:=100;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  BASS_Free;
end;

procedure TForm1.FreeStream(var Stream: HStream);
begin
  BASS_ChannelStop(Stream);
  BASS_StreamFree(Stream);
end;

procedure TForm1.PlayStream;
begin
if Channel2=0 then Exit;
  if Channel=0 then begin
    Channel:=Channel2;
    Play;
  end else
  if BASS_ChannelIsActive(Channel)=Bass_Active_Stopped then begin
  FreeStream(Channel);
  Channel:=Channel2;
  Play;
  end else begin
  BASS_ChannelSlideAttribute(Channel,BASS_ATTRIB_VOL,0,FadeTimer);
  BASS_ChannelSetAttribute(Channel2,BASS_ATTRIB_VOL,0);
  BASS_ChannelPlay(Channel2,False);
  end;
PlaySync:=BASS_ChannelSetSync(Channel2,BASS_SYNC_SLIDE,0,@PlayStreamSync,nil);
BASS_ChannelSlideAttribute(Channel2,BASS_ATTRIB_VOL,Volume / 100,FadeTimer)
end;

procedure TForm1.Play; //ôóíêöèÿ  âîñïðîèçâåäåíèÿ êàíàëà äàâíî çàãðóæåííîãî â ïàìÿòü
begin
BASS_ChannelSetAttribute(Channel,BASS_ATTRIB_VOL,0);
BASS_ChannelPlay(Channel,False);
BASS_ChannelSlideAttribute(Channel,BASS_ATTRIB_VOL,Volume / 100,FadeTimer);
end;

function TForm1.LoadStream(FileName : String) : Boolean;
var
  Time : DWORD;
begin
if Channel2<>0 then Channel2:=0;
Channel2:=Bass_StreamCreateFile(False,PChar(FileName),0,0,0);
end;

procedure TForm1.btn1Click(Sender: TObject);
begin
if sOpenDialog1.Execute then
ListBox.Items.Append(sOpenDialog1.FileName);
end;

procedure TForm1.ListBoxDblClick(Sender: TObject);
var ST:string;
begin
St := ListBox.Items[ListBox.ItemIndex];
if LoadStream(St) then
PlayStream;
end;

end.
Ошибку нашел вот здесь:
Код:
procedure PlayStreamSync(handle: HSYNC; Stream, data: DWORD; user: Pointer); stdcall;
begin
BASS_ChannelRemoveSync(Stream,Handle);
Channel:=Channel2;
Channel2:=0;
// все из-за этой строчки, я ее просто убрал, и все нормально работает
BASS_StreamFree(Channel);
end;
sariman вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
bass Запись звука со всего компьютера jhonyxakep Мультимедиа в Delphi 6 23.03.2017 11:47
Передача звука по сети с использованием UDP и BASS.DLL cactus628 Работа с сетью в Delphi 6 02.02.2012 14:11
Bass.dll -непрерывное воспроизведение звука werrey Мультимедиа в Delphi 9 13.06.2011 15:23
Требование к воспроизведению звука по нажатию клавиши клавиатуры в Bass.dll Fluffy123 Мультимедиа в Delphi 8 15.05.2010 21:48
Запись звука в BASS Gr@nd Мультимедиа в Delphi 1 18.09.2009 18:17