Private Sub Form_Unload(Cancel As Integer)
Dim i As Integer
Call CloseDevice
'close all sub forms
For i = Forms.Count - 1 To 1 Step -1
Unload Forms(i)
Next
If Me.WindowState <> vbMinimized Then
SaveSetting App.Title, "Settings", "MainLeft", Me.Left
SaveSetting App.Title, "Settings", "MainTop", Me.Top
End If
End Sub
Public Sub OpenDevice()
Dim Err As Long ' Код ошибки
Dim enable As Long ' Поддерживается / не поддерживается
Dim Serial As Long ' Серийный номер
numberDSP = 0 ' Здесь задан первый порядковый номер устройства
pointerADC = 0
pointerADC_old = 0
pBufferADC = 0
' Цикл подключения к первому поддерживаемому устройству
For typeDevice = 0 To MAX_TYPE_DSP - 1
' подключиться к драйверу (обязательно)
Err = ZOpen(typeDevice, numberDSP)
If (Err = 0) Then
' Проверить поддерживается ли АЦП
Err = ZGetEnableADC(typeDevice, numberDSP, enable)
If (Err = 0 And enable <> 0) Then
Exit For
Else
Err = ZClose(typeDevice, numberDSP)
End If
End If
Next typeDevice
If (typeDevice >= MAX_TYPE_DSP) Then
MsgBox ("Поддерживаемое устройство не найдено!")
End
End If
Err = ZGetSerialNumberDSP(typeDevice, numberDSP, Serial)
If (Err = 0) Then
frmMain.Caption = "Test_Zadc для устройства №" + CStr(Serial)
End If
' опросить кол-во каналов АЦП
Err = ZGetQuantityChannelADC(typeDevice, numberDSP, numChannelsADC)
If (Err <> 0) Then
MsgBox ("Ошибка в ZGetQuantityChannelADC(), Error = " + CStr(Err))
GoTo EndWithZClose
End If
' включить первый канал АЦП
Err = ZSetInputADC(typeDevice, numberDSP, 0, 1)
If (Err <> 0) Then
MsgBox ("Ошибка в ZSetInputADC(), Error = " + CStr(Err))
GoTo EndWithZClose
End If
If numChannelsADC > 1 Then
' включить второй канал АЦП
Err = ZSetInputADC(typeDevice, numberDSP, 1, 1)
If (Err <> 0) Then
MsgBox ("Ошибка в ZSetInputADC(), Error = " + CStr(Err))
GoTo EndWithZClose
End If
End If
' опросить коэф. усиления по первому каналу АЦП
Err = ZGetAmplifyADC(typeDevice, numberDSP, 0, amplifyADC(0))
If (Err <> 0) Then
MsgBox ("Ошибка в ZGetAmplifyADC(), Error = " + CStr(Err))
GoTo EndWithZClose
End If
If numChannelsADC > 1 Then
' опросить коэф. усиления по второму каналу АЦП
Err = ZGetAmplifyADC(typeDevice, numberDSP, 1, amplifyADC(1))
If (Err <> 0) Then
MsgBox ("Ошибка в ZGetAmplifyADC(), Error = " + CStr(Err))
GoTo EndWithZClose
End If
End If
' опросить вес младшего разряда АЦП первого канала
Err = ZGetDigitalResolChanADC(typeDevice, numberDSP, 0, resolutionADC(0))
If (Err <> 0) Then
MsgBox ("Ошибка в ZGetDigitalResolChanADC(), Error = " + CStr(Err))
GoTo EndWithZClose
End If
If numChannelsADC > 1 Then
' опросить вес младшего разряда АЦП второго канала
Err = ZGetDigitalResolChanADC(typeDevice, numberDSP, 1, resolutionADC(1))
If (Err <> 0) Then
MsgBox ("Ошибка в ZGetDigitalResolChanADC(), Error = " + CStr(Err))
GoTo EndWithZClose
End If
End If
' опросить кол-во включенных каналов АЦП
Err = ZGetNumberInputADC(typeDevice, numberDSP, numChannelsADC)
If (Err <> 0) Then
MsgBox ("Ошибка в ZGetNumberInputADC(), Error = " + CStr(Err))
GoTo EndWithZClose
End If
' опросить кол-во слов в одном отсчете АЦП
Err = ZGetWordsADC(typeDevice, numberDSP, numWordsADC)
If (Err <> 0) Then
MsgBox ("Ошибка в ZGetWordsADC(), Error = " + CStr(Err))
GoTo EndWithZClose
End If
' Проверка переменных, чтобы избежать деления на 0
If (numWordsADC = 0 Or amplifyADC(0) = 0 Or amplifyADC(1) = 0) Then
MsgBox ("Ошибочные значения параметров АЦП!")
GoTo EndWithZClose
End If
' Запросить буфер АЦП
Err = ZGetBufferADC(typeDevice, numberDSP, pBufferADC, sizeBufferADC)
If (Err <> 0) Then
MsgBox ("Ошибка в ZGetBufferADC(), Error = " + CStr(Err))
GoTo EndWithZClose
End If
' Останов АЦП
Err = ZStopADC(typeDevice, numberDSP)
' Запуск АЦП
Err = ZStartADC(typeDevice, numberDSP)
' Запуск таймера
frmMain.Timer1.Enabled = True
GoTo OnExit
EndWithZClose:
Err = ZClose(typeDevice, numberDSP)
End
OnExit:
End Sub
Public Sub CloseDevice()
Dim Err As Long ' Код ошибки
' Останов АЦП
Err = ZStopADC(typeDevice, numberDSP)
' Освободить буфер АЦП
If pBufferADC <> 0 Then
Err = ZRemBufferADC(typeDevice, numberDSP, pBufferADC)
End If
' Отключиться от драйвера (обязательно)
Err = ZClose(typeDevice, numberDSP)
pBufferADC = 0
End Sub
Private Sub Timer1_Timer()
Dim Err As Long ' Код ошибки
' Запросить текущее значение указателя
Err = ZGetPointerADC(typeDevice, numberDSP, pointerADC)
If Err <> 0 Then
Unload frmMain
End
End If
' Если новые данные в буфер не поступили, то выйти из процедуры
If pointerADC = pointerADC_old Then GoTo EndTimer
' Обновить предыдущее значение указателя
pointerADC_old = pointerADC
' Перейти на отсчет первого включенного канала последнего кадра АЦП
If (pointerADC - numWordsADC * numChannelsADC) < 0 Then
pointerADC = sizeBufferADC + pointerADC - numWordsADC * numChannelsADC
Else
pointerADC = pointerADC - numWordsADC * numChannelsADC
End If
' Вычислить адрес памяти откуда копировать данные АЦП для CopyMemory()
pointerADC_abs = pBufferADC + 2 * pointerADC
If numWordsADC = 1 Then
' Скопировать два байта если отсчет АЦП состоит из одного слова
CopyMemory Buffer16ADC(0), ByVal pointerADC_abs, 2
' Вычислить из целого значения отсчета АЦП вещественное значение отсчета (в Вольтах)
volt(0) = resolutionADC(0) * Buffer16ADC(0) / amplifyADC(0)
Else
' Скопировать четыре байта если отсчет АЦП состоит из двух слов
CopyMemory Buffer32ADC(0), ByVal pointerADC_abs, 4
' Вычислить из целого значения отсчета АЦП вещественное значение отсчета (в Вольтах)
volt(0) = resolutionADC(0) * Buffer32ADC(0) / amplifyADC(0)
End If
' Отобразить мгновенное значение напряжения для первого канала
TextBox1.Text = Format(volt(0), "###0.000000")
' Если включено более одного канала АЦП, то сделать то же самое для второго канала
If numChannelsADC > 1 Then
' Перейти на следующий отсчет АЦП
pointerADC = pointerADC + numWordsADC
' Если вышли за границу буфера, то перейти в начало
If pointerADC >= sizeBufferADC Then pointerADC = pointerADC - sizeBufferADC
pointerADC_abs = pBufferADC + 2 * pointerADC
If numWordsADC = 1 Then
CopyMemory Buffer16ADC(1), ByVal pointerADC_abs, 2
volt(1) = resolutionADC(1) * Buffer16ADC(1) / amplifyADC(1)
Else
CopyMemory Buffer32ADC(1), ByVal pointerADC_abs, 4
volt(1) = resolutionADC(1) * Buffer32ADC(1) / amplifyADC(1)
End If
' Отобразить мгновенное значение напряжения для второго канала
TextBox2.Text = Format(volt(1), "#0.000000")
End If
EndTimer:
End Sub
Public Sub GetVerDSP()
Dim Err As Long ' Код ошибки
Dim Length As Long ' Длина строки
Dim strVer As String
Dim strVerDrv As String, strVerDSP As String, strVerLib As String
Err = ZOpen(typeDevice, numberDSP)
If Err <> 0 Then MsgBox ("Device not find, Error = " + CStr(Err))
strVerDrv = Space$(100)
strVerDSP = Space$(100)
strVerLib = Space$(100)
Err = ZGetVersion(typeDevice, numberDSP, strVerDSP, strVerDrv, strVerLib)
strVer = Trim(strVerDSP)
Length = Len(strVer)
If Length > 0 Then strVer = Left(strVer, Length - 1)
MsgBox (strVer)
Err = ZClose(typeDevice, numberDSP)
End Sub
388828835 - Мария