frmmain.frm

CH341评估板

Private Sub eppromtype_Click(Index As Integer)
Select Case Index
      Case 0
         eepromid = ID_24C01
      Case 1
         eepromid = ID_24C02
      Case 2
         eepromid = ID_24C04
      Case 3
         eepromid = ID_24C08
      Case 4
         eepromid = ID_24C16
      Case 5
         eepromid = ID_24C32
      Case 6
         eepromid = ID_24C64
      Case 7
         eepromid = ID_24C128
      Case 8
         eepromid = ID_24C256
      Case 9
         eepromid = ID_24C512
      Case 10
         eepromid = ID_24C1024
      Case 11
         eepromid = ID_24C2048
      Case 12
         eepromid = ID_24C4096
  End Select
End Sub

Private Sub eppWrite0_Click()
    Dim mLen As Long
    Dim buffer As arrRBuffer
    
    mLen = HexToBcd(eppLen0.Text)
    If (mLen <= 0 Or Len(eppData0.Text) = 0) Then
        MsgBox "请输入要写的数据,长度！", vbExclamation, "CH341"
        Exit Sub
    End If
    If (mLen > Len(eppData0.Text) \ 2) Then
        mLen = Len(eppData0.Text) \ 2
    End If
    Call mStrtoVal(eppData0.Text, buffer, mLen)  '将输入的十六进制格式字符数据转成数值数据
    
    If (mOpen = True) Then
        If (CH341EppWriteData(mIndex, buffer, mLen) = False) Then
            MsgBox "EPP写数据块0失败！", vbExclamation, "CH341"
        End If
        eppLen0.Text = Hex(mLen)
    Else
        MsgBox "设备未打开！", vbExclamation, "CH341"
    End If
End Sub

Private Sub eppWrite1_Click()
    Dim mLen As Long
    Dim buffer As arrRBuffer
    
    mLen = HexToBcd(eppLen1.Text)
    
    If (mLen <= 0 Or Len(eppData1.Text) = 0) Then
        MsgBox "请输入写数据和长度！", vbExclamation, "CH341"
        Exit Sub
    End If
    
    If (mLen > Len(eppData1.Text) \ 2) Then
        mLen = Len(eppData1.Text) \ 2
    End If
    
    Call mStrtoVal(eppData1.Text, buffer, mLen)  '将输入的十六进制格式字符数据转成数值数据
   If (mOpen = True) Then
        If (CH341EppWriteAddr(mIndex, buffer, mLen) = False) Then
            MsgBox "EPP写数据块1失败！", vbExclamation, "CH341"
        End If
       eppLen1.Text = Hex(mLen)
    Else
        MsgBox "设备未打开！", vbExclamation, "CH341"
    End If
End Sub

Private Sub evtbtrefresh_Click()
Dim mBuf(0) As Byte
Dim mLen As Long

If mOpen = True Then
mLen = 1
If (memadd0(0).Value = True) Then
    If (CH341MemReadAddr0(mIndex, mBuf(0), mLen) = False) Then
       MsgBox "MEM地址方式读拔码开关状态失败！ ", vbExclamation, "CH341"
       Exit Sub
    End If
ElseIf (memadd1(1).Value = True) Then
    If (CH341MemReadAddr1(mIndex, mBuf(0), mLen) = False) Then
       MsgBox "MEM地址方式1读拔码开关状态失败！ ", vbExclamation, "CH341"
       Exit Sub
    End If
End If
'按钮状态显示
    If ((mBuf(0) And 1) = 0) Then
      swit(0).Value = 1
    Else
      swit(0).Value = 0
    End If
    If ((mBuf(0) And 2) = 0) Then
      swit(1).Value = 1
    Else
      swit(1).Value = 0
    End If
    If ((mBuf(0) And 4) = 0) Then
      swit(2).Value = 1
    Else
      swit(2).Value = 0
    End If
    If ((mBuf(0) And 8) = 0) Then
      swit(3).Value = 1
    Else
      swit(3).Value = 0
    End If
    If ((mBuf(0) And 16) = 0) Then
      swit(4).Value = 1
    Else
     swit(4).Value = 0
    End If
    If ((mBuf(0) And 32) = 0) Then
      swit(5).Value = 1
    Else
      swit(5).Value = 0
    End If
    If ((mBuf(0) And 64) = 0) Then
      swit(6).Value = 1
    Else
      swit(6).Value = 0
    End If
    If ((mBuf(0) And 128) = 0) Then
      swit(7).Value = 1
    Else
      swit(7).Value = 0
    End If
Else
    MsgBox "设备未打开！", vbExclamation, "CH341"
End If
End Sub

Private Sub Form_Load()
mIndex = 0
hopen = CH341OpenDevice(mIndex)
If (hopen = INVALID_HANDLE_VALUE) Then
    'MsgBox "打开设备失败", vbExclamation, "CH341PAR"
    mOpen = False
Else
    mOpen = True
