VPF::Визуализация с ипользованием bass.dll

Ahmund

Дата 18.10.2011, 13:30 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 23
Регистрация: 18.10.2011

Репутация: нет
Всего: нет

Доброго времени суток!
При создании плеера для прослушивание онлайн радио, современем оживить както плеер захотелось сделать визуализацию воспроизводящией звуковой волны.
Нужен простой код с разниснением, чтоб запустит его, потестировать, разобратся в работе.
Поиск в нете привел на много разных кодов, в которых ничего не понятно было, плюс они все не работи ругались что на кто.
Вот пример простого кода визуализации на bass.dll библеотеки который удалось найти. Вроде пару строчек и ничего сложного но не работает.

Код


unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs,bass,spectrum_vis,CommonTypes, StdCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    OpenDialog1: TOpenDialog;
    Timer1: TTimer;
    PaintBox1: TPaintBox;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  channel:HSTREAM;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
   BASS_Init(-1,44100,0,Handle,0);
   OpenDialog1.Filter:='mp3|*.mp3';
   Spectrum:=TSpectrum.Create(PaintBox1.Width,PaintBox1.Height);
   Spectrum.Mode:=1;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
   if OpenDialog1.Execute then
    BASS_StreamFree(channel);
    channel:=BASS_StreamCreateFile(false,Pchar(OpenDialog1.FileName),0,0,0);
    if channel<>0 then
    BASS_ChannelPlay(channel,False);
    Timer1.Enabled:=True;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
   FFData:TFFTData;
begin
   BASS_ChannelGetData(channel,@FFdata,BASS_DATA_FFT1024);
   Spectrum.Draw(PaintBox1.Canvas.Handle,FFData,1,1);
end;

end.

Появляется ошибка 'access violation at 0x000311c9: write of address 0x10c00000'Pcoess Stoped. Use Step or Run to continue и приложение дальше не работает!
При уберании процедуры:

Код


procedure TForm1.Timer1Timer(Sender: TObject);
var
   FFData:TFFTData;
begin
   BASS_ChannelGetData(channel,@FFdata,BASS_DATA_FFT1024);
   Spectrum.Draw(PaintBox1.Canvas.Handle,FFData,1,1);
end;

Приложение запускается и работает но визуализации нет.
Кто что может подсказать по этому поводу? Может ктото реализововал подобное? сталкивался с такими проблемами?
Или мжет посоветуете рабочии коды с правильной установкой и запуском их, буду очь блогадарен

Alexeis

Дата 19.10.2011, 08:46 (ссылка)

(нет голосов)

Загрузка ...

Амеба

Профиль
Группа: Админ
Сообщений: 11743
Регистрация: 12.10.2005
Где: Зеленоград

Репутация: 55
Всего: 459

Вместо

Код


    if channel<>0 then
    BASS_ChannelPlay(channel,False);
    Timer1.Enabled:=True;

Думаю нужно

Код


    if channel<>0 then
    begin
      BASS_ChannelPlay(channel,False);
      Timer1.Enabled:=True;
    end;

--------------------

Vit вечная память.

Обсуждение действий администрации форума производятся только в этом форуме

гениальность идеи состоит в том, что ее невозможно придумать

Ahmund

Дата 19.10.2011, 13:21 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 23
Регистрация: 18.10.2011

Репутация: нет
Всего: нет

Это ничего не меняет, все тажа ошибка. Всзял сделал все на новом проекте, уже при запуске высвечивается ошибка Invalid floating operation и програма завершает работу.
уже разбирал тот код как мог, непойму никак почему те ошибки вылитают. Мож ктота делал анализатор в прогресбаре, подскажите как это сделать???

jhonyxakep

Дата 19.10.2011, 13:51 (ссылка)

(нет голосов)

Загрузка ...

Divide Et Impera

Профиль
Группа: Участник
Сообщений: 983
Регистрация: 7.4.2009
Где: Что, Когда?

Репутация: нет
Всего: 8

Цитата(Ahmund @ 19.10.2011, 13:21

)

