Anbai 512电阻仪控件封装及VB6.0测量程序

封装Anbai 512控件

---

---

前言

Anbai 512是一款测量电阻的仪器，可用来测量pt1000的电阻，但自带程序很难在测量程序中整合。为方便集成到VB6测量程序中，需要开发出VB6控件，以实现打开设备（建立通信），采集数据，关闭设备（停止通信）功能。

---

一、Anbai 512控件开发平台

系统：win11
开发语言：VB6
说明：开发出来的控件能够在win10和win11上正常运行，其他平台尚未测试。

二、Anbai 512封装过程

1.程序设计简要说明

打开设备openDevice(comID)->采集数据revData->关闭设备closeDevice。
额外功能：可通过initDevice函数配置端口号，波特率，校验码，数据位，停止位信息。

2.程序对象界面

3.程序代码如下

Option Explicit
Option Base 1 '限定动态数组下标从1开始

Dim baudRate As Long '波特率
Dim comNum As Integer '通道号
Dim check As String '校验码
Dim dataBits As Integer '数据位数
Dim stopBits As Integer '停止位数
Dim bInit As Boolean '记录初始化是否成功
Dim bCon As Boolean '记录连接状态
Public readyRead As Boolean '是否能读
Dim revStr As String '记录原始接收数据
Public dataStr As String '记录字符串数据
Dim cntForRev As Integer

Private Function IsHex(c As String) As Integer
    If c >= "0" And c <= "9" Then
      IsHex = Val(c) - Val("0")
    ElseIf c >= "a" And c <= "f" Then
      IsHex = Asc(c) - Asc("a") + 10
    ElseIf c >= "A" And c <= "F" Then
      IsHex = Asc(c) - Asc("A") + 10
    Else
      IsHex = 16
    End If
End Function

Public Function initDevice(com As Integer, rate As Long, bits As Integer, stopBit As Integer, parity As String) As Boolean
    bInit = True
    setDevice com, rate, bits, stopBit, parity
    If bInit = False Then
        initDevice = False
        Exit Function
    End If
    initDevice = True
End Function

Public Function openDevice(comID As Integer) As Boolean
        '初始化基本配置
    '串口
    If comID >= 1 And comID <= 256 Then
        comNum = comID
    Else
        openDevice = False
        Exit Function
    End If
    
    '波特率
    If baudRate = 300 Or baudRate = 600 Or baudRate = 1200 Or baudRate = 2400 Or baudRate = 4800 Or baudRate = 9600 _
        Or baudRate = 19200 Or baudRate = 38400 Or baudRate = 56000 Or baudRate = 57600 Or baudRate = 115200 Then
        
    Else
        baudRate = 9600
    End If
    
    '校验码
    If check <> "N" And check <> "O" And check <> "E" Then
        check = "N"
    End If
    
    '数据位
    If dataBits <> 8 And dataBits <> 7 And dataBits <> 6 Then
        dataBits = 8
    End If
    
    '停止位
    If stopBits <> 2 And stopBits <> 1 Then
        stopBits = 1
    End If

    If connectDevice = False Then
        openDevice = False
        Exit Function
    End If
    openDevice = True
End Function

Private Sub setDevice(com As Integer, rate As Long, bits As Integer, stopBit As Integer, parity As String)
    '串口号
    If com > 0 Then
        comNum = com
    Else
        bInit = False
    End If
    
    '波特率
    Select Case rate
            Case 300 '300
                baudRate = 300
            Case 600 '600
                baudRate = 600
            Case 1200 '1200
                baudRate = 1200
            Case 2400 '2400
                baudRate = 2400
            Case 4800 '4800
                baudRate = 4800
            Case 9600 '9600
                baudRate = 9600
            Case 19200 '19200
                baudRate = 19200
            Case 38400 '38400
                baudRate = 38400
            Case 56000 '56000
                baudRate = 56000
            Case 57600 '57600
                baudRate = 57600
            Case 115200 '115200
                baudRate = 115200
            Case Else
                bInit = False
    End Select
    
    '数据位
    Select Case bits
        Case 8 '8位
            dataBits = 8
        Case 7 '7位
            dataBits = 7
        Case 6 '6位
            dataBits = 6
        Case Else
            bInit = False
    End Select
    
    '停止位
    If stopBit = 1 Or stopBit = 2 Then
        stopBits = stopBit
    Else
        bInit = False
    End If
    
    '校验位
    If parity = "N" Or parity = "n" Then
        check = CStr("N")
    ElseIf parity = "O" Or parity = "o" Then
        check = CStr("O")
    ElseIf parity = "E" Or parity = "e" Then
        check = CStr("E")
    Else
        bInit = False
    End If
    