End If
'设置设备插拔通知
If CH341SetDeviceNotify(mIndex, vbNullString, AddressOf mPCH341_NOTIFY_ROUTINE) = False Then
    MsgBox "设置设备插拔通知失败", vbExclamation, "CH341PAR"
End If
enablebtn (mOpen)
End Sub

Private Sub Form_Unload(Cancel As Integer)
CH341SetDeviceNotify mIndex, vbNullString, 0&
If (mOpen = True) Then
    CH341CloseDevice (mIndex)
End If
End Sub

Private Sub Led_Click(Index As Integer)
Dim mBuf(0) As Byte
Dim mLen As Long
If (mOpen = True) Then
  mLen = 1
  mBuf(0) = CByte((Led(0).Value * (2 ^ 7)) + (Led(1).Value * (2 ^ 6)) + (Led(2).Value * (2 ^ 5)) + (Led(3).Value * (2 ^ 4)) + (Led(4).Value * (2 ^ 3)) + (Led(5).Value * (2 ^ 2)) + (Led(6).Value * (2 ^ 1)) + (Led(7).Value * (2 ^ 0)))         '组合按钮键值
  If (memadd0(0).Value = True) Then '地址0
     If (CH341MemWriteAddr0(mIndex, mBuf(0), mLen) = False) Then
        MsgBox "发送LED状态值失败！", vbExclamation, "CH341"
     End If
  ElseIf (memadd1(1).Value = True) Then
     If (CH341MemWriteAddr1(mIndex, mBuf(0), mLen) = False) Then
        MsgBox "发送LED状态值失败！", vbExclamation, "CH341"
     End If
  End If
Else
  MsgBox "设备未打开！", vbExclamation, "CH341"
End If
End Sub

Private Sub memRead0_Click()
    Dim mLen As Long
    Dim buffer As arrRBuffer
    
    mLen = HexToBcd(memLen0.Text)
    
    If (mLen <= 0) Then
        MsgBox "请输入读取长度", vbExclamation, "CH341"
        Exit Sub
    End If
    
    If (mOpen = True) Then
        On Error Resume Next
            If (CH341MemReadAddr0(mIndex, buffer, mLen)) Then
                Dim buff As String
                Dim i As Long
                buff = ""
                For i = 0 To mLen - 1 Step 1
                    DoEvents
                    buff = buff & Hex2bit(buffer.buf(i)) + " "
                Next i
                memData0.Text = buff
            Else
                MsgBox "MEM读数据块0失败！ ", vbExclamation, "CH341"
            End If
            memLen0.Text = Hex(mLen)
    Else
         MsgBox "设备未打开！", vbExclamation, "CH341"
    End If
End Sub

Private Sub memRead1_Click()
    Dim mLen As Long
    Dim buffer As arrRBuffer
    
    mLen = HexToBcd(memLen1.Text)
    If (mLen <= 0) Then
        MsgBox "请输入读数据长度", vbExclamation, "CH341"
        Exit Sub
    End If
    
     If (mOpen = True) Then
        If (CH341MemReadAddr1(mIndex, buffer, mLen)) Then
            Dim buff As String
            Dim i As Long
            For i = 0 To mLen - 1
                buff = buff & Hex2bit(buffer.buf(i)) + " "
            Next i
            memData1.Text = buff
        Else
            MsgBox "MEM读数据块1失败！ ", vbExclamation, "CH341"
        End If
        memLen1.Text = Hex(mLen)
    Else
        MsgBox "设备未打开！", vbExclamation, "CH341"
    End If
End Sub

Private Sub memWrite0_Click()
    Dim mLen As Long
    Dim buffer As arrRBuffer
    
    mLen = HexToBcd(memLen0.Text)
    
    If (mLen <= 0 Or Len(memData0.Text) = 0) Then
        MsgBox "请输入要写的数据,长度！", vbExclamation, "CH341"
        Exit Sub
    End If
    
    If (mLen > Len(memData0.Text) / 2) Then
        mLen = Len(memData0.Text) / 2
    End If
    
    Call mStrtoVal(memData0.Text, buffer, mLen)    '将输入的十六进制格式字符数据转成数值数据
    If (mOpen = True) Then
        If (CH341MemWriteAddr0(mIndex, buffer, mLen) = False) Then
            MsgBox "MEM写数据块0失败！", vbExclamation, "CH341"
       End If
       memLen0.Text = Hex(mLen)
    Else
        MsgBox "设备未打开！", vbExclamation, "CH341"
    End If
End Sub

Private Sub memWrite1_Click()
    Dim mLen As Long
    Dim buffer As arrRBuffer
    
    mLen = HexToBcd(memLen1.Text)
    
    If (mLen <= 0 Or Len(memData1.Text) = 0) Then
        MsgBox "请输入要写入的数据,长度！", vbExclamation, "CH341"
        Exit Sub
    End If
    
    If (mLen > Len(memData1.Text) / 2) Then
        mLen = Len(memData1.Text) / 2
    End If
    
    Call mStrtoVal(memData1.Text, buffer, mLen)       '将输入的十六进制格式字符数据转成数值数据
    If (mOpen = True) Then
        If (CH341MemWriteAddr1(mIndex, buffer, mLen) = False) Then
            MsgBox "MEM写数据块0失败！", vbExclamation, "CH341"
       End If
       memLen1.Text = Hex(mLen)
    Else
        MsgBox "设备未打开！", vbExclamation, "CH341PAR"
    End If
