Редактировалось 2 раз(а), последний 2025-01-09 08:29:52

Егор, отрисовка нормально просиходит... смотри примеры...

Редактировалось 2 раз(а), последний 2025-01-09 08:29:52

Можно взять BASS_ChlVisibleSpectrum и по его аналогии сделать компонент, выводящий уровень наиболее высокого столбика.

Вот компонент:
[code:1]unit hiBASS_ChlVisibleOcilloRec;
interface

uses Windows,Kol,Share,Debug,BASS;

type
THIBASS_ChlVisibleOcilloRec = class(TDebug)
private
VisBuff:PBitmap;
public
_prop_BackColor:TColor;
_prop_Offset:integer;
_prop_Pen:TColor;
_prop_Mode:byte;
_prop_Res:byte;
_prop_FrameClear:boolean;

_data_BackBitmap:THI_Event;
_data_ChannelHandle:THI_Event;
_data_WindowsHandle:THI_Event;

_event_OnLeValue:THI_Event;
_event_OnRiValue:THI_Event;

procedure _work_doDraw(var _Data:TData; Index:word);
end;

implementation

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

procedure THIBASS_ChlVisibleOcilloRec._work_doDraw;
var i, YPos,Ri,Le : LongInt; X,Y,R,L : SmallInt; YVal : single;
WaveData:TWaveData;
h:cardinal;
Scr:PBitmap;
begin
VisBuff := ReadBitmap(_Data,_data_WindowsHandle,nil);
//h := ReadInteger(_Data,_data_ChannelHandle,0);
h := RECORDCHAN;
scr := ReadBitmap(_Data,_data_BackBitmap,nil);

if _prop_FrameClear then
begin
VisBuff.Canvas.Pen.Color := _prop_BackColor;
VisBuff.Canvas.Brush.Color := _prop_BackColor;
VisBuff.Canvas.Rectangle(0, 0, VisBuff.Width, VisBuff.Height);
if Scr <> nil then
Scr.Draw(VisBuff.Canvas.Handle,0,0);
end;

if BASS_ChannelIsActive(h) <> BASS_ACTIVE_PLAYING then Exit;
BASS_ChannelGetData(h, @WaveData, 2048);
//BASS_ChannelGetData(h, @FFTData, BASS_DATA_FFT1024 or BASS_DATA_FFT_NOWINDOW);

X := 0;
Y := VisBuff.Height div 2;
Ri := 0;
Le := 0;

VisBuff.Canvas.Pen.Color := _prop_Pen;
R := SmallInt(LOword(WaveData[0]));
L := SmallInt(HIword(WaveData[0]));
YPos := Trunc(((R + L) / (2 * 65535)) * _prop_Offset) ;
VisBuff.Canvas.MoveTo(X , Y + YPos);

for i := 1 to 256*_prop_Res do
begin
R := SmallInt(LOword(WaveData[i]));
Ri := Ri+abs(R);
//begin
// _hi_OnEvent(_event_onRiValue,abs(R));
//end;
L := SmallInt(HIword(WaveData[i]));
Le := Le+abs(L);
//begin
//_hi_OnEvent(_event_onLeValue,abs(L));
//end;
YPos := Trunc(((R + L) / (2 * 65535)) * _prop_Offset) ;

case _prop_Mode of
0: VisBuff.Canvas.lineto(X + i*5, Y + YPos);
1:
begin
VisBuff.Canvas.MoveTo(X + i, Y);
VisBuff.Canvas.lineto(X + i, Y + YPos);
end;
2 : VisBuff.Pixels[X + i, Y + YPos] := _prop_Pen;
end;
end;
begin
_hi_OnEvent(_event_onRiValue,Ri/100000);
_hi_OnEvent(_event_onLeValue,Le/100000);
end;
end;

end.[/code:1]

Вот конфиг:
[code:1][About] Version=1.0
Author=Dilma
Mail=hiasm@mail.ru

[Type]
Class=Element
Info=Визуализация канала записи

[Property]
BackColor=Цвет фона|8|0
Offset=Смещение вывода по X|1|100
Pen=Цвет столбика|8|clWhite
Mode=Режим отображения столбиков|4|0|Line,Solid,Pixels
Res=Длина выборки(256/512/1024/2048 отсчетов)|14|0|1,2,3,4
FrameClear=Очистка фона|14|0|True,False

[Methods]
doDraw=Отрисовка состояния канала|1|
WindowsHandle=Определяет идентификатор картинки, на которой требуется отрисовать диаграмму (точки Bitmap)|4|
ChannelHandle=Определяет идентификатор канала, чьё состояние требуется отобразить (не применимо к компонентам BASS_SmpXXX)|4|
BackBitmap=Определяет фоновую картинку|4|bmp
onLeValue=Выдает уровень левого канала после выборки|2|
onRiValue=Выдает уровень правого канала после выборки|2|[/code:1]

