form2.frm

这是一个不错的can上位机程序

      Top             =   5280
      Width           =   1095
   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

' 用途：将十六进制转化为十进制       ----------在文本框中显示用
' 输入：Hex(十六进制数)
' 输入数据类型：String
' 输出：HEX_to_DEC(十进制数)
' 输出数据类型：Long
' 输入的最大数为7FFFFFFF,输出的最大数为2147483647
Public Function HEX_to_DEC(ByVal Hex As String) As Long
    Dim k As Long
    Dim B As Long
    
    Hex = UCase(Hex)
    For k = 1 To Len(Hex)
        Select Case Mid(Hex, Len(Hex) - k + 1, 1)
            Case "0": B = B + 16 ^ (k - 1) * 0
            Case "1": B = B + 16 ^ (k - 1) * 1
            Case "2": B = B + 16 ^ (k - 1) * 2
            Case "3": B = B + 16 ^ (k - 1) * 3
            Case "4": B = B + 16 ^ (k - 1) * 4
            Case "5": B = B + 16 ^ (k - 1) * 5
            Case "6": B = B + 16 ^ (k - 1) * 6
            Case "7": B = B + 16 ^ (k - 1) * 7
            Case "8": B = B + 16 ^ (k - 1) * 8
            Case "9": B = B + 16 ^ (k - 1) * 9
            Case "A": B = B + 16 ^ (k - 1) * 10
            Case "B": B = B + 16 ^ (k - 1) * 11
            Case "C": B = B + 16 ^ (k - 1) * 12
            Case "D": B = B + 16 ^ (k - 1) * 13
            Case "E": B = B + 16 ^ (k - 1) * 14
            Case "F": B = B + 16 ^ (k - 1) * 15
        End Select
    Next k
    HEX_to_DEC = B
End Function
Private Sub Form_Load()
    m_devtype = 5 'PCI9820类型号
    m_connect = 0 '默认此时的连接成功
    m_cannum = 0
    'Combo1.ListIndex = 0 '选择设备索引号为0
    'Combo2.ListIndex = 0 '选择第0路CAN
    'Combo3.ListIndex = 2 '发送格式选择自发自收
    'Combo4.ListIndex = 0 '帧类型为标准帧
    'Combo5.ListIndex = 0 '帧格式为数据帧
    'Combo6.ListIndex = 0 '滤波方式选择单滤波
    'Combo7.ListIndex = 0 '选择模式为正常模式
End Sub

Private Sub Combo8_Click()
If Combo8.Text = "5" Then     '选择波特率,确定定时器的定时
Text5.Text = "BF"
Text6.Text = "FF"
End If
If Combo8.Text = "10" Then
Text5.Text = "31"
Text6.Text = "1C"
End If
If Combo8.Text = "20" Then
Text5.Text = "53"
Text6.Text = "2F"
End If
If Combo8.Text = "40" Then
Text5.Text = "87"
Text6.Text = "FF"
End If
If Combo8.Text = "50" Then
Text5.Text = "47"
Text6.Text = "2F"
End If
If Combo8.Text = "80" Then
Text5.Text = "83"
Text6.Text = "FF"
End If
If Combo8.Text = "100" Then
Text5.Text = "43"
Text6.Text = "2F"
End If
If Combo8.Text = "125" Then
Text5.Text = "03"
Text6.Text = "1C"
End If
If Combo8.Text = "200" Then
Text5.Text = "81"
Text6.Text = "FA"
End If
If Combo8.Text = "250" Then
Text5.Text = "01"
Text6.Text = "1C"
End If
If Combo8.Text = "400" Then
Text5.Text = "80"
Text6.Text = "FA"
End If
If Combo8.Text = "500" Then
Text5.Text = "00"
Text6.Text = "1c"
End If
If Combo8.Text = "666" Then
Text5.Text = "80"
Text6.Text = "B6"
End If
If Combo8.Text = "800" Then
Text5.Text = "00"
Text6.Text = "16"
End If
If Combo8.Text = "1000" Then     '1M
Text5.Text = "00"
Text6.Text = "14"
End If

End Sub