End Sub

Private Sub SSTab1_Click(PreviousTab As Integer)

If (mOpen = True) And (SSTab1.Tab = 4) Then
   Call evtbtrefresh_Click
   Call Led_Click(0)
End If

End Sub

Private Sub StreamICRW_Click()
Dim mWrLen As Long
Dim mRdLen As Long
Dim iBuff As arrRBuffer
Dim buffer As arrRBuffer

mWrLen = HexToBcd(I2CWRLen.Text)
mRdLen = HexToBcd(I2CRDLen.Text)

If (mWrLen > 0 And I2CWRBuf.Text = "") Then
  MsgBox "请输入要写的数据,长度！", vbExclamation, "CH341"
  Exit Sub
End If
If ((mWrLen = 0) And (mRdLen = 0)) Then
  MsgBox "请输入读数据所需的长度！", vbExclamation, "CH341"
  Exit Sub
End If
If (mWrLen > Len(Trim(I2CWRBuf.Text)) \ 2) Then
   mWrLen = Len(Trim(I2CWRBuf.Text)) \ 2
End If

Call mStrtoVal(I2CWRBuf.Text, buffer, mWrLen)       '将输入的十六进制格式字符数据转成数值数据

If (mOpen = True) Then
  If (CH341StreamI2C(mIndex, mWrLen, buffer, mRdLen, iBuff) = False) Then
     MsgBox "流模式读写数据失败！", vbExclamation, "CH341"
  Else
    If (mRdLen > 0) Then   '有数据返回
       Dim buff As String
       Dim i As Long
       For i = 0 To mRdLen - 1
         buff = buff & Hex2bit(iBuff.buf(i)) + " "
       Next
       I2CRDBuf.Text = buff
    End If
  End If
  I2CWRLen.Text = Hex(mWrLen)
  I2CRDLen.Text = Hex(mRdLen)
Else
  MsgBox "设备未打开！", vbExclamation, "CH341PAR"
End If
End Sub

Private Sub CH341_NOTIFY_ROUTINE_KeyUp(KeyCode As Integer, Shift As Integer)  '设备插拔通知处理程序
    Dim iEventStatus As Long
    iEventStatus = KeyCode '插拔事件
    If (iEventStatus = CH341_DEVICE_ARRIVAL) Then ' 设备插入事件,已经插入
        If (CH341OpenDevice(mIndex) = INVALID_HANDLE_VALUE) Then
            MsgBox "打开设备失败!", vbOK, "CH341PAR"
            mOpen = False
        Else
            mOpen = True  '打开成功
        End If
    ElseIf (iEventStatus = CH341_DEVICE_REMOVE) Then ' 设备拔出事件,已经拔出
        CH341CloseDevice (mIndex)
        mOpen = False
    End If
    enablebtn (mOpen) '设备打开,按钮可用,设备没打开,按钮禁用
End Sub

Public Sub enablebtn(ByVal bEnable As Boolean)  'bEnable=true :各窗体按钮可用 ;=false:enable:各窗体按钮禁用
  With frmMain
  
    .eppRead0.Enabled = bEnable
    .eppWrite0.Enabled = bEnable
    .eppRead1.Enabled = bEnable
    .eppWrite1.Enabled = bEnable
    
    .memRead0.Enabled = bEnable
    .memWrite0.Enabled = bEnable
    .memRead1.Enabled = bEnable
    .memWrite1.Enabled = bEnable
    
    .StreamICRW.Enabled = bEnable
    
    .eepromRdDate.Enabled = bEnable
    .eepromWrDate.Enabled = bEnable
    
    .evtbtrefresh.Enabled = bEnable
    .Led(0).Enabled = bEnable
    .Led(1).Enabled = bEnable
    .Led(2).Enabled = bEnable
    .Led(3).Enabled = bEnable
    .Led(4).Enabled = bEnable
    .Led(5).Enabled = bEnable
    .Led(6).Enabled = bEnable
    .Led(7).Enabled = bEnable
    
    If (bEnable = True) Then '窗体标题显示
        frmMain.Caption = "CH341EVT **设备已插上"
    Else
        frmMain.Caption = "CH341EVT **设备已拔出"
    End If
  End With
    
    If (bEnable = True) Then '数字I/O窗口已初始化,刷新LED,按拔码开关状态
        Call Led_Click(0)
        Call Led_Click(1)
        Call Led_Click(2)
        Call Led_Click(3)
        Call Led_Click(4)
        Call Led_Click(5)
        Call Led_Click(6)
        Call Led_Click(7)
        Call evtbtrefresh_Click
    End If
End Sub