Invalid floating operation

У меня была такая трабла, решилась с помощью

Код


try 
   BASS_ChannelGetData(channel,@FFdata,BASS_DATA_FFT1024);
   Spectrum.Draw(PaintBox1.Canvas.Handle,FFData,1,1);
except 
end;

Еще совет: Использовать промежуточный визуальный буфер. Сейчас покажу:

в Var перед implementation пишешь VisBuff : TBitmap;

в FormCreate

Код



 VisBuff := TBitmap.Create;
 VisBuff.Width := PaintBox1.Width;
 VisBuff.Height := PaintBox1.Height;

вместо

Код


Spectrum.Draw(PaintBox1.Canvas.Handle,FFData,1,1);

Код


Spectrum.Draw(VisBuff.canvas.Handle,FFData,1,1);
 BitBlt(PaintBox1.Canvas.handle,0, 0,PaintBox1.Width,PaintBox1.Height,VisBuff.Canvas.Handle,0, 0,SrcCopy);

После этого ты избавишься еще от неприятных мерцаний.

Это сообщение отредактировал(а) jhonyxakep - 19.10.2011, 14:17

Ahmund

Дата 19.10.2011, 14:35 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 23
Регистрация: 18.10.2011

Репутация: нет
Всего: нет

Пробывал через try except , вылазит первая ошибка что я в первом посте писал.
Если несложно скинь свой рабочий пример, а то сколько перепробывал примеров всяких не один не работает. Буду благодарен

jhonyxakep

Дата 21.10.2011, 14:02 (ссылка)

(нет голосов)

Загрузка ...

Divide Et Impera

Профиль
Группа: Участник
Сообщений: 983
Регистрация: 7.4.2009
Где: Что, Когда?

Репутация: нет
Всего: 8

У меня в коде именно так и написано:

Код



procedure TForm14.tmr1Timer(Sender: TObject);
var
  FFTFata : TFFTData;
  begin
 try

    BASS_ChannelGetData(Form1.main, @FFTFata, BASS_DATA_FFT1024);
    Spectrum.Draw(VisBuff.canvas.Handle,FFTFata,1,1);
    BitBlt(pb1.Canvas.handle,0, 0,pb1.Width,pb1.Height,VisBuff.Canvas.Handle,0, 0,SrcCopy);

 except
   end;
end;

Вот весь код, сорри, что грязноват, но писал для себя, м править в будущем не собирался:

Код



unit MixerSpectruma;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls,bass,CommonTypes, StdCtrls, ComCtrls,spectrum_vis, JvPaintFX;

