mainfrm.frm

来自「16 relay output channels and 16 isolated」· FRM 代码 · 共 780 行 · 第 1/2 页

FRM
780
字号

Public Function InitDevList() As Boolean

Dim lErrCde As Long
Dim nDevNum As Integer
Dim nOutEntries As Integer
Dim DevList(0 To MAX_ENTRIES) As PT_DEVLIST
Dim nResponse As Integer
Dim i As Integer
Dim j As Integer
Dim nIndex As Integer
Dim strDevInfo As String

'Firstly, get count of devices
lErrCde = DRV_DeviceGetNumOfList(nDevNum)
If lErrCde <> SUCCESS Then
    ErrReport lErrCde
    InitDevList = False
    Exit Function
End If
'Check if there are too many devices to procedure
If nDevNum > MAX_ENTRIES Then
    nResponse = MsgBox("Too many devices to run the program! ", vbOKOnly Or vbCritical, "Error")
    InitDevList = False
    Exit Function
End If
If nDevNum = 0 Then
    nResponse = MsgBox("Please install a device first! ", vbOKOnly Or vbCritical, "Error")
    InitDevList = False
    Exit Function
End If

'Secondly, get device list
lErrCde = DRV_DeviceGetList(DRV_GetAddress(DevList(0)), MAX_ENTRIES, nOutEntries)
If lErrCde <> SUCCESS Then
    ErrReport lErrCde
    InitDevList = False
    Exit Function
End If

'Thirdly, fill the combo and save the devices' number
For i = 0 To nOutEntries - 1
    m_DevNumList(i) = DevList(i).dwDeviceNum
    strDevInfo = ""
    For j = 0 To 49
        strDevInfo = strDevInfo + Chr(DevList(i).szDeviceName(j))
    Next j
    CmbDevList.AddItem strDevInfo
Next i

CmbDevList.ListIndex = 0
InitDevList = True

End Function
Public Sub ErrReport(lErrCde As Long)

Dim strErr As String * 40
Dim nResponse As Integer

DRV_GetErrorMessage lErrCde, strErr
nResponse = MsgBox(strErr, vbOKOnly Or vbInformation, "Driver Error")

End Sub

Public Function CharToByte(C As Byte) As Byte

If ((C >= Asc("0")) And (C <= Asc("9"))) Then
    CharToByte = C - Asc("0")
    Exit Function
End If

If ((C >= Asc("A")) And (C <= Asc("F"))) Then
    CharToByte = C - Asc("A") + 10
    Exit Function
End If

If ((C >= Asc("a")) And (C <= Asc("f"))) Then
    CharToByte = C - Asc("a") + 10
    Exit Function
End If

CharToByte = 0


End Function

Private Sub BtnGetDOState_Click()
Dim nPortStart As Integer
Dim nPortCount As Integer
Dim npData() As Byte
Dim strData As String
Dim i As Integer
Dim lErrCde As Long

If (m_lDevHandle = 0) Then
    MsgBox "Please open a device firstly!", vbOKOnly Or vbInformation, "Prompt"
    Exit Sub
End If

'Firstly, get port start number
If ((DOSPortStart.Text = "") Or (Not IsNumeric(DOSPortStart.Text))) Then
    MsgBox "Please input a avaliable number", vbOKOnly, "Prompt"
    Exit Sub
End If
nPortStart = Int(DOSPortStart.Text)

If (nPortStart >= m_lDOPortCount) Then
    MsgBox "Please input an appropriate number!", vbOKOnly Or vbInformation, "Prompt"
    Exit Sub
End If

'Secondly, get port count
If ((DOSPortCount.Text = "") Or (Not IsNumeric(DOSPortCount.Text))) Then
    MsgBox "Please input a avaliable number", vbOKOnly, "Prompt"
    Exit Sub
End If
nPortCount = Int(DOSPortCount.Text)

If (((nPortCount + nPortStart) > m_lDOPortCount) Or (nPortCount = 0)) Then
    MsgBox "Please input a avaliable number", vbOKOnly, "Prompt"
    Exit Sub
End If

'Thirdly, allocate memory and read the ports
ReDim npData(0 To nPortCount)
lErrCde = AdxDioGetCurrentDoPortsState(m_lDevHandle, nPortStart, nPortCount, npData(0))
If (lErrCde <> SUCCESS) Then
    Exit Sub