Private Sub Connect_Click()                '连接CAN
    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                        '初始化CAN的数据类型
    
    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                    '第几路CAN
        filtertype = Combo6.ListIndex                '滤波
        Mode = Combo7.ListIndex                      '模式
        code = Val("&H" + Text2.Text)                '验收码
        mask = Val("&H" + Text3.Text)                '屏蔽码
        Timing0 = Val("&H" + Text5.Text)             '定时器0
        Timing1 = Val("&H" + Text6.Text)             '定时器1
        
        '初始化赋值
        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      'm_devtype：设备索引类型号 index：设备索引号
            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 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   '定义CAN信息帧的数据类型
    Dim str As String
    Dim num(7) As String
    Dim a  As Long
    Dim str1 As String
    Dim Temp(99) As Double
    Dim n
    Dim j
    SendType = Combo3.ListIndex        '发送格式
    frameformat = Combo5.ListIndex     '桢格式
    frametype = Combo4.ListIndex       '桢类型
    str = "&H"
    str = str + Text1.Text
    ID = Val(str)                      '桢ID
    str = Text4.Text
    strdata = " "
    i = 0
    For i = 0 To 7                     '把将要发送的数据存入数组data[8]中
    
       strdata = Left(str, 2)
       If Len(strdata) = 0 Then
          Exit For
       End If
       str = Right(str, Len(str) - 3)
       data(i) = Val("&H" + strdata)
       num(i) = strdata
    Next
    
                                       '定义信息桢的类型
    frameinfo.DataLen = i
    frameinfo.ExternFlag = frametype
    'frameinfo.RemoteFlag = frameformat
    frameinfo.SendType = SendType      '发送格式
    frameinfo.ID = ID
    
    For j = 0 To i - 1                '将数组data[8]中的数据依次写入CAN卡中去
        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
   
    Text7.Text = ""
    For i = 0 To 7
     a = HEX_to_DEC(num(i))
     
    If a <> 0 Then
    Text7.Text = Text7.Text + CStr(a)
    End If
    Picture1.Cls '首先清除picture1内的图形
    Picture1.ScaleMode = 0
    Picture1.ScaleMode = 2
    Picture1.Scale (0, 100)-(100, -100) 'Scale方法设定用户坐标系，坐标原点在Picture1中心
    Picture1.DrawWidth = 1 '设置绘线宽度
    Picture1.Line (0, 0)-(100, 0), vbBlue
    Picture1.Line (99, 0.5)-(100, 0), vbBlue
    Picture1.Line -(99, -0.5), vbBlue
    Picture1.ForeColor = vbBlue
    Picture1.Print "X" '绘坐标系的X轴及箭头线
    Picture1.Line (0, 100)-(0, -100), vbBlue
    Picture1.Line (0.5, 99)-(0, 100), vbBlue
    Picture1.Line -(-0.5, 99), vbBlue
    Picture1.Print "T" '绘坐标系的Y轴及箭头线
    Picture1.CurrentX = 0.5
    Picture1.CurrentY = -0.5
    Picture1.Print "O" '指定位置显示原点O
    Picture1.DrawWidth = 2 '重设绘线宽度
    
    If CStr(a) = "" Then
        j = 0
    Else
        j = a
    End If
    
        For n = 99 To 1 Step -1
          Temp(n) = Temp(n - 1)
        Next
         Temp(0) = j
         If Temp(n) > 100 Or Temp(n) < -100 Then
                MsgBox "WARNING:输入的数据超出范围，是非正常信号"
        Else
               For n = 0 To 99 Step 1
            
                   Picture1.PSet (n, Temp(n)), vbRed
            
               Next
        End If
    
 Next
   
End Sub

Private Sub Command2_Click()              '启动CAN
    If m_connect = 0 Then
        MsgBox ("请先打开端口")
        Exit Sub
    End If
    If VCI_StartCAN(m_devtype, m_devind, m_cannum) <> 1 Then  '判断启动CAN信息
        MsgBox ("启动CAN错误")
    Else
        List1.AddItem "启动CAN成功", List1.ListCount
    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  'CAN的数据类型
    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
    
   '****************************在list1 中将接收数据信息显示出来********************
    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



Private Sub Command3_Click()               '复位CAN
        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 Command6_Click()
If m_connect = 0 Then
        MsgBox ("请先打开端口")
        Exit Sub
    End If
    
End Sub

Private Sub Command7_Click()               '清空绘图
List1.Clear
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