ZETLAB [тема: Программирование спектральной оси частот]

Программирование спектральной оси частот

Fri, 09 Sep 2016 23:05:20 +0300

Программирование спектральной оси частот в форуме Форум по вопросам о продукции компании ZETLAB.
Большое спасибо, Андрей! мой email: ozyabkin@mail.ru
09.09.2016 23:05:20, Андрей Озябкин.

Программирование спектральной оси частот

Fri, 09 Sep 2016 23:04:33 +0300

Программирование спектральной оси частот в форуме Форум по вопросам о продукции компании ZETLAB.
Здравствуйте, Андрей! Проблема устранена, напишите, куда вам выслать обновление.
09.09.2016 23:04:33, Manager ZETLAB.

Программирование спектральной оси частот

Fri, 09 Sep 2016 23:04:03 +0300

Программирование спектральной оси частот в форуме Форум по вопросам о продукции компании ZETLAB.
Спасибо за ответ, Андрей. Но проблема состоит в том, что при запросе вектора частот Unit1.SetParam 6, 0 в подпрограмме массив data заполняется только на четверть того объёма, который был получен в результате запроса Unit1.SetParam 5, 0 При изменении декады частот размер не изменяется. Если можно, то на email могу сбросить первоисточники.
09.09.2016 23:04:03, Андрей Озябкин.

Программирование спектральной оси частот

Fri, 09 Sep 2016 23:03:38 +0300

Программирование спектральной оси частот в форуме Форум по вопросам о продукции компании ZETLAB.
Здравствуйте, Андрей! Ответ на первый вопрос: Вот пример получения из узкоплосного спектра всех параметров (размера, массива частот, массива значений): Dim data(100000) As Single Private Sub Command1_Click() Unit1.SetParam 5, 0 End Sub Private Sub Command2_Click() Unit1.SetParam 6, 0 End Sub Private Sub Command3_Click() Unit1.SetParam 7, 0 End Sub Private Sub Form_Load() Unit1.Activate ("spectr") End Sub Private Sub Form_Unload(Cancel As Integer) Unit1.DisActivate End Sub Private Sub Unit1_Ready(ByVal param As Long) Dim size As Long Dim parametr As Long Unit1.Read size, data(0), parametr End Sub Ответ на второй вопрос: Для отображения спектрограммы надо добавить компоненты GrammaGL и ColScale, а далее обрабатывать сообщения второго компонента: (текст функций обработки на C++) void CZetGrammaCtrl::MouseUpColscalectrl1(short Button, short Shift, long x, long y) { m_gramma.SetColorWidth(m_scale.GetMathdy()); m_gramma.SetColorMin(m_scale.GetMathly()); if (m_scale.GetAutoColor() == 1) m_gramma.SetTypeXAxis(100); m_gramma.Display(); m_scale.SetMathdy(m_gramma.GetColorWidth()); m_scale.SetMathly(m_gramma.GetColorMin()); m_scale.Redraw(); } void CZetGrammaCtrl::MouseWheelColscalectrl1() { m_gramma.SetColorWidth(m_scale.GetMathdy()); m_gramma.SetColorMin(m_scale.GetMathly()); m_gramma.Display(); }
09.09.2016 23:03:38, Manager ZETLAB.

Программирование спектральной оси частот

Fri, 09 Sep 2016 23:02:04 +0300

