• Автор
    Тема
  • #48346

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

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

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

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

Просмотр 4 ответов - с 1 по 4 (всего 4)
  • Автор
    Ответы
  • #48347

    Менеджер 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();
    }

    #48348

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

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

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

    Unit1.SetParam 6, 0

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

    Unit1.SetParam 5, 0

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

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

    #48349

    Менеджер ZETLab
    Хранитель

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

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

    #48350

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

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

    мой email: ozyabkin@mail.ru

Просмотр 4 ответов - с 1 по 4 (всего 4)

Для ответа в этой теме необходимо авторизоваться.