form1.frm

ControlCAN 开发程序例程1

         TabIndex        =   10
         Top             =   360
         Width           =   1095
      End
      Begin VB.Label Label9 
         Caption         =   "设备索引号："
         Height          =   255
         Left            =   240
         TabIndex        =   9
         Top             =   360
         Width           =   1095
      End
   End
   Begin VB.Frame Frame6 
      Caption         =   "信息"
      Height          =   2535
      Left            =   120
      TabIndex        =   18
      Top             =   3840
      Width           =   8655
      Begin VB.ListBox List1 
         Height          =   2205
         Left            =   120
         TabIndex        =   19
         Top             =   240
         Width           =   8415
      End
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim m_devtype As Long
Dim m_connect As Byte
Dim m_devind As Long
Dim m_cannum As Long


Private Sub Command1_Click()
    If m_connect = 0 Then
        MsgBox ("请先打开端口")
        Exit Sub
    End If
    
    Dim SendType, frameformat, frametype As Byte
    Dim ID As Long
    Dim data(7) As Byte
    Dim frameinfo As VCI_CAN_OBJ
    Dim str As String
    
    SendType = Combo3.ListIndex
    frameformat = Combo5.ListIndex
    frametype = Combo4.ListIndex
    str = "&H"
    str = str + Text1.Text
    ID = Val(str)
    str = Text4.Text
    strdata = " "
    i = 0
    For i = 0 To 7
       strdata = Left(str, 2)
       If Len(strdata) = 0 Then
          Exit For
       End If
       str = Right(str, Len(str) - 3)
       data(i) = Val("&H" + strdata)
    Next
    
    frameinfo.DataLen = i
    frameinfo.ExternFlag = frametype
    frameinfo.RemoteFlag = frameformat
    frameinfo.SendType = SendType
    frameinfo.ID = ID
    For j = 0 To i - 1
        frameinfo.data(j) = data(j)
    Next
    If VCI_Transmit(m_devtype, m_devind, m_cannum, frameinfo, 1) <> 1 Then
        MsgBox ("发送数据失败")
    Else
        List1.AddItem "发送数据成功", List1.ListCount
    End If

End Sub

Private Sub Command2_Click()
    If m_connect = 0 Then
        MsgBox ("请先打开端口")
        Exit Sub
    End If
    If VCI_StartCAN(m_devtype, m_devind, m_cannum) <> 1 Then
        MsgBox ("启动CAN错误")
    Else
        List1.AddItem "启动CAN成功", List1.ListCount
    End If
End Sub

Private Sub Command3_Click()
    If m_connect = 0 Then
        MsgBox ("请先打开端口")
        Exit Sub
    End If
    If VCI_ResetCAN(m_devtype, m_devind, m_cannum) <> 1 Then
        MsgBox ("复位CAN错误")
   Else
        List1.AddItem "复位CAN成功", List1.ListCount
    End If

End Sub

Private Sub Command4_Click()
    If m_connect = 0 Then
        MsgBox ("请先打开端口")
        Exit Sub
    End If
    
    Dim i As Long
    i = Combo1.ListIndex
    If i <> -1 Then
        If VCI_SetReference(m_devtype, m_devind, 0, 1, i) <> 1 Then
            MsgBox ("更改CAN波特率错误")
        Else
            List1.AddItem "更改CAN波特率成功", List1.ListCount
        End If
    End If

End Sub

Private Sub Command5_Click(index As Integer)
    If m_connect = 0 Then
        MsgBox ("请先打开端口")
        Exit Sub
    End If
    
    Dim i As Long
    i = Combo2.ListIndex
    If i <> -1 Then
        i = i + 1
        If VCI_SetReference(m_devtype, m_devind, 0, 3, i) <> 1 Then
            MsgBox ("更改232波特率错误")
        Else
            List1.AddItem "更改232波特率成功", List1.ListCount
        End If
    End If

End Sub