End Sub

Private Function connectDevice() As Boolean
    Dim i As Integer
    On Error Resume Next
    Err.Clear

    '连接串口
    If MSComm1.PortOpen = True Then
        MSComm1.PortOpen = False
    End If
    MSComm1.CommPort = comNum
    MSComm1.Settings = CStr(baudRate) + "," + check + "," + CStr(dataBits) + "," + CStr(stopBits) '设置波特率及数据帧格式
    MSComm1.InputLen = 0             '读取接收缓冲区的所有字符
    MSComm1.InBufferSize = 256       '数据接受缓冲区大小为4000字节
    MSComm1.OutBufferSize = 256      '数据发送缓冲区大小为4000字节
    
    MSComm1.RThreshold = 1          '接受一个字节就产生ON_COMMM事件
    
    'MSComm1.SThreshold = 1          '发送缓冲区空触发发送事件
    'MSComm1.InputMode = comInputModeText  '字节模式
    
    
    '设定 InputMode 以读取二进位资料
    MSComm1.InputMode = comInputModeBinary
    
    MSComm1.PortOpen = True
    
    If Err.Number Then
        If Err.Number = 8002 Then
            '串口不存在
            connectDevice = False
        ElseIf Err.Number = 8005 Then
'            MsgBox "串口" + CStr(comNum) + "已打开！", vbOKOnly, "警告"
            connectDevice = True
            
        Else
            '其他错误
'            Text1.Text = "收到错误码：" + CStr(Err.Number)
'            Command1(0).Enabled = True
''            Command1(1).Enabled = True
'            Command4.Enabled = False
            connectDevice = False
            Err.Clear
            Exit Function
        End If
    Else '没有错误
        connectDevice = True
    End If
End Function

'采集数据
Private Sub collectData()
    Dim s As String
    Dim sz As Integer '记录输入字符串个数
    Dim i As Integer, cnt As Integer
    Dim a As Integer
    Dim temStr As String
    Dim deviceID As String

    Dim send_buf() As Byte

    ReDim send_buf(1024)
    
    dataStr = ""
    revStr = ""
    cntForRev = 0

    cnt = 0
    
    s = "66657463683F0A"
    
    Call sendOrders(s)
End Sub

Public Function closeDevice()
        '关闭串口
    If MSComm1.PortOpen = True Then
        MSComm1.PortOpen = False
    End If
End Function

Private Sub sendOrders(strOders As String)
    Dim sz As Integer '记录输入字符串个数
    Dim i As Integer, cnt As Integer
    Dim a As Integer
    Dim temStr As String
    Dim s As String

    Dim send_buf() As Byte

    ReDim send_buf(1024)

    cnt = 0
    s = Trim(strOders)
    sz = Len(s)
    
    If sz = 0 Then Exit Sub
    
    temStr = s
    '判断所有字符是否为16进制
    For i = 0 To sz - 1
        If IsHex(Left(temStr, 1)) = 16 Then
'            MsgBox "发送内容必须为16进制形式", vbOKOnly, "警告"
            Exit Sub
        End If
        temStr = Right(temStr, sz - 1 - i)
    Next i
    
    Do While (sz)

      a = IsHex(Left(s, 1))

      sz = sz - 1
      s = Right(s, sz)

      If sz <> 0 Then
         a = a * 16 + IsHex(Left(s, 1))
         sz = sz - 1
         s = Right(s, sz)
      End If
      
      cnt = cnt + 1
      send_buf(cnt) = a
      
    Loop

    If cnt > 128 Then cnt = 128
    ReDim Preserve send_buf(cnt) '保留原始数据并改变字符串长度