End If

'Finally, show the data
For i = 0 To nPortCount - 1
    If (npData(i) <= 15) Then
        strData = strData + "0" + Hex(npData(i)) + " "
    Else
        strData = strData + Hex(npData(i)) + " "
    End If
Next i

DOSData.Text = strData

End Sub

Private Sub BtnOpenDev_Click()

Dim nDevNum As Integer
Dim nSel As Integer
Dim lErrCde As Long
Dim lDataLen As Long

'Firstly, get the deivce number
nSel = CmbDevList.ListIndex
If (nSel < 0) Then
    MsgBox "Too many devices to run the program!", vbOKOnly, "Sorry"
    Exit Sub
End If
nDevNum = m_DevNumList(nSel)

'Secondly, open the device
'--If the device has been opened, close it
If (m_lDevHandle <> 0) Then
    lErrCde = DRV_DeviceClose(m_lDevHandle)
    If (lErrCde <> SUCCESS) Then
        ErrReport lErrCde
        Exit Sub
    End If
End If
'--Then, open the device
lErrCde = DRV_DeviceOpen(nDevNum, m_lDevHandle)
If (lErrCde <> SUCCESS) Then
    ErrReport lErrCde
    BtnRead.Enabled = False
    BtnWrite.Enabled = False
    BtnGetDOState.Enabled = False
    DIPorts.Text = ""
    DOPorts.Text = ""
    m_lDIPortCount = 0
    m_lDOPortCount = 0
    Exit Sub
End If

'Thirdly, get the count of DIO ports
'The buffer for the porperty is long type. So, we need four bytes to store it.
lDataLen = 4
'--DI ports
lErrCde = DRV_DeviceGetProperty(m_lDevHandle, CFG_DiPortCount, m_lDIPortCount, lDataLen)
If (lErrCde = SUCCESS) Then
    If (m_lDIPortCount > 0) Then
        DIPorts.Text = Str(m_lDIPortCount)
        BtnRead.Enabled = True
    Else
        BtnRead.Enabled = False
        DIPorts.Text = ""
        m_lDIPortCount = 0
    End If
Else
    BtnRead.Enabled = False
    DIPorts.Text = ""
    m_lDIPortCount = 0
End If
'--DO ports
lErrCde = DRV_DeviceGetProperty(m_lDevHandle, CFG_DoPortCount, m_lDOPortCount, lDataLen)
If (lErrCde = SUCCESS) Then
    If (m_lDOPortCount > 0) Then
        DOPorts.Text = Str(m_lDOPortCount)
        BtnWrite.Enabled = True
        BtnGetDOState.Enabled = True
    Else
        BtnWrite.Enabled = False
        BtnGetDOState.Enabled = False
        DOPorts.Text = ""
        m_lDOPortCount = 0
    End If
Else
    BtnWrite.Enabled = False
    BtnGetDOState.Enabled = False
    DOPorts.Text = ""
    m_lDOPortCount = 0
End If

End Sub

Private Sub BtnRead_Click()
Dim nPortStart As Integer
Dim nPortCount As Integer
Dim npData() As Byte
Dim strData As String
Dim i As Integer
Dim lErrCde As Long

If (m_lDevHandle = 0) Then
    MsgBox "Please open a device firstly!", vbOKOnly Or vbInformation, "Prompt"
    Exit Sub
End If

'Firstly, get port start number
If ((DIPortStart.Text = "") Or (Not IsNumeric(DIPortStart.Text))) Then
    MsgBox "Please input a avaliable number", vbOKOnly, "Prompt"
    Exit Sub
End If
nPortStart = Int(DIPortStart.Text)
If (nPortStart >= m_lDIPortCount) Then
    MsgBox "Please input an appropriate number!", vbOKOnly Or vbInformation, "Prompt"
    Exit Sub
End If

'Secondly, get port count
If ((DIPortCount.Text = "") Or (Not IsNumeric(DIPortCount.Text))) Then
    MsgBox "Please input a avaliable number", vbOKOnly, "Prompt"
    Exit Sub
