Здравствуйте!

Я не могу запрограммировать возврат информации об изменении в спектральном анализе частотного разрешения; программа просто игнорирует подаваемые запросы.
Мой листинг программы на 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: как к программе спектрограммы подключить шкалу палитры амплитуд сигнала?

Большое спасибо, с уважением Озябкин Андрей Львович.

Тема

[Manager 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();
}

[Андрей ОзябкинУчастник]

Спасибо за ответ, Андрей.

Но проблема состоит в том, что при запросе вектора частот

Unit1.SetParam 6, 0

в подпрограмме массив data заполняется только на четверть того объёма, который был получен в результате запроса

Unit1.SetParam 5, 0

При изменении декады частот размер не изменяется.

Если можно, то на email могу сбросить первоисточники.

[Manager ZETLABУчастник]

Здравствуйте, Андрей!

Проблема устранена, напишите, куда вам выслать обновление.

[Андрей ОзябкинУчастник]

Большое спасибо, Андрей!

мой email: ozyabkin@mail.ru

[Автор]

Ответы