Private Sub Connect_Click()
    Dim index As Long
    Dim cannum As Long
    Dim code, mask As Long
    Dim Timing0, Timing1, filtertype, Mode As Byte
    Dim InitConfig As VCI_INIT_CONFIG
    
    If m_connect = 1 Then
        m_connect = 0
        Connect.Caption = "连接"
        VCI_CloseDevice m_devtype, m_devind
        Exit Sub
    End If
        
    If Combo1.ListIndex <> -1 And Combo2.ListIndex <> -1 Then
        index = Combo1.ListIndex
        cannum = Combo2.ListIndex
        filtertype = Combo6.ListIndex
        Mode = Combo7.ListIndex
        code = Val("&H" + Text2.Text)
        mask = Val("&H" + Text3.Text)
        Timing0 = Val("&H" + Text5.Text)
        Timing1 = Val("&H" + Text6.Text)
        InitConfig.AccCode = code
        InitConfig.AccMask = mask
        InitConfig.Filter = filtertype
        InitConfig.Mode = Mode
        InitConfig.Timing0 = Timing0
        InitConfig.Timing1 = Timing1
        
        If VCI_OpenDevice(m_devtype, index, 0) <> 1 Then
            MsgBox ("打开设备错误")
        Else
            If VCI_InitCAN(m_devtype, index, cannum, InitConfig) = 1 Then
                m_connect = 1
                m_devind = index
                m_cannum = cannum
                Connect.Caption = "断开"
            Else
                MsgBox ("初始化CAN错误")
            End If
        End If
    End If
    
End Sub

Private Sub Form_Load()
    m_devtype = 5 'PCI9820类型号
    m_connect = 0
    m_cannum = 0
    Combo1.ListIndex = 0
    Combo2.ListIndex = 0
    Combo3.ListIndex = 2
    Combo4.ListIndex = 0
    Combo5.ListIndex = 0
    Combo6.ListIndex = 0
    Combo7.ListIndex = 0
End Sub

Private Sub Form_Unload(Cancel As Integer)
    If m_connect = 1 Then
        m_connect = 0
        VCI_CloseDevice m_devtype, m_devind
    End If
End Sub





Private Sub Timer1_Timer()
    Timer1.Enabled = False
    Dim ErrInfo As VCI_ERR_INFO
    
    If m_connect = 0 Then
        Timer1.Enabled = True
        Exit Sub
    End If

    Dim length As Long
    Dim frameinfo(49) As VCI_CAN_OBJ
    Dim str As String
    
    length = VCI_Receive(m_devtype, m_devind, m_cannum, frameinfo(0), 50, 10)
    If length <= 0 Then
        VCI_ReadErrInfo m_devtype, m_devind, m_cannum, ErrInfo '注意：如果没有读到数据则必须调用此函数来读取出当前的错误码，
                                                               '千万不能省略这一步（即使你可能不想知道错误码是什么）
        Timer1.Enabled = True
        Exit Sub
    End If
    
    For i = 0 To length - 1
        str = "接收到数据帧:  "
        If frameinfo(i).TimeFlag = 0 Then
            tmpstr = "时间标识:无  "
        Else
            tmpstr = "时间标识:0x" + Hex(frameinfo(i).TimeStamp)
        End If
        str = str + tmpstr
        tmpstr = "  帧ID:0x" + Hex(frameinfo(i).ID)
        str = str + tmpstr
        str = str + "  帧格式:"
        If frameinfo(i).RemoteFlag = 0 Then
            tmpstr = "数据帧 "
        Else
            tmpstr = "远程帧 "
        End If
        str = str + tmpstr
        str = str + "  帧类型:"
        If frameinfo(i).ExternFlag = 0 Then
            tmpstr = "标准帧 "
        Else
            tmpstr = "扩展帧 "
        End If
        str = str + tmpstr
        List1.AddItem str, List1.ListCount
        If frameinfo(i).RemoteFlag = 0 Then
            str = "  数据:"
            If frameinfo(i).DataLen > 8 Then
                frameinfo(i).DataLen = 8
            End If
            For j = 0 To frameinfo(i).DataLen - 1
                tmpstr = Hex(frameinfo(i).data(j)) + " "
                str = str + tmpstr
            Next
            List1.AddItem str, List1.ListCount
        End If
    Next
    Timer1.Enabled = True
End Sub