End If
nPortCount = Int(DIPortCount.Text)
If (((nPortCount + nPortStart) > m_lDIPortCount) Or (nPortCount = 0)) Then
    MsgBox "Please input a avaliable number", vbOKOnly, "Prompt"
    Exit Sub
End If

'Thirdly, allocate memory and read the ports
ReDim npData(0 To nPortCount)
lErrCde = AdxDioReadDiPorts(m_lDevHandle, nPortStart, nPortCount, npData(0))
If (lErrCde <> SUCCESS) Then
    Exit Sub
End If

'Finally, show the data
For i = 0 To nPortCount - 1
    If (npData(i) <= 15) Then
        strData = strData + "0" + Hex(npData(i)) + " "
    Else
        strData = strData + Hex(npData(i)) + " "
    End If
Next i

DIData.Text = strData

End Sub

Private Sub BtnWrite_Click()
Dim nPortStart As Long
Dim nPortCount As Long
Dim strText() As Byte
Dim pData() As Byte
Dim i, j, K As Integer
Dim Low, High As Byte
Dim lErrCde As Long
Dim nTextLen As Integer
Dim nDataCnt As Integer

If (m_lDevHandle = 0) Then
    MsgBox "Please open a device firstly!", vbOKOnly Or vbInformation, "Prompt"
    Exit Sub
End If

'Firstly, get the start port number
If ((DOPortStart.Text = "") Or (Not IsNumeric(DOPortStart.Text))) Then
    MsgBox "Please input a avaliable number", vbOKOnly, "Prompt"
    Exit Sub
End If
nPortStart = Int(DOPortStart.Text)
If (nPortStart >= m_lDOPortCount) Then
    MsgBox "Please input an appropriate number!", vbOKOnly Or vbInformation, "Prompt"
    Exit Sub
End If

'Secondly, get port count
If ((DOPortCount.Text = "") Or (Not IsNumeric(DOPortCount.Text))) Then
    MsgBox "Please input a avaliable number", vbOKOnly, "Prompt"
    Exit Sub
End If
nPortCount = Int(DOPortCount.Text)
If (((nPortCount + nPortStart) > m_lDOPortCount) Or (nPortCount = 0)) Then
    MsgBox "Please input a avaliable number", vbOKOnly, "Prompt"
    Exit Sub
End If

'Thirdly, allocate memory and get string inputed by user
If (DOData.Text = "") Then
    MsgBox "Please input the data you want to output firstly!", vbOKOnly Or vbInformation, "Prompt"
    Exit Sub
End If

ReDim pData(0 To nPortCount)
ReDim strText(0 To nPortCount * 2)

nTextLen = Len(DOData.Text)
nDataCnt = nTextLen / 2 '1.5 = 2 for VB
strText = DOData.Text

i = 0
j = 0
K = 0   'Character index
Do While (i < nPortCount)
    '* 16 means move the number for four bits left to be high data. 16 = 2^4
    If (i < nDataCnt) Then
        High = CharToByte(strText(j)) * 16
        K = K + 1
        If ((i = nDataCnt - 1) And (nTextLen = K)) Then 'The last charater in the string
            Low = 0
            K = K + 1
        Else
        Low = CharToByte(strText(j + 2))
        K = K + 1
        End If
        pData(i) = High Or Low
        j = j + 4
    Else
        pData(i) = 0
    End If
    i = i + 1
Loop

lErrCde = AdxDioWriteDoPorts(m_lDevHandle, nPortStart, nPortCount, pData(0))
If (lErrCde <> SUCCESS) Then
    Exit Sub
End If




End Sub

Private Sub Form_Load()

'Initialization
m_lDIPortCount = 0
m_lDOPortCount = 0
m_lDevHandle = 0

If (InitDevList <> True) Then
    MsgBox "", vbOKOnly Or vbInformation, "Error"
    Exit Sub
End If
    
End Sub


Private Sub Form_Unload(Cancel As Integer)
Dim lErrCde As Long

If (m_lDevHandle <> 0) Then
    lErrCde = DRV_DeviceClose(m_lDevHandle)
    If (lErrCde <> SUCCESS) Then
        ErrReport lErrCde
        MsgBox "Can not close device. There maybe some memory lease", vbOKOnly, "Error"
    End If
End If
End Sub


⌨️ 快捷键说明

复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?