yunkongzhi.frm

串口调试工具

    Call DrawPushButton
    
    '加载指令集和通读参数
    Call Initial
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Dim iniFile As New clswenjian
    Dim bSuccess As Boolean
    '终止WinIo库
    ShutdownWinIo
    
    '清空配置文件
'    bSuccess = iniFile.DeleteFileEx(App.Path + "\" + strFileName)
    With iniFile
        .OpenFile (App.Path + "\" + strFileName)
        '存储通信方式
        .WriteByte bSerial

        '存储串口各参数
        .WriteByte conSerialPort.Parity
        .WriteLong conSerialPort.BaudRate
        .WriteLong conSerialPort.DataBits
        .WriteSingle conSerialPort.StopBits
        .WriteByte conSerialPort.PortNr

        '存储IO端口号
        .WriteLong IoPort
    
        '存储指令集
        .WriteArray ByteCodeChoose
        .WriteArray ByteCodeAct
        .WriteArray ByteCodeMir
        .WriteArray ByteCodeStatus
    
        '存储32个云台状态
        .WriteArray2Dim ByteStatus, 33, 3
    
        .CloseFile
    End With
End Sub



Private Sub labChoose_Click(index As Integer)
    picChoose_Click index
End Sub

'*********************************************
'功能：使指定按钮浮起
'参数：index，被浮起按钮在控件数组中的index值
'*********************************************
Private Sub LiftButton(index As Integer)
    InnerLineTop(index).BorderColor = brightRgb
    InnerLineLeft(index).BorderColor = brightRgb
    picChoose(index).BackColor = bkUpRgb
    shpFrame(index).BorderColor = frameRgb
End Sub

'*********************************************
'功能：使指定按钮下沉
'参数：index，被下沉按钮在控件数组中的index值
'*********************************************
Private Sub DownButton(index As Integer)
    InnerLineTop(index).BorderColor = darkRgb
    InnerLineLeft(index).BorderColor = darkRgb
    picChoose(index).BackColor = bkDownRgb
    shpFrame(index).BorderColor = bkUpRgb
End Sub

'*******************************************
'功能：响应对云台选择按钮和状态按钮的单击响应
'参数：Index:被点击的picChoose的index值
'*******************************************
Private Sub picChoose_Click(index As Integer)
    Dim i As Integer
    '点击选择云台按钮
    If index < 33 Then
        If index = curChoose Then Exit Sub
        '重画按钮，使原按钮浮起
        Call LiftButton(curChoose)
        '重画按钮，使当前被点击按钮凹下
        Call DownButton(index)
        curChoose = index
        '发送云台选择指令
        WriteToPort ByteCodeChoose(curChoose), 1
    
        '装载选中云台三状态（射灯、雨刷与自动），并取消原云台选中标志
        For i = 0 To 2
            If ByteStatus(curChoose, i) = 0 Then
                Call LiftButton(33 + i)
            Else
                Call DownButton(33 + i)
            End If
        Next i
    '点击状态切换按钮
    Else
      '改变云台指定状态值
        If ByteStatus(curChoose, index - 33) Then
            ByteStatus(curChoose, index - 33) = 0
            Call LiftButton(index)
        Else
            ByteStatus(curChoose, index - 33) = 1
            Call DownButton(index)
        End If
        
        '计算待发送指令值
        Dim code As Byte
        code = &HC0
        If ByteStatus(curChoose, 0) Then
            code = code + 1
        End If
        
        For i = 1 To 2
            If ByteStatus(curChoose, i) Then
                code = code + i * 2
            End If
        Next i
        '发送指令
        Call WriteToPort(code, 1)
    End If
End Sub

'状态栏消息，显示程序向解码器发送的控制码
Private Sub StatusInfo(strPort As String, strData As String)
    StatusBar1.Panels(1).Text = "通过" + strPort + "发送指令" + strData
End Sub

'******************************************************
'向串口或IO口发指令，程序上层界面与底层通信模块交互的唯一函数
'******************************************************
Private Sub WriteToPort(ByVal pData As Byte, datLen As Integer)
    On Error GoTo ErrProcess:
    '格式化状态栏消息参数Data
    Dim strPort As String
    Dim Data As String
    Dim bRet As Boolean
    Dim arData(0 To 0) As Byte
    
    Data = CBin(pData)
    arData(0) = pData
    
    If bSerial Then
        '格式化状态栏消息参数strPort
        strPort = "串口" + Str(conSerialPort.PortNr)
        '向串口发送指令
'        MSComm1.CommPort = conSerialPort.PortNr
        If MSComm1.PortOpen = False Then
            MSComm1.PortOpen = True
        End If
        MSComm1.Output = arData()
        MSComm1.PortOpen = False
    Else
        '格式化状态栏消息参数strPort
        strPort = "并口" + Str(IoPort)
        '向IO端口发送指令，若失败则在状态栏显示失败消息。
        '注意失败只可能由WinIO库初始化错误引起
        bRet = SetPortVal(IoPort, pData, Len(pData))
        If Not bRet Then
            Data = Data + "失败"
        End If
    End If
    '在状态栏显示传送指令信息
    StatusInfo strPort, Data
    Exit Sub
ErrProcess:
    MsgBox "错误提示：" + Err.Description, vbCritical
End Sub

'*********************************************
'功能：在未提供配置文件时，以默认指令集初始化各程序控制码
'*********************************************
Private Sub DefaultCodeSet()
    Dim i As Byte
    For i = 1 To 32
        ByteCodeChoose(i) = i
    Next i
    For i = 0 To 3
        ByteCodeAct(i) = &H40 + i
    Next i
    ByteCodeAct(4) = 0  'reset
    For i = 0 To 5
        ByteCodeMir(i) = &H80 + i
    Next i
    ByteCodeStatus(0) = &HC0 + 1
    For i = 1 To 2
        ByteCodeStatus(i) = &HC0 + i * 2
    Next i
End Sub

'*********************************************
'功能：在未提供配置文件时，以默认参数初始化串口和IO
'*********************************************
Private Sub DefaultPortSet()
    On Error GoTo ErrProcess:
    '串口的默认设置
    With conSerialPort
        .PortNr = 1
        .BaudRate = 9600
        .Parity = Asc("E")
        .DataBits = 7
        .StopBits = 1
        MSComm1.CommPort = .PortNr
        MSComm1.InputMode = comInputModeText
        MSComm1.Settings = Str(.BaudRate) + "," + Chr(.Parity) + "," + Str(.DataBits) + "," + Str(.StopBits)
    End With
    'IO口的默认设置
    IoPort = 956
    '默认启用串口
    bSerial = True
    MSComm1.InputLen = 0
    If MSComm1.PortOpen = False Then
        MSComm1.PortOpen = True
    End If
    
    Exit Sub
'错误处理:
ErrProcess:
    '有错误发生时MSComm1的最保守配置
    MSComm1.CommPort = 1
    MSComm1.InputMode = comInputModeText
    MSComm1.Settings = "9600,n,8,1"
    If MSComm1.PortOpen = False Then
        MSComm1.PortOpen = True
    End If
End Sub

'*******************************************
'功能：初使化用,加载指令集和串口、并口的通讯参数
'*******************************************
Private Sub Initial()
    '定义类模块clsFile对象，用于文件操作
    Dim iniFile As New clswenjian
    '标志
    Dim bSuccess As Boolean
    '文件操作时用，读取串口参数
    Dim Parity As Byte
    Dim PortNr As Byte
    Dim BaudRate As Long
    Dim DataBits As Long
    Dim StopBits As Single
    
On Error GoTo ErrProcess:

    '打开配置文件对象，配置文件存储程序通信方式及其参数、云台指令集与32云台状态
    bSuccess = iniFile.OpenFile(App.Path + "\" + strFileName)
    '若存在配置文件且配置文件不为空
    If iniFile.GetLength() = 0 Then
        '若不存在配置文件或配置文件为空，
        '并使用默认指令集初始化各控制码
        DefaultCodeSet
        '则使用默认串口参数初始化串口，
        DefaultPortSet
    Else
        With iniFile
            '由配置文件读入通信方式
            .ReadByte bSerial
        
            '由配置文件读入串口与IO口参数
             .ReadByte Parity
             .ReadLong BaudRate
             .ReadLong DataBits
             .ReadSingle StopBits
             .ReadByte PortNr
    
            '读入IO端口号
            .ReadLong IoPort
            
            '由配置文件读入指令集
            .ReadArray ByteCodeChoose
            .ReadArray ByteCodeAct
            .ReadArray ByteCodeMir
            .ReadArray ByteCodeStatus
            
            '由配置文件读入各云台状态
            .ReadArray2Dim ByteStatus, 33, 3
        End With
        '更新串口参数
        With conSerialPort
            .Parity = Parity
            .BaudRate = BaudRate
            .DataBits = DataBits
            .StopBits = StopBits
            .PortNr = PortNr
        End With
        
        '若通信使用串口，则初始化串口，并启动串口监听
        If bSerial = True Then
            If conSerialPort.PortNr < 1 Or conSerialPort.PortNr > 4 Then
                conSerialPort.PortNr = 1
            End If
            MSComm1.CommPort = conSerialPort.PortNr
            MSComm1.InputMode = comInputModeText
            MSComm1.Settings = Str(conSerialPort.BaudRate) + "," + _
                Chr(conSerialPort.Parity) + "," + Str(conSerialPort.DataBits) _
                + "," + Str(conSerialPort.StopBits)
            MSComm1.InputLen = 0
            ' 打开串口
            If MSComm1.PortOpen = False Then
                MSComm1.PortOpen = True
            End If
        '若通信使用并口，初始化WinIO库
        Else
            Dim bResult As Boolean
            bResult = InitializeWinIo()
            If Not bResult Then
                MsgBox ("WINIO库初始化失败")
            End If
        End If
    End If
    '读取完毕，关闭配置文件存档对象指针
    iniFile.CloseFile
    curChoose = 0
    '默认选择云台1
    picChoose_Click (1)
    Exit Sub
ErrProcess:
    DefaultCodeSet
    DefaultPortSet
    
    iniFile.CloseFile
    curChoose = 0
    picChoose_Click (1)
End Sub