Форум программистов
 
Контакты: о проблемах с регистрацией, почтой и по другим вопросам пишите сюда - alarforum@yandex.ru, проверяйте папку спам! Обязательно пройдите активизацию e-mail.
Внимание! Некоторое время письма не доходят до аккаунтов MAIL RU GROUP, не доходят на все почтовые ящики mail.ru, inbox.ru, bk.ru. Пишите им жалобы, чтобы быстрее восстановили получение писем, регистрируйтесь через яндекс почту и gmail, туда письма с активизацией доходят.

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

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

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

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

Типа этого.


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

Последний раз редактировалось АНАТОЛИЙ249; 01.10.2018 в 17:22.
АНАТОЛИЙ249 вне форума   Ответить с цитированием
Старый 24.10.2018, 22:23   #2
Aliens_wolfs
Участник клуба
 
Регистрация: 16.12.2009
Адрес: WWW ЛЕНИНГРАД СПб точка РУ
Сообщений: 860
Репутация: 435
По умолчанию

Вот нашел у себя пример на 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 Кб, 12 просмотров)

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

Опции темы

Ваши права в разделе
Вы не можете создавать новые темы
Вы не можете отвечать в темах
Вы не можете прикреплять вложения
Вы не можете редактировать свои сообщения

BB коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.

Быстрый переход

Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
BASS.DLL Serrg1994 Мультимедиа в Delphi 0 20.09.2011 21:38
bass.dll larry Общие вопросы C/C++ 1 09.11.2009 14: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


10:07.


Powered by vBulletin® Version 3.8.8 Beta 2
Copyright ©2000 - 2018, Jelsoft Enterprises Ltd.

RusProfile.ru


Справочник российских юридических лиц и организаций.
Проекты отопления, пеллетные котлы, бойлеры, радиаторы
интернет магазин respective.ru