?? form1.frm
字號:
VERSION 5.00
Object = "{648A5603-2C6E-101B-82B6-000000000014}#1.1#0"; "MSCOMM32.OCX"
Begin VB.Form Form1
Caption = "qzx5/x6"
ClientHeight = 2670
ClientLeft = 60
ClientTop = 345
ClientWidth = 4695
ControlBox = 0 'False
LinkTopic = "Form1"
ScaleHeight = 2670
ScaleWidth = 4695
StartUpPosition = 2 '屏幕中心
Begin VB.CommandButton Command3
Caption = "退出"
Height = 315
Left = 3000
TabIndex = 22
Top = 2160
Width = 1155
End
Begin VB.Timer Timer1
Enabled = 0 'False
Interval = 2000
Left = 2100
Top = 1680
End
Begin MSCommLib.MSComm MSComm1
Left = 2040
Top = 840
_ExtentX = 1005
_ExtentY = 1005
_Version = 393216
DTREnable = -1 'True
BaudRate = 300
InputMode = 1
End
Begin VB.CommandButton Command2
Caption = "15/16表召測"
Height = 315
Left = 3000
TabIndex = 21
Top = 1740
Width = 1155
End
Begin VB.CommandButton Command1
Caption = "05/06表召測"
Height = 315
Left = 3000
TabIndex = 17
Top = 1320
Width = 1155
End
Begin VB.TextBox Text1
Height = 270
Left = 3420
TabIndex = 16
Text = "0"
Top = 840
Width = 615
End
Begin VB.ComboBox Combo2
Height = 300
ItemData = "Form1.frx":0000
Left = 3420
List = "Form1.frx":0010
TabIndex = 15
Text = "1"
Top = 480
Width = 855
End
Begin VB.ComboBox Combo1
Height = 300
ItemData = "Form1.frx":0020
Left = 3420
List = "Form1.frx":0036
Style = 1 'Simple Combo
TabIndex = 14
Text = "300"
Top = 120
Width = 855
End
Begin VB.Label Label1
Caption = "地址："
Height = 195
Index = 7
Left = 2940
TabIndex = 20
Top = 900
Width = 555
End
Begin VB.Label Label1
Caption = "端口："
Height = 195
Index = 6
Left = 2940
TabIndex = 19
Top = 540
Width = 555
End
Begin VB.Label Label1
Caption = "波特率："
Height = 195
Index = 5
Left = 2760
TabIndex = 18
Top = 180
Width = 735
End
Begin VB.Label Label3
Caption = "Hz"
Height = 195
Index = 3
Left = 1740
TabIndex = 13
Top = 1560
Width = 195
End
Begin VB.Label Label3
Caption = "W"
Height = 195
Index = 2
Left = 1740
TabIndex = 12
Top = 1140
Width = 195
End
Begin VB.Label Label3
Caption = "A"
Height = 195
Index = 1
Left = 1740
TabIndex = 11
Top = 720
Width = 195
End
Begin VB.Label Label3
Caption = "V"
Height = 195
Index = 0
Left = 1740
TabIndex = 10
Top = 300
Width = 195
End
Begin VB.Label Label2
Alignment = 1 'Right Justify
Height = 195
Index = 4
Left = 900
TabIndex = 9
Top = 1980
Width = 795
End
Begin VB.Label Label2
Alignment = 1 'Right Justify
Height = 195
Index = 3
Left = 900
TabIndex = 8
Top = 1560
Width = 795
End
Begin VB.Label Label2
Alignment = 1 'Right Justify
Height = 195
Index = 2
Left = 900
TabIndex = 7
Top = 1140
Width = 795
End
Begin VB.Label Label2
Alignment = 1 'Right Justify
Height = 195
Index = 1
Left = 900
TabIndex = 6
Top = 720
Width = 795
End
Begin VB.Label Label2
Alignment = 1 'Right Justify
Height = 195
Index = 0
Left = 900
TabIndex = 5
Top = 300
Width = 795
End
Begin VB.Label Label1
Caption = " PF ："
Height = 195
Index = 4
Left = 300
TabIndex = 4
Top = 1980
Width = 555
End
Begin VB.Label Label1
Caption = "頻率："
Height = 195
Index = 3
Left = 300
TabIndex = 3
Top = 1560
Width = 555
End
Begin VB.Label Label1
Caption = "功率："
Height = 195
Index = 2
Left = 300
TabIndex = 2
Top = 1140
Width = 555
End
Begin VB.Label Label1
Caption = "電流："
Height = 195
Index = 1
Left = 300
TabIndex = 1
Top = 720
Width = 555
End
Begin VB.Label Label1
Caption = "電壓："
Height = 195
Index = 0
Left = 300
TabIndex = 0
Top = 300
Width = 555
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim shuju As Variant '可用的接受數(shù)據(jù)
Private Type A_single
dblValue As Single
End Type
Private Type a_ByteAry
ByteVal(0 To 3) As Byte
End Type
Dim errt As String '出錯信息
Dim t_flag As Integer '通訊狀態(tài)標(biāo)記
Dim read_count As Integer '接收字節(jié)數(shù)
Dim shujut As Variant '全部接受數(shù)據(jù)
Dim s_flag As Boolean '可用數(shù)據(jù)在全部接受數(shù)據(jù)中的位置
Private Sub Command1_Click()
With MSComm1
'通訊口設(shè)置
If .PortOpen = True Then .PortOpen = False
.CommPort = Combo2.ListIndex + 1
.Settings = Combo1.Text + ",n,8,1"
If .PortOpen = False Then .PortOpen = True
.RThreshold = 20
t = qz8700(Text1) '調(diào)用通訊函數(shù)
If t = True Then
crc = 0
s_flag = False
For TmpI = 0 To read_count - 2 '查找通訊頭
If shujut(TmpI) = &HAA And s_flag = False Then
ReDim shuju(read_count - TmpI - 1)
s_flag = True
i = 0
End If
If s_flag = True Then
crc = shujut(TmpI) + crc
shuju(i) = shujut(TmpI)
i = i + 1
End If
Next
If shujut(TmpI) = (crc Mod 256) Then
shuju(i) = shujut(TmpI)
Label2(0).Caption = fresult8700(0)
Label2(1).Caption = fresult8700(1)
Label2(2).Caption = fresult8700(2)
Label2(3).Caption = fresult8700(3)
MsgBox "通訊成功！"
Else
MsgBox errt & "校驗錯!" + Chr(10) + Chr(13)
End If
If .PortOpen = True Then .PortOpen = False
End If
End With
End Sub
Private Sub Command2_Click()
With MSComm1
If .PortOpen = True Then .PortOpen = False
.CommPort = Combo2.ListIndex + 1
.Settings = Combo1.Text + ",n,8,1"
If .PortOpen = False Then .PortOpen = True
.RThreshold = 24
t = qz8700(Text1)
If t = True Then
crc = 0
s_flag = False
For TmpI = 0 To read_count - 2
If shujut(TmpI) = &HAA And s_flag = False Then
ReDim shuju(read_count - TmpI - 1)
s_flag = True
i = 0
End If
If s_flag = True Then
crc = shujut(TmpI) + crc
shuju(i) = shujut(TmpI)
i = i + 1
End If
Next
If shujut(TmpI) = (crc Mod 256) Then
shuju(i) = shujut(TmpI)
Label2(0).Caption = fresult8700(0)
Label2(1).Caption = fresult8700(1)
Label2(2).Caption = fresult8700(2)
Label2(3).Caption = fresult8700(3)
Label2(4).Caption = fresult8700(4)
MsgBox "通訊成功！"
Else
MsgBox errt & "校驗錯!" + Chr(10) + Chr(13)
End If
If .PortOpen = True Then .PortOpen = False
End If
End With
End Sub
Private Sub Command3_Click()
Unload Me
End Sub
Private Sub Form_Load()
Combo1.ListIndex = 0
Combo2.ListIndex = 0
End Sub
Private Sub mscomm1_OnComm()
'通訊中斷
Dim read_count As Integer
Dim crc As Long
Select Case MSComm1.CommEvent
Case comEvReceive
'接受中斷
Timer1.Enabled = False
t_flag = 1
Case comEventRxParity
'奇偶校驗錯中斷
Timer1.Enabled = False
t_flag = 2
errt = errt & "奇偶校驗錯!" + Chr(10) + Chr(13)
End Select
End Sub
Private Sub Timer1_Timer()
'通訊超時處理
Dim read_count As Integer
read_count = MSComm1.InBufferCount
If read_count > 0 Then
'接受字節(jié)數(shù)不符
t_flag = 2
t = MSComm1.Input
Timer1.Enabled = False
errt = errt & "錯誤響應(yīng)!請檢查儀表類型！" + Chr(10) + Chr(13)
Else
'未接受到數(shù)據(jù)
t_flag = 3
errt = errt & "通訊超時!" + Chr(10) + Chr(13)
Timer1.Enabled = False
End If
End Sub
Public Function fresult8700(ByVal lo As Integer) As String '浮點數(shù)轉(zhuǎn)換函數(shù)，保留四位有效數(shù)
Dim byteAry As a_ByteAry
Dim dbl As A_single
For i = 0 To 3
byteAry.ByteVal(i) = Val(shuju(i + 3 + lo * 4))
Next i
LSet dbl = byteAry
s = CCur(dbl.dblValue)
If s < 1 Then
s0 = Format(s, "0.000")
s1 = " "
ElseIf s < 1000 Then
s0 = s
s1 = " "
ElseIf s > 1000 And s < 1000000 Then
s0 = s / 1000
s1 = "k"
ElseIf s > 1000000 Then
s0 = s / 1000000
s1 = "m"
End If
s = CStr(s0)
rep:
If InStr(1, s, ".") = 1 Then s = "0" + s
s0 = InStr(1, s, ".")
Select Case Len(s)
Case Is > 4
If Val(Mid(s, 6, 1)) > 5 Then
s = CStr(Round(Val(s), 5 - s0))
GoTo rep
Else
fresult8700 = Left(s, 5) + s1
End If
Case Is = 4
fresult8700 = s + "0" + s1
Case Is = 3
If s0 > 0 Then
fresult8700 = s + "00" + s1
Else
fresult8700 = s + ".0" + s1
End If
Case Is = 2
fresult8700 = s + ".00" + s1
Case Is = 1
fresult8700 = s + ".000" + s1
End Select
End Function
Private Function qz8700(ByVal add As Integer) As Boolean '通訊函數(shù)
On Error GoTo errs
With MSComm1
ReDim fx(3) As Byte
errt = ""
fx(0) = &H55
fx(1) = add '儀表地址
fx(2) = &H10
crc = 0
For i = 0 To 2
crc = crc + fx(i)
Next
fx(3) = crc Mod 256
t_flag = 0
tmp = .Input
.Output = fx
Timer1.Enabled = True
Do
If t_flag <> 0 Then
If t_flag = 1 Then
read_count = .InBufferCount
shujut = .Input
qz8700 = True
Else
MsgBox errt
qz8700 = False
End If
Exit Do
End If
DoEvents
Loop
End With
Exit Function
errs:
Timer1.Enabled = False
MsgBox Err.Description
qz8700 = False
End Function
?? 快捷鍵說明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -