Последние записи
- TChromium (CEF3), сохранение изображений
- Как в Delphi XE обнулить таймер?
- Изменить цвет шрифта TextBox на форме
- Ресайз PNG без потери прозрачности
- Вывод на печать графического файла
- Взаимодействие через командную строку
- Перенести программу из Delphi в Lazarus
- Определить текущую ОС
- Автоматическая смена языка (раскладки клавиатуры)
- Сравнение языков на массивах. Часть 2
Интенсив по Python: Работа с API и фреймворками 24-26 ИЮНЯ 2022. Знаете Python, но хотите расширить свои навыки?
Slurm подготовили для вас особенный продукт! Оставить заявку по ссылке - https://slurm.club/3MeqNEk
Online-курс Java с оплатой после трудоустройства. Каждый выпускник получает предложение о работе
И зарплату на 30% выше ожидаемой, подробнее на сайте академии, ссылка - ttps://clck.ru/fCrQw
16th
Ноя
Нарисовать синусоиду или огибающую на PaintBbox с использованием BASS.DLL
Posted by obzor under Delphi
мне нужно нарисовать синусоиду или огибающую на paintbox , не могу найти ,как сделать это на bass.dll , есть примеры с WAV форматом , через звуковую карту непосредственно , а мне так не надо.Типа этого.Спасибо.
Вот нашел у себя пример на 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);
//Пеpемещает текущую позицию в указанную точку
PaintBoxSpectrum.Canvas.LineTo(i * (ColWidth + 1) + ColWidth, PaintBoxSpectrum.Height - FPeaks);
//чертит линию от текущей позиции до
// рисуем полосы
PaintBoxSpectrum.Canvas.Pen.Color := clLtGray;
//Цвет рамки линий Пиков
PaintBoxSpectrum.Canvas.Brush.Color := clBlue;
//Цвет заливки линий Пиков
PaintBoxSpectrum.Canvas.Rectangle(i * (ColWidth + 1), PaintBoxSpectrum.Height - FLimit,
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;
Похожие статьи
Купить рекламу на сайте за 1000 руб
пишите сюда - alarforum@yandex.ru
Да и по любым другим вопросам пишите на почту
пеллетные котлы
Пеллетный котел Emtas
Наши форумы по программированию:
- Форум Web программирование (веб)
- Delphi форумы
- Форумы C (Си)
- Форум .NET Frameworks (точка нет фреймворки)
- Форум Java (джава)
- Форум низкоуровневое программирование
- Форум VBA (вба)
- Форум OpenGL
- Форум DirectX
- Форум CAD проектирование
- Форум по операционным системам
- Форум Software (Софт)
- Форум Hardware (Компьютерное железо)