type
  TForm14 = class(TForm)
    pb1: TPaintBox;
    tmr1: TTimer;
    btn1: TButton;
    trckbr1: TTrackBar;
    trckbr2: TTrackBar;
    procedure FormCreate(Sender: TObject);
    procedure tmr1Timer(Sender: TObject);
    procedure trckbr2Change(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure Blur;
    procedure btn2Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormHide(Sender: TObject);
    procedure btn1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form14: TForm14;
 Spectrum : TSpectrum;
 VisBuff : TBitmap;

implementation
  uses Unit1;
{$R *.dfm}


{procedure TForm14.Blur;
const
  width = 100;
  height = 60;
  d = 2;
var
  x, y: integer;
  i, j: integer;
  c: integer;
  Pix: array [0..width-1, 0..height-1] of byte;
begin
  randomize;
  with pb1.Canvas do
  begin
 for y := 0 to height - 1 do
      for x := 0 to width - 1 do
        Pix[x,y] := GetRValue(Pixels[x,y]);
    for y := d to height - d - 1 do
    begin
      for x := d to width - d - 1 do
      begin
        c := 0;
        for i := -d to d do
          for j := -d to d do
            c := c + Pix[x+i,y+j];
        c := round(c / sqr(2 * d + 1));
        Pixels[x,y] := RGB(c, c, c);
      end;
      //Application.ProcessMessages;
    end;
  end;
end;  }

procedure TForm14.FormCreate(Sender: TObject);
begin
Spectrum:= TSpectrum.Create(pb1.Width, pb1.Height);
Spectrum.Pen:=clGreen;
Spectrum.Peak:=clYellow;
Spectrum.Mode:=1;
Spectrum.LineFallOff := 3;
 VisBuff := TBitmap.Create;
 VisBuff.Width := pb1.Width;
 VisBuff.Height := pb1.Height;


end;

procedure TForm14.tmr1Timer(Sender: TObject);
var
  FFTFata : TFFTData;
  begin
 try

    BASS_ChannelGetData(Form1.main, @FFTFata, BASS_DATA_FFT1024);
    Spectrum.Draw(VisBuff.canvas.Handle,FFTFata,1,1);
    BitBlt(pb1.Canvas.handle,0, 0,pb1.Width,pb1.Height,VisBuff.Canvas.Handle,0, 0,SrcCopy);

 except
   end;
end;



procedure TForm14.trckbr2Change(Sender: TObject);
begin

end;

procedure TForm14.FormResize(Sender: TObject);
begin
Spectrum.Free;
 VisBuff.Free;
FormCreate(self);
end;

procedure TForm14.btn2Click(Sender: TObject);
begin
tmr1.Enabled := false;
tmr1Timer(self);
end;

procedure TForm14.FormShow(Sender: TObject);
begin
tmr1.Enabled := True;
end;

procedure TForm14.FormHide(Sender: TObject);
begin
tmr1.Enabled := False;
end;

procedure TForm14.btn1Click(Sender: TObject);
begin
hide;
end;

end.

Еще совет: таймер не меньше 10 мсек.

На всякий случай
CommonTypes

Код


unit CommonTypes;
{ CommonTypes by Alessandro Cappellozza
  version 0.8 02/2002
  http://digilander.Libero.it/Kappe/audioobject
}

interface
 uses Windows, Dialogs, Forms, Controls, StdCtrls, Classes, ExtCtrls, SysUtils;

  Type TWaveData = array [ 0..2048] of DWORD;
  Type TFFTData  = array [0..512] of Single;

implementation

end.

и визуализатор:

Код



unit spectrum_vis;
{ Spectrum Visualyzation by Alessandro Cappellozza
  version 0.8 05/2002
  http://digilander.iol.it/Kappe/audioobject
}

interface
  uses Windows, Dialogs, Graphics, SysUtils, CommonTypes, Classes;

 type TSpectrum = Class(TObject)
    private
      VisBuff : TBitmap;
      BackBmp : TBitmap;

      BkgColor : TColor;
      SpecHeight : Integer;
      PenColor : TColor;
      PeakColor: TColor;
      DrawType : Integer;
      DrawRes  : Integer;
      FrmClear : Boolean;
      UseBkg   : Boolean;
      PeakFall : Integer;
      LineFall : Integer;
      ColWidth : Integer;
      ShowPeak : Boolean;

       FFTPeacks  : array [0..128] of Integer;
       FFTFallOff : array [0..128] of Integer;

    public
     Constructor Create (Width, Height : Integer);
     procedure Draw(HWND : THandle; FFTData : TFFTData; X, Y : Integer);
     procedure SetBackGround (Active : Boolean; BkgCanvas : TGraphic);

     property BackColor : TColor read BkgColor write BkgColor;
     property Height : Integer read SpecHeight write SpecHeight;
     property Width  : Integer read ColWidth write ColWidth;
     property Pen  : TColor read PenColor write PenColor;
     property Peak : TColor read PeakColor write PeakColor;
     property Mode : Integer read DrawType write DrawType;
     property Res  : Integer read DrawRes write DrawRes;
     property FrameClear : Boolean read FrmClear write FrmClear;
     property PeakFallOff: Integer read PeakFall write PeakFall;
     property LineFallOff: Integer read LineFall write LineFall;
     property DrawPeak   : Boolean read ShowPeak write ShowPeak;
  end;

 var Spectrum : TSpectrum;

implementation

     Constructor TSpectrum.Create(Width, Height : Integer);
      begin
        VisBuff := TBitmap.Create;
        BackBmp := TBitmap.Create;

          VisBuff.Width := Width;
          VisBuff.Height := Height;
          BackBmp.Width := Width;
          BackBmp.Height := Height;

          BkgColor := clBlack;
          SpecHeight := 100;
          PenColor := clWhite;
          PeakColor := clYellow;
          DrawType := 0;
          DrawRes  := 1;
          FrmClear := True;
          UseBkg := False;
          PeakFall := 1;
          LineFall := 3;
          ColWidth := 5;
          ShowPeak := True; 
      end;

     procedure TSpectrum.SetBackGround (Active : Boolean; BkgCanvas : TGraphic);
      begin
        UseBkg := Active;
        BackBmp.Canvas.Draw(0, 0, BkgCanvas);
      end;

     procedure TSpectrum.Draw(HWND : THandle; FFTData : TFFTData; X, Y : Integer);
        var i, YPos : LongInt; YVal : Single;
       begin

       if FrmClear then begin
          VisBuff.Canvas.Pen.Color := BkgColor;
          VisBuff.Canvas.Brush.Color := BkgColor;
          VisBuff.Canvas.Rectangle(0, 0, VisBuff.Width, VisBuff.Height);
           if UseBkg then VisBuff.Canvas.CopyRect(Rect(0, 0, BackBmp.Width, BackBmp.Height), BackBmp.Canvas, Rect(0, 0, BackBmp.Width, BackBmp.Height));
       end;

        VisBuff.Canvas.Pen.Color := PenColor;
         for i := 0 to 128 do begin
           YVal := Abs(FFTData[(i * DrawRes) + 5]);
           YPos := Trunc((YVal) * 500);
           if YPos > Height then YPos := SpecHeight;

           if YPos >= FFTPeacks[i] then FFTPeacks[i] := YPos
              else FFTPeacks[i] := FFTPeacks[i] - PeakFall;

           if YPos >= FFTFallOff[i] then FFTFallOff[i] := YPos
              else FFTFallOff[i] := FFTFallOff[i] - LineFall;

              if (VisBuff.Height - FFTPeacks[i]) > VisBuff.Height then FFTPeacks[i] := 0;
              if (VisBuff.Height - FFTFallOff[i]) > VisBuff.Height then FFTFallOff[i] := 0;

              case DrawType of
                0 : begin
                       VisBuff.Canvas.MoveTo(X + i, Y + VisBuff.Height);
                       VisBuff.Canvas.LineTo(X + i, Y + VisBuff.Height - FFTFallOff[i]);
                       if ShowPeak then VisBuff.Canvas.Pixels[X + i, Y + VisBuff.Height - FFTPeacks[i]] := Pen;
                    end;

                1 : begin
                     if ShowPeak then VisBuff.Canvas.Pen.Color := PeakColor;
                     if ShowPeak then VisBuff.Canvas.MoveTo(X + i * (ColWidth + 1), Y + VisBuff.Height - FFTPeacks[i]);
                     if ShowPeak then VisBuff.Canvas.LineTo(X + i * (ColWidth + 1) + ColWidth, Y + VisBuff.Height - FFTPeacks[i]);

                     VisBuff.Canvas.Pen.Color := PenColor;
                     VisBuff.Canvas.Brush.Color := PenColor;
                     VisBuff.Canvas.Rectangle(X + i * (ColWidth + 1), Y + VisBuff.Height - FFTFallOff[i], X + i * (ColWidth + 1) + ColWidth, Y + VisBuff.Height);
                    end;
              end;
         end;

          BitBlt(HWND, 0, 0, VisBuff.Width, VisBuff.Height, VisBuff.Canvas.Handle, 0, 0, srccopy)
       end;
end.

Просто помню, что правил какие-то юниты, но не помню точно - какие smile

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: Звук, графика и видео \| Следующая тема »