canform.frm

vb书本教材

      Begin VB.Shape Shape2 
         FillColor       =   &H0080FFFF&
         FillStyle       =   0  'Solid
         Height          =   975
         Index           =   0
         Left            =   840
         Top             =   810
         Width           =   375
      End
      Begin VB.Shape Shape1 
         FillColor       =   &H00C0FFFF&
         FillStyle       =   0  'Solid
         Height          =   375
         Index           =   8
         Left            =   5280
         Shape           =   3  'Circle
         Top             =   1740
         Width           =   375
      End
      Begin VB.Shape Shape1 
         FillColor       =   &H00C0FFFF&
         FillStyle       =   0  'Solid
         Height          =   375
         Index           =   7
         Left            =   5280
         Shape           =   3  'Circle
         Top             =   1080
         Width           =   375
      End
      Begin VB.Shape Shape1 
         FillColor       =   &H00C0FFFF&
         FillStyle       =   0  'Solid
         Height          =   375
         Index           =   6
         Left            =   5280
         Shape           =   3  'Circle
         Top             =   390
         Width           =   375
      End
      Begin VB.Shape Shape1 
         FillColor       =   &H00C0FFFF&
         FillStyle       =   0  'Solid
         Height          =   375
         Index           =   5
         Left            =   3330
         Shape           =   3  'Circle
         Top             =   1740
         Width           =   375
      End
      Begin VB.Shape Shape1 
         FillColor       =   &H00C0FFFF&
         FillStyle       =   0  'Solid
         Height          =   375
         Index           =   4
         Left            =   3330
         Shape           =   3  'Circle
         Top             =   1080
         Width           =   375
      End
      Begin VB.Shape Shape1 
         FillColor       =   &H00C0FFFF&
         FillStyle       =   0  'Solid
         Height          =   375
         Index           =   3
         Left            =   3330
         Shape           =   3  'Circle
         Top             =   390
         Width           =   375
      End
      Begin VB.Shape Shape1 
         FillColor       =   &H00C0FFFF&
         FillStyle       =   0  'Solid
         Height          =   375
         Index           =   2
         Left            =   1320
         Shape           =   3  'Circle
         Top             =   1740
         Width           =   375
      End
      Begin VB.Shape Shape1 
         FillColor       =   &H00C0FFFF&
         FillStyle       =   0  'Solid
         Height          =   375
         Index           =   1
         Left            =   1320
         Shape           =   3  'Circle
         Top             =   1080
         Width           =   375
      End
      Begin VB.Shape Shape1 
         FillColor       =   &H00C0FFFF&
         FillStyle       =   0  'Solid
         Height          =   375
         Index           =   0
         Left            =   1320
         Shape           =   3  'Circle
         Top             =   390
         Width           =   375
      End
   End
End
Attribute VB_Name = "CANForm"
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
Dim addrdata(10, 5) As String
Dim CANid(50) As String
Dim CANaddr(50) As String
Dim CANn(50) As String
Dim CANnum As Integer
Dim kkk As Integer
'程序初始化
Private Sub Form_Load()
  m_devtype = 5
  m_connect = 0
  m_cannum = 0
  'Call Connect_CAN
  'Call start_CAN
End Sub
'连接板卡设备
Public Sub Connect_CAN()
  Dim Index, CANnum, 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
    VCI_CloseDevice m_devtype, m_devind
    Exit Sub
  End If
  Index = 0: CANnum = 0
  filtertype = 1: Mode = 0
  code = Val("&H" + "00000000")
  mask = Val("&H" + "FFFFFFFF")
  Timing0 = Val("&H" + "18")
  Timing1 = Val("&H" + "1c")
  
  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 ("打开设备错误")
    Exit Sub
  Else
    If VCI_InitCAN(m_devtype, Index, CANnum, InitConfig) = 1 Then
      m_connect = 1
      m_devind = Index
      m_cannum = CANnum
    Else
      MsgBox ("初始化CAN错误")
      Exit Sub
    End If
  End If
End Sub
'启动板卡设备
Public Sub start_CAN()
  If m_connect = 0 Then
    MsgBox ("请先打开端口")
    Unload Me
    Exit Sub
  End If
  If VCI_StartCAN(m_devtype, m_devind, m_cannum) <> 1 Then
    MsgBox ("启动CAN错误")
    Unload Me
    Exit Sub
  End If
End Sub
'赋地址值
Sub get_addr()
  addrdata(1, 1) = "1": addrdata(1, 2) = "01": addrdata(1, 3) = "01"
  addrdata(2, 1) = "2": addrdata(2, 2) = "01": addrdata(2, 3) = "02"
  addrdata(3, 1) = "3": addrdata(3, 2) = "01": addrdata(3, 3) = "03"
  addrdata(4, 1) = "4": addrdata(4, 2) = "02": addrdata(4, 3) = "01"
  addrdata(5, 1) = "5": addrdata(5, 2) = "02": addrdata(5, 3) = "02"
  addrdata(6, 1) = "6": addrdata(6, 2) = "02": addrdata(6, 3) = "03"
  addrdata(7, 1) = "7": addrdata(7, 2) = "03": addrdata(7, 3) = "01"
  addrdata(8, 1) = "8": addrdata(8, 2) = "03": addrdata(8, 3) = "02"
  addrdata(9, 1) = "9": addrdata(9, 2) = "03": addrdata(9, 3) = "03"
End Sub
'选择要打开的指示灯并获得其地址
Private Sub Cmdopen_Click()
  Dim kk As Integer
  Call get_addr
  kk = 1
  CANnum = 0
  For i = 0 To 8
    CANn(kk) = 0
    If Check1(i).Value = 1 Then
      CANn(kk) = i + 1
      CANnum = CANnum + 1
      kk = kk + 1
      Shape1(i).FillColor = QBColor(12)
    End If
  Next i
  For i = 1 To CANnum
      For k = 1 To 9
        If CANn(i) = Trim$(addrdata(k, 1)) Then
           CANid(i) = Trim$(addrdata(k, 2))
           CANaddr(i) = Trim$(addrdata(k, 3))
        End If
      Next k
   Next i
   kkk = 1
   Timer1.Enabled = True
End Sub
'依次打开指定的指示灯
Private Sub Timer1_Timer()
   Dim frameinfo As VCI_CAN_OBJ
   If kkk > CANnum Then
     Timer1.Enabled = False
     Exit Sub
   End If
   If m_connect = 0 Then
     MsgBox ("请先打开端口")
     Exit Sub
   End If
   frameinfo.DataLen = 8
   frameinfo.ExternFlag = 0
   frameinfo.RemoteFlag = 0
   frameinfo.SendType = 0
   frameinfo.ID = Val("&H" + CANid(kkk))
   frameinfo.data(0) = Val("&H" + "44")
   frameinfo.data(1) = Val("&H" + "43")
   frameinfo.data(2) = Val("&H" + CANaddr(kkk))
   frameinfo.data(3) = Val("&H" + "aa")
   If VCI_Transmit(m_devtype, m_devind, m_cannum, frameinfo, 1) <> 1 Then
     MsgBox ("发送数据失败")
   End If
   kkk = kkk + 1
End Sub
'关闭设备、程序
Private Sub Cmdquit_Click()
  If m_connect = 1 Then
    m_connect = 0
    VCI_CloseDevice m_devtype, m_devind
  End If
  Unload Me
End Sub