'    Text1.Text = CStr(send_buf())
    MSComm1.Output = send_buf() '发送16进制ASCII码字节流
'    curT = timeGetTime '记录发送时间
End Sub

Private Sub MSComm1_OnComm()

    Static cnt As Integer
    Dim receive_cnt As Integer
    Dim i As Integer

    Dim Buffer As Variant
    Dim Arr() As Byte
    Dim s As String
    
'    Static num As Integer
'    Text1.Text = Text1.Text + "计数：" + CStr(num) + "; "
'    num = num + 1

    Select Case MSComm1.CommEvent
        Case comEvReceive

            receive_cnt = MSComm1.InBufferCount   '接收缓冲区的字节数

            ' 往暂存区存二进位资料
            Buffer = MSComm1.Input
            ' 指定给位元组阵列以便处理
            Arr = Buffer
            
            s = ""
            For i = 0 To receive_cnt - 1

                If Arr(i) > 15 Then
'                    s = s + Hex(Arr(i)) + " "
                    revStr = revStr + Hex(Arr(i))
'                    Text1.Text = Text1.Text & s
                Else
'                    s = s + "0" + Hex(Arr(i)) + " "
                    revStr = revStr + "0" + Hex(Arr(i))
'                    Text1.Text = Text1.Text & s
                    If "0" + Hex(Arr(i)) = "0A" Then '判断结尾, 0A为安柏A512, 0D为ALicat
                        dataStr = analysData(revStr)
                        readyRead = True
                    End If
                End If

                cnt = cnt + 1

            Next i
            
            If cnt >= 300 Then
                cnt = 0
                Exit Sub
            End If
        Case comEvSend
            
        Case comEvEOF

    End Select
    
End Sub

Public Function revData() As String
    If revStr = "" Then
        Call collectData
    Else
        revData = analysData(revStr)
        revStr = ""
    End If
End Function

Private Function analysData(temStr As String) As String
    Dim sz As Long
    Dim i As Long
    Dim str As String
    
    str = ""
    sz = Len(temStr)
    For i = 0 To sz - 2 Step 2
        str = str + Chr(Val("&H" + Left(temStr, 2)))
        temStr = Right(temStr, sz - i - 2)
    Next i
    analysData = str
End Function

4.生成控件

控件生成方法可以自行百度。

三、Anbai 512控件使用案例

1.对象界面

控件注册后，添加控件，左上角空白区域。

2.采集程序代码

Option Explicit
Private Declare Function timeGetTime Lib "winmm.dll" () As Long
Private Sub Command1_Click()
    If AnbaiPt1.openDevice(Val(Text2.Text)) = True Then
        Command1.Caption = "已打开"
    End If
End Sub

Private Sub Command2_Click()
    AnbaiPt1.closeDevice
End Sub

Private Sub Command3_Click()
    Dim aPt As Double
    Dim bPt As Double
    Dim cPt As Double
    Dim temStr As String
    
    aPt = 1000#
    bPt = 0.0039083
    cPt = -5.775 * 10 ^ (-7)
    
    AnbaiPt1.revData
    delay 200
    If AnbaiPt1.readyRead Then
        Text1.Text = CStr(Round((-bPt + (bPt ^ 2 - 4 * cPt * (1 - Val(AnbaiPt1.dataStr) * 10 / aPt)) ^ 0.5) / 2 / cPt, 4))
    End If
End Sub

'毫秒级延时精度
Sub delay(T As Long)
    Dim time1 As Long
    time1 = timeGetTime
    Do
        DoEvents
        
    Loop While timeGetTime - time1 < T
End Sub

四、源文件访问

源码及控件：
链接：https://pan.baidu.com/s/1zuIgRFZI-cy5woe6-54Now
提取码：dk85