Иконку сами нарисуете, что то свою не могу сюда скопировать.

ХЭМ, 1) нарисуйте, пожалуйста, пример использования, у меня не получается!
2) строку кода:
"for i := 1 to 256*_prop_Res do "
можно-ли заменить на:
"for i := 1 to 2*_prop_Res do "?

Леонид, вот пример с этим элементом:
[code:1]Add(InfoTip,3139768,28,229) {
Info=#9:Âíèìàíèå!|
Font=[MS Sans Serif,12,1,255,1]
Transparent=1
Width=232
Height=95
}
Add(MainForm,93829,21,-9)
{
Left=21
Top=105
Width=480
Height=170
Font=[Arial,20,1,0,1]
Caption="LEVEL IN"
link(onCreate,86720:doEvent1,[])
}
Add(Hub,86720,70,26)
{
OutCount=5
link(onEvent4,13172458:doInit,[(128,53)(128,186)])
link(onEvent5,13172458:doStart,[(121,60)(121,200)])
}
Add(Timer,37612,14,425)
{
Interval=100
link(onTimer,670:doEvent1,[])
}
Add(LinkTip,9279260,42,299)
{
Link="http://si-tech.ru/hiasm/tools/BASS.DLL=load://http://si-tech.ru/hiasm/tools/BASS.DLL"
Font=[MS Sans Serif,8,0,16711680,1]
}
Add(Edit,8544919,351,501)
{
Left=130
Top=60
Width=60
DataType=4
}
Add(InfoTip,8392515,42,250)
{
Info=#92:Äëÿ ðàáîòû êîìïîíåíò áèáëèîòåêè BASS íåîáõîäèìî ñêà÷àòü DLL è ñêîïèðîâàòü å¸ â ïàïêó Windows|
Frame=1
HAlign=0
Width=218
Height=39
}
Add(Hub,670,63,425)
{
OutCount=4
link(onEvent1,30279:doDraw,[(138,431)(138,466)])
link(onEvent2,22442:doRefresh,[(110,438)(110,361)])
}
Add(Message,5206808,224,187)
{
}
Add(BASS_Record,13172458,154,180)
{
Freg=22050
Channels=1
link(onError,5206808:doMessage,[])
}
Add(BASS_ChlVisibleOcilloRec,30279,182,460)
{
link(WindowsHandle,22442:ImageBitmap,[(188,417)(133,417)])
link(onLeValue,6446346:doEvent1,[(228,466)(228,361)])
link(onRiValue,2329963:doEvent1,[])
}
Add(Edit,5550868,399,355)
{
Left=130
Top=10
Width=60
DataType=4
}
Add(Hub,2329963,259,467)
{
link(onEvent1,8290714:doPosition,[(341,473)(341,445)])
link(onEvent2,8544919:doText,[(321,480)(321,507)])
}
Add(Hub,6446346,273,355)
{
link(onEvent1,4265956:doPosition,[(352,361)(352,291)])
link(onEvent2,5550868:doText,[(352,368)(352,361)])
}
Add(Image,22442,127,341)
{
Left=5
Top=5
Width=120
Height=125
Draw=0
Point(doRefresh)
}
Add(ProgressBar,4265956,399,285)
{
Left=200
Top=10
Width=260
Max=50
Smooth=1
}
Add(ProgressBar,8290714,392,439)
{
Left=200
Top=60
Width=260
Max=50
Smooth=1
}
[/code:1]
Насчет изменения строки - можно, только зачем, выборка слишком короткая для усреднения показания будут прыгать случайно.

ХЭМ, спасибо! работает, я собирал точно так же - не работало, наваждение какое-то, сохранил, на всякий случай, в двух местах

Леонид, а какая у Вас ОС? Я намедни обнародовал одну прогу с использованием этого элемента. Так почему то не у всех работает (как я понял с XP). И кстати у меня тоже наваждения, этот примерчик я делал из работающей схемы. А из набранных элементов никак не хочет. Надо искать глюк.

ХЭМ, XP 2002 г. выпуска.

Леонид, а попробуйте запустить вот этот приборчик http://www.cqham.ru/u-meter.htm. извините почему то не получается перебросить схему, может слишком большая.

ХЭМ, я тоже хочу посмотреть.Сегодня даже поругался на том сайте с UN7RX. Если мможно,то и мне на мыло...

ХЭМ, выскакивает целый список Runtime Error (13 шт), сама программа со звуком, синусоидой, значением амплитуды, но если нажать Ok на сообщении об ошибке, всё закрывается.