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