高精度电压表(24bit) VB源程序
Dim PortValue As Integer '端口号选择1-4
Dim value As Double '当前一次取值
Dim value2 As Double '要显示的值
Dim valueSum As Double '和
Dim numCount As Double '算平均值是的计数个数
Dim func As Integer '功能号标志1-4
Dim valueFlag As Integer
Private Sub Check1_Click()
'自动刷新 被选中则 刷新按钮无效
If Check1.value Then
Command1.Enabled = False
Else
Command1.Enabled = True
Command1.SetFocus
End If
End Sub
Private Sub Command1_Click()
'显示
Call display
End Sub
Private Sub Command2_Click()
valueSum = 0 '清计数和
numCount = 1 '清计数个数
Label6.Caption = Str(numCount - 1) '显示复位
value = 0
value2 = 0
valueFlag = 0
Call display
End Sub
Private Sub Form_Activate()
numCount = 1
value = 0
valueSum = 0
PortValue = 1
Text1.Visible = False
Label6.Caption = "0"
Option1(0).value = True
Option2(0).value = True
Command1.SetFocus
Label1.Caption = Format(value2 0.000,000 )
For i = 0 To 3
If Option2(i).value = True Then
func = i + 1
End If
Next i
Check1.value = 1
'Call ComPortOpen
End Sub
Public Sub ComPortOpen() '开串口
With MSComm1
.CommPort = PortValue '使用COM1
.Settings = "9600 N 8 1 '设置通信口参数
.InBufferSize = 40
'设置MSComm1接收缓冲区为40字节
'.OutBufferSize = 2
'设置MSComm1发送缓冲区为2字节
.InputMode = comInputModeBinary
'设置接收数据模式为二进制形式
.InputLen = 1
'设置Input 一次从接收缓冲读取字节数为1
'.SThreshold = 1
'设置Output 一次从发送缓冲读取字节数为1
.InBufferCount = 0 '清除接收缓冲区
'.OutBufferCount = 0 '清除发送缓冲区
'MaxW = -99
'最大值赋初值
'MinW = 99 '最小值赋初值
'w = 0
'数据个数计数器清零
.RThreshold = 1
On Error Resume Next
'设置接收一个字节产生OnComm事件
If .PortOpen = False Then
'判断通信口是否打开
.PortOpen = True '打开通信口
If Err Then '错误处理
msg = MsgBox(" 串口 COM" & PortValue & " 无效！ " vbOKOnly 警告 )
Exit Sub
End If
End If
End With
'MsgBox "端口已打开"
End Sub
Public Sub ComPortClose() '关串口
MSComm1.PortOpen = False
' MsgBox "端口已关闭"
End Sub
Private Sub MSComm1_OnComm()
Call recive
End Sub
Private Sub Option1_Click(Index As Integer)
If MSComm1.PortOpen = True Then
Call ComPortClose
End If
PortValue = Index + 1
Call ComPortOpen
End Sub
Private Sub recive() '检测起始位并接收数据
Dim Buffer As Variant
Dim Arr() As Byte
Dim inData(5) As Byte
Dim count As Integer
Dim temp As Byte
' MsgBox "OnComm"
With MSComm1
Select Case .CommEvent
'判断MSComm1通信事件
Case comEvReceive
'收到Rthreshold个字节产生的接收事件
Buffer = .Input
Arr = Buffer
'读取一个接收字节
' Text1.Text = Arr(0)
If Arr(0) = &H1B Then
.RThreshold = 0
Do
DoEvents
Loop Until .InBufferCount >= 4
For i = 1 To 4
'count = .InBufferCount
Buffer = .Input
Arr = Buffer
inData(i) = Arr(0)
Next i
If inData(4) = &HA Then
If (inData(1) Mod 64) >= 32 Then
.RThreshold = 1
Exit Sub
End If
valueFlag = 1
'0.000003814697265625
temp = inData(1) Mod 16
If temp <= 7 Then
value = inData(1) Mod 8
value = value * 256 * 256
value = value + Val(inData(2)) * 256
value = value + Val(inData(3))
value = value * 3.814697265625E-06
'Text1.Text = Format(value 0.000,000 )
Else
value = inData(1) Mod 8
value = value * 256 * 256
value = value + Val(inData(2)) * 256
value = value + Val(inData(3))
value = value * 3.814697265625E-06
value = 0 - value
End If
temp = inData(1) Mod 128
' test OF
If temp >= 64 Then
If value < 0 Then
value = value - 0.000004
Else
value = value + 0.000004
End If
End If
'检测自动刷新
If Check1.value Then
'valueFlag = 1
Call display
End If
Else
.RThreshold = 1
Exit Sub
End If
.InBufferCount = 0
.RThreshold = 1
End If
Case Else
End Select
End With
'Text1.Text = Text1.Text + 1
End Sub
Private Sub Option2_Click(Index As Integer)
func = Index + 1
End Sub
Public Sub display() '判断功能并显示
'功能选择
Select Case func
Case 1 '当前值
value2 = value
Case 2 '平均值
If numCount > 100000 Then
numCount = 1
valueSum = 0
End If
If valueFlag = 1 Then
valueSum = valueSum + value
value2 = valueSum / numCount
numCount = numCount + 1
valueFlag = 0
Label6.Caption = Str(numCount - 1)
End If
Case 3 '最大值
If value > value2 Then
value2 = value
End If
Case 4 '最小值
If value < value2 Then
value2 = value
End If
Case Else
End Select
'Text1.Text = Str(valueSum)
Label1.Caption = Format(value2 0.000,000 )
End Sub
Private Sub Timer1_Timer()'清缓冲区
' Text1.Text = MSComm1.InBufferCount
If MSComm1.InBufferCount >= 80 Then
MSComm1.InBufferCount = 0
End If
End Sub
/3 
文章评论（0条评论）
登录后参与讨论