Программирование спектральной оси частот в форуме Форум по вопросам о продукции компании ZETLAB.
Здравствуйте! Я не могу запрограммировать возврат информации об изменении в спектральном анализе частотного разрешения; программа просто игнорирует подаваемые запросы. Мой листинг программы на VB6 Private Sub Unit1_Ready(ByVal param As Long) 'объявляем временные переменные Dim arraySize As Long Dim Size As Long Dim parametr As Long Dim ptrData As Long Dim data_() As Single On Error GoTo 1 DoEvents 'узнаем размер массива данных arraySize = RequestDataArraySize() 'смотрим, какая информация к нам пришла ' получаем указатель на блок памяти 'читаем данные, поступившие с программы Spectr.exe ReDim buffdata(arraySize) As Long 'получаем указатель на массив 'функция позволяющая получить указатель на элемент массива '(самый настоящий указатель на первый элемент массива!). ptrData = VarPtr(buffdata(0)) Unit1.ReadNet Size, ptrData, parametr 'создаем динамический массив, в который будут копироваться данные из 'места в памяти, куда указывает ptrData data_ = ResolvePointer(ptrData, arraySize) 'если стоит флаг о запросе четки частот, то 'в предыдущей строчке (m_unit.Read) мы прочитали сетку частот If flags.m_bRequestFreq Then 'сразу же сбрасываем флаг flags.m_bRequestFreq = False With GridGL1 'теперь необходимо выставить параметры координатной сетки компонента GridGL.ocx .Size = arraySize .NumVisiblePoints = arraySize 'выставляем параметры отображения по оси X .Xfirst = data_(0) 'значение в начале координатной сетки .Xend = data_(arraySize - 1) 'значение в конце координатной сетки 'выставляем текущую область видимости по оси Х .Mathlx = data_(0) 'Левая граница отображения данных .Mathdx = data_(arraySize - 1) 'Длина отображения данных End With With GrammaGL1 .Xfirst = data_(0) .Xend = data_(arraySize - 1) .Mathlx = data_(0) .Mathdx = data_(arraySize - 1) End With 'посылаем команду Юниту на запрос массива, содержащего спектр Unit1.SetParam 7, 0 'ставим флаг запроса спектра flags.m_bRequestSpectr = True Else 'если размер вновь пришедшего массива отличается от размера предыдущего массива, 'значит надо подстроить координатную сетку под новый размер '(это может быть если вы изменили настройки Spectr.exe в ручную, а не через Юнит) If (m_oldArraySize <> arraySize) Then m_oldArraySize = arraySize RequestFreq Else 'если же пришел спектр, то просто, отрисовываем его на графике GridGL1.PaintNet ptrData GrammaGL1.PaintNet ptrData End If End If Exit Sub 1: Resume 0 End Sub 'запрос размера массива, передаваемого от запущенной программы Spectr.exe Private Function RequestDataArraySize() As Long Dim Size As Long Dim data As Single Dim parametr As Long On Error GoTo 1 2: Unit1.ReadNet Size, CLng(data), parametr RequestDataArraySize = Size Exit Function 1: Resume 2 End Function 'запрос массива, содержащего сетку частот Private Sub RequestFreq() Unit1.SetParam 6, 0 'запрос массива, содержащего сетку частот 'ставим флаг запроса сетк частот flags.m_bRequestFreq = True flags.m_bRequestSpectr = False End Sub Private Sub CheckActivateError(ByVal error_ As Integer) Select Case error_ Case -5 MsgBox "Программа не проходит инициализацию с сервером программ Unit (мало оперативной памяти или дискового пространства)" Case -4 MsgBox "не запускается программа Spectr.exe (нет на диске, не та версия)" Case -3, 0 Case -2 MsgBox "Нет свободного места для подключения к серверу программ Unit (слишком много программ подключено к серверу Unit)" Case -1 MsgBox "Нет свободного места для подключения к серверу программ Unit (слишком много программ подключено к серверу Unit)" Case Else End Select End Sub ' Подпрограмма копирования блока памяти из одного места в другое Private Property Get ResolvePointer(ByVal lpObj As Long, ByVal Size As Long) As Single() Dim oSH() As Single ' oSH - начальный адрес назначения копируемого блока ' lpObj - начальный адрес блока памяти, который должен быть скопирован ReDim oSH(Size) CopyMemory ByVal VarPtr(oSH(0)), ByVal lpObj, Size ResolvePointer = oSH CopyMemory ByVal VarPtr(oSH(0)), ByVal lpObj, Size End Property Программа выдаёт размер оси частот в 1000 ячеек памяти, но заполняет информацией только 250 и больше никак не реагирует на изменение декады частотного разрешения. Вопрос 2: как к программе спектрограммы подключить шкалу палитры амплитуд сигнала? Большое спасибо, с уважением Озябкин Андрей Львович.
09.09.2016 23:02:04, Андрей Озябкин.