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

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

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

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

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

Ответ
 
Опции темы Поиск в этой теме
Старый 01.10.2018, 13:48   #1
АНАТОЛИЙ249
Пользователь
 
Регистрация: 05.02.2007
Сообщений: 91
По умолчанию BASS.DLL

Может кто поможет? Вопрос такой:
Загружаю файл в bass c синусом 1 кгц
мне нужно нарисовать синусоиду или огибающую на painbox , не могу найти ,как сделать это на bass.dll , есть примеры с WAV форматом , через звуковую карту непосредственно , а мне так не надо.

Типа этого.


Спасибо.
Изображения
Тип файла: jpg 10.jpg (49.0 Кб, 239 просмотров)
Тип файла: png Sine wave.png (1.8 Кб, 229 просмотров)

Последний раз редактировалось АНАТОЛИЙ249; 01.10.2018 в 16:22.
АНАТОЛИЙ249 вне форума Ответить с цитированием
Старый 24.10.2018, 21:23   #2
Aliens_wolfs
Форумчанин
 
Регистрация: 16.12.2009
Сообщений: 902
По умолчанию

Вот нашел у себя пример на Bass, воспроизводит выбранный муз файл и отображает в спектре, думаю не сложно переделать под вашу синусоиду, главное поймите что к чему, может это вам поможет.

Код:
  
uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, Vcl.StdCtrls, Bass;

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

  end;

//тип данных для спектра
  type
  FFTData = array[0..2048] of Single; // Массив для получения данных звука и работы с данными в спектре 
  TPeaks = array[0..128] of Integer; //Массив макс. количество полос

  var
  FData: FFTDATA;
  FPeaks: TPeaks;
  FLimit: TPeaks;

  Form1: TForm1;
  PlayChan: DWORD;

implementation

{$R *.dfm}


procedure TForm1.Timer1Timer(Sender: TObject);
var
  i, YPos, SpecHeight, ColWidth, BandCount : Integer;
begin
if PlayChan > 0 then
begin
//снимаем данные с канала в буфер для прорисовки
BASS_ChannelGetData(PlayChan, @FData, BASS_DATA_FFT2048);

  SpecHeight := PaintBoxSpectrum.Height - 2; //Высота полосы 
  ColWidth := 4; //ширина полосы спектров
  BandCount := 45; //кол-во полос спектров

  PaintBoxSpectrum.Canvas.Pen.Color := clWhite;  //цвет рамки окна спектра
  PaintBoxSpectrum.Canvas.Brush.Color := clBlack; //цвет фона окна спектра
  PaintBoxSpectrum.Canvas.Rectangle(0, 0, PaintBoxSpectrum.Width, PaintBoxSpectrum.Height); //Рисует прямоугольник.

  for i := 0 to BandCount-1 do
  begin // работаем с полученными данными
   YPos := Trunc(Abs(FData[i + 5]) * 500);
   if YPos > SpecHeight then YPos := SpecHeight;
   if YPos >= FPeaks[i] then FPeaks[i] := YPos
    else 
   FPeaks[i] := FPeaks[i] - 1;

   if YPos >= FLimit[i] then FLimit[i] := YPos - 1
    else 
     FLimit[i] := FLimit[i] - 3;

   if (PaintBoxSpectrum.Height - FPeaks[i]) > PaintBoxSpectrum.Height then
     FPeaks[i] := 0;
   if (PaintBoxSpectrum.Height - FLimit[i]) > PaintBoxSpectrum.Height then
     FLimit[i] := 0;

   // рисуем обычные пики
   PaintBoxSpectrum.Canvas.Pen.Color := clRed; //Цвет верхних точек Пиков
   PaintBoxSpectrum.Canvas.MoveTo(i * (ColWidth + 1), PaintBoxSpectrum.Height - FPeaks[i]); //Пеpемещает текущую позицию в указанную точку
   PaintBoxSpectrum.Canvas.LineTo(i * (ColWidth + 1) + ColWidth, PaintBoxSpectrum.Height - FPeaks[i]); //чертит линию от текущей позиции до

   // рисуем полосы
   PaintBoxSpectrum.Canvas.Pen.Color := clLtGray; //Цвет рамки линий Пиков
   PaintBoxSpectrum.Canvas.Brush.Color := clBlue; //Цвет заливки линий Пиков
   PaintBoxSpectrum.Canvas.Rectangle(i * (ColWidth + 1), PaintBoxSpectrum.Height - FLimit[i],
     i * (ColWidth + 1) + ColWidth, PaintBoxSpectrum.Height); //Рисует прямоугольник.
  end;
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
if opendialog1.Execute then
begin
Button2Click(nil);
PlayChan:= BASS_StreamCreateFile(false, PAnsiChar(AnsiString(opendialog1.FileName)), 0, 0, 0);
if PlayChan > 0 then
bass_channelplay(PlayChan, true);
end;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
i: integer;
begin
bass_streamfree(PlayChan);
//чистим спектр
for i := 0 to Length(FData) -1 do
FData[i]:= 0;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
if BASS_Init(-1, 44100, 0, handle, nil) then
begin
BASS_Start;
Timer1.Interval:= 10;
Timer1.Enabled:= true;
end
else
ShowMessage('Error Bass code: ' + SysErrorMessage(BASS_ErrorGetCode));
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  if PlayChan <> 0 then
  begin
    BASS_ChannelStop(PlayChan);
    Bass_StreamFree(PlayChan);
    end;
BASS_Free();
end;
Изображения
Тип файла: jpg Bass.jpg (31.4 Кб, 140 просмотров)

Последний раз редактировалось Aliens_wolfs; 24.10.2018 в 22:39.
Aliens_wolfs вне форума Ответить с цитированием
Ответ


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

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
BASS.DLL Serrg1994 Мультимедиа в Delphi 0 20.09.2011 21:38
bass.dll larry Общие вопросы C/C++ 1 09.11.2009 13:23
Ошибка при выхове функций Bass.dll из другой DLL SalasAndriy Общие вопросы Delphi 7 21.10.2009 23:36
BASS DLL ygy Мультимедиа в Delphi 4 29.09.2009 04:39
bass.dll Elem Мультимедиа в Delphi 18 19.07.2009 11:04