新建 文本文档.txt

高精度电压表(24bit) VB源程序,简单修改可实现多量程

2005-11-28 14:43:33 
作者：liwenzhao
高精度电压表(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


一个简单的VB串口发送程序（源码） 
2005-11-28 14:45:21 
'-----发送按钮Click事件子程序-----------
Private Sub Fasong_Click()
Dim JIHAO(0) As Byte ’机号
Dim head_data(4) As Byte ’5 Byte控制字
Dim end_data(0) As Byte '1 Byte 结束字
JIHAO(0) = Val(Text3.Text)
head_data(0) = Val(Text4.Text)
head_data(2) = &HEE 'TIMH
head_data(3) = &HEE 'TIML
head_data(4) = Val(Combo1.Text) 'INMOD
end_data(0) = &HFF
If Combo2.Text = "增加" Then head_data(1) = &H99
If Combo2.Text = "清空" Then head_data(1) = &H33
If Combo2.Text = "删除" Then head_data(1) = &H32
Ready = 0: ErrCount = 0
On Error GoTo ERRORCOM ’打开错误处理
'----------------------------------------------------------
If com1.Value Then MSComm1.CommPort = 1 'Use com1
If com2.Value Then MSComm1.CommPort = 2 'Use com2

MSComm1.Settings = FORM1.Combo3.Text ",M,8,2" '设定波特率和置校验和位为1
MSComm1.InputLen = 0 '
MSComm1.PortOpen = -1 'Open the port
MSComm1.OutBufferCount = 0
MSComm1.Output = JIHAO ‘发送机号
MSComm1.PortOpen = False ’关闭串口
MSComm1.Settings = FORM1.Combo3.Text ",S,8,2" '设定波特率和置校验和位为空
MSComm1.OutBufferCount = 0
MSComm1.PortOpen = True
MSComm1.Output = head_data
MSComm1.Output = Text2.Text
MSComm1.Output = end_data
MSComm1.PortOpen = False
Text1.Text = "发送成功!" Chr(13) & Chr(10) "发送至" Text3.Text "屏体," "信息编号:" Text4.Text Chr(13) & Chr(10) Chr(13) & Chr(10) Text1.Text
GoTo comend
ERRORCOM:
Text1.Text = "ERROR!请重新选择COM口!" Chr(13) & Chr(10) Chr(13) & Chr(10) Text1.Text
comend:
On Error GoTo 0
End Sub