📄 frm_readstat.frm
字号:
End
End
Attribute VB_Name = "Frm_readstat"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim i, arr_i As Byte
Dim ii As Integer
Dim outbyte() As Byte
Dim Inbyte() As Byte
Dim start, finish, totaltime As Long
Private Sub Com_cancel_Click()
Timer1.Enabled = False
Timer3.Enabled = False
Timer4.Enabled = False
If MSComm1.PortOpen Then MSComm1.PortOpen = False
end_s = True
MARK = 0 '发送完毕
Com_cancel.Visible = False
MousePointer = 0 '鼠标形状还原
Label13.Visible = False
ProgressBar1.Visible = False
End Sub
Private Sub Form_Load()
mtitle = "读状态"
End Sub
Private Sub Form_Unload(Cancel As Integer)
If MSComm1.PortOpen Then MSComm1.PortOpen = False
End Sub
Private Sub send_meter_Click() '发送到表
Dim gvbh_str(5) As Byte
Dim pp As Boolean
If end_s Then '正在通讯不执行发送.
'计算选择项数目
j = 0
For n = 17 To 30
If Check1(n).Value Then j = j + 1
Next
If j = 0 Then
Err.Number = 621 '没有选择命令项错误
GoTo line_err2
End If
MSComm1.CommPort = B_COMPORT
If MSComm1.PortOpen Then MSComm1.PortOpen = False
MSComm1.OutBufferSize = 1
On Error Resume Next
MSComm1.PortOpen = True
If Err.Number = 8002 Then
MsgBox "通讯端口号错误！", vbExclamation, mtitle '错误信息，一个确认键，标题栏文本
MARK = 0
Exit Sub
End If
MSComm1.InputMode = comInputModeBinary
'MSComm1.RThreshold = 1 '收到一个字符产生一次ONCOMM事件
MSComm1.InBufferCount = 0
MSComm1.PortOpen = False
Call chang_color '改变已抄数据的颜色为黑色
If Option3.Value Then
If Option1.Value Then
If Text0.Text <> "" Then
Else
line_err0: Err.Number = 2
line_err2: OnErrStatement (mtitle)
Exit Sub
End If
Else
If Text4.Text <> "" Then
Else
GoTo line_err0
End If
End If
Else
For i = 0 To 5
gvbh_str(i) = &HAA
Next
End If
Call copy_Com(Check1, gvbh_str, 17, 31) '拼装抄表命令字
end_s = False '设通讯状态标志
ii = 16: SEND_MARK = 0 '开始发送命令通讯
Label6.Visible = False
ProgressBar1.Visible = True
ProgressBar1.Value = ProgressBar1.Min '设置进度的值为 Min，初始化ProgressBar。
Label13.Visible = True
MousePointer = 11 '设置鼠标为沙漏型
If MSComm1.PortOpen <> True Then MSComm1.PortOpen = True
start = Timer ' 设置开始通讯的时刻。
Timer1.Enabled = True
Com_cancel.Visible = True
End If
End Sub
Private Sub Timer1_Timer() '启动发送命令
'If Err.Number = 0 Then
If (SEND_MARK = 0) And (IsEmpty(send_r(ii)) = False) Then
Timer1.Enabled = False
outbyte() = send_r(ii)
send_count = 1 + UBound(send_r(ii), 1) '发送的字节数
arr_i = 0 '发送命令数组的起始下标
MSComm1.RTSEnable = False
Timer3.Enabled = True '启动发送命令定时器
Else
Call inc_ii
End If
End Sub
Private Sub Timer2_Timer()
MSComm1.RTSEnable = True '最后一个字节发送完毕,RTS使能，启动丕希485通讯转换器RTS(232的7脚)的控制
Timer2.Enabled = False '关闭发送状态，打开接收状态
End Sub
Private Sub timer3_timer() '发送命令定时器,每个字节之间停顿12ms
Dim ARRR(0) As Byte
ARRR(0) = outbyte(arr_i)
MSComm1.Output = ARRR
arr_i = arr_i + 1
send_count = send_count - 1
If send_count = 0 Then
Timer3.Enabled = False
Timer2.Enabled = True '等待15ms至最后一个字节的最后一位发送完毕
SEND_MARK = 1 '一条命令发送完毕
MSComm1.InBufferCount = 0
Timer4.Interval = 650
If ii = 25 Then Timer4.Interval = 1200 '启动等待应答延时监视器(<=1300ms)
Timer4.Enabled = True '启动等待应答延时监视器(<=1300ms)
End If
End Sub
Private Sub TIMER4_TIMER() '等待应答延时监视器
Timer4.Enabled = False
If MSComm1.InBufferCount = 0 Then
MSComm1.PortOpen = False
Err.Number = 630
OnErrStatement (mtitle)
end_s = True '发送完毕
Com_cancel.Visible = False
MousePointer = 0 '鼠标形状还原
ProgressBar1.Visible = False
Label13.Visible = False
ProgressBar1.Value = ProgressBar1.Min
Exit Sub
End If
Inbyte() = MSComm1.Input
Call com_analy(Inbyte)
SEND_MARK = 0
If Err.Number = 0 Then
Call inc_ii
Else
Com_cancel_Click
End If
End Sub
Public Sub inc_ii()
ii = ii + 1
ProgressBar1.Value = ii
Timer1.Interval = 22
If ii < 31 Then
Timer1.Enabled = True
Else:
Timer1.Enabled = False
MSComm1.PortOpen = False
finish = Timer ' 设置结束时刻。
Com_cancel.Visible = False
totaltime = finish - start ' 计算总时间。
end_s = True '发送完毕
FrmMDI.Timer1 = True '开放时间刷新
Label13.Visible = False
ProgressBar1.Visible = False
MousePointer = 0 '鼠标形状还原
Label6.Visible = True
Label6.Caption = "抄表通讯时间共" & CStr(totaltime) & "秒"
End If
End Sub
Private Sub com_analy(aray() As Byte)
Dim bx, cx, dx, ex, fx, gx, hx, ix, k As Byte
Dim ss(6) As String
Dim FUN_NO As String
cx = UBound(aray()) '接收的字节数
If cx < 10 Then
Err.Number = 630
OnErrStatement (mtitle)
Com_cancel_Click '发送完毕
Exit Sub
End If
k = 0
'寻找FEH,68H开始的有效应答信号
Do
k = k + 1
Loop Until ((aray(k - 1) = 254) And (aray(k) = 104)) Or (k = cx)
'如果找到了，求和
SUM1 = 0
If (k < cx) Then
j = k + 9 + aray(k + 9)
If j > cx Then GoTo err_line1 '如果接收到的数据长度<应答命令给出的数据长度，说明应答命令错误
For n = k To j
SUM1 = SUM1 + aray(n)
Next
SUM1 = SUM1 Mod 256
If SUM1 <> aray(n) Then
err_line1: Err.Number = 631
OnErrStatement (mtitle)
Exit Sub
Else
If k < cx Then '将FEH,68H...，16H的数据移动到数组的最开头，覆盖前面的无效数据。便于下面取数据
For ix = 0 To n
aray(ix) = aray(ix + k - 1)
Next
End If
FUN_NO = CStr(Hex(aray(11))) + CStr(Hex(aray(12)))
Select Case FUN_NO
Case "43E5" '读最近编程时间
bx = (aray(16) - &H33) \ 16: cx = (aray(16) - &H33) Mod 16
dx = (aray(15) - &H33) \ 16: ex = (aray(15) - &H33) Mod 16
fx = (aray(14) - &H33) \ 16: gx = (aray(14) - &H33) Mod 16
hx = (aray(13) - &H33) \ 16: ix = (aray(13) - &H33) Mod 16
Text1(65).ForeColor = &HFF&
Text1(65).Text = CStr(bx) + CStr(cx) + "-" + CStr(dx) + CStr(ex) + " " + CStr(fx) + CStr(gx) + ":" + CStr(hx) + CStr(ix)
Case "4DE5" '读最近清零时间
bx = (aray(16) - &H33) \ 16: cx = (aray(16) - &H33) Mod 16
dx = (aray(15) - &H33) \ 16: ex = (aray(15) - &H33) Mod 16
fx = (aray(14) - &H33) \ 16: gx = (aray(14) - &H33) Mod 16
hx = (aray(13) - &H33) \ 16: ix = (aray(13) - &H33) Mod 16
Text1(66).ForeColor = &HFF&
Text1(66).Text = CStr(bx) + CStr(cx) + "-" + CStr(dx) + CStr(ex) + " " + CStr(fx) + CStr(gx) + ":" + CStr(hx) + CStr(ix)
Case "45E5" '读编程次数
dx = (aray(14) - &H33) \ 16: ex = (aray(14) - &H33) Mod 16
fx = (aray(13) - &H33) \ 16: gx = (aray(13) - &H33) Mod 16
Text1(67).ForeColor = &HFF&
Text1(67).Text = CStr(dx) + CStr(ex) + CStr(fx) + CStr(gx) & "次"
Case "4EE5" '读清零次数
dx = (aray(14) - &H33) \ 16: ex = (aray(14) - &H33) Mod 16
fx = (aray(13) - &H33) \ 16: gx = (aray(13) - &H33) Mod 16
Text1(68).ForeColor = &HFF&
Text1(68).Text = CStr(dx) + CStr(ex) + CStr(fx) + CStr(gx) & "次"
Case "44F3" '读时间
bx = (aray(15) - &H33) \ 16: cx = (aray(15) - &H33) Mod 16 '时
dx = (aray(14) - &H33) \ 16: ex = (aray(14) - &H33) Mod 16 '分
fx = (aray(13) - &H33) \ 16: gx = (aray(13) - &H33) Mod 16 '秒
Text1(70).ForeColor = &HFF&
Text1(70).Text = CStr(bx) + CStr(cx) + ":" + CStr(dx) + CStr(ex) + ":" + CStr(fx) + CStr(gx)
Case "43F3" '读日期及周次
bx = (aray(16) - &H33) \ 16: cx = (aray(16) - &H33) Mod 16 '年
dx = (aray(15) - &H33) \ 16: ex = (aray(15) - &H33) Mod 16 '月
fx = (aray(14) - &H33) \ 16: gx = (aray(14) - &H33) Mod 16 '日
hx = (aray(13) - &H33) Mod 16 '星期
Text1(69).ForeColor = &HFF&
Dim weekchr(7) As String * 1
weekchr(1) = "一": weekchr(2) = "二": weekchr(3) = "三"
weekchr(4) = "四": weekchr(5) = "五": weekchr(6) = "六": weekchr(7) = "日"
Text1(69).Text = Left(CStr(Year(Date)), 2) + CStr(bx) + CStr(cx) + "-" + CStr(dx) + CStr(ex) + "-" + CStr(fx) + CStr(gx) + " 星期" + weekchr(hx)
Case "4AF4" '读自动抄表日期
dx = (aray(14) - &H33) \ 16: ex = (aray(14) - &H33) Mod 16
fx = (aray(13) - &H33) \ 16: gx = (aray(13) - &H33) Mod 16
Text1(73).ForeColor = &HFF&
Text1(74).ForeColor = &HFF&
Text1(73).Text = CStr(dx) + CStr(ex)
Text1(74).Text = CStr(fx) + CStr(gx)
Case "46F4" '读循显时间
bx = (aray(15) - &H33) \ 16: cx = (aray(15) - &H33) Mod 16
dx = (aray(14) - &H33) \ 16: ex = (aray(14) - &H33) Mod 16
fx = (aray(13) - &H33) \ 16: gx = (aray(13) - &H33) Mod 16
Text1(72).ForeColor = &HFF&
Text1(72).Text = CStr(bx) + CStr(cx) + CStr(dx) + CStr(ex) + CStr(fx) + CStr(gx) & "秒"
Case "65F3" '读表号
'If aray(7) <> 170 Then
' Check1(25).Value = vbChecked
' Frame2.Visible = False
' Frame3.Visible = True
Text1(71).ForeColor = &HFF&
bx = (aray(18) - &H33) \ 16: cx = (aray(18) - &H33) Mod 16
dx = (aray(17) - &H33) \ 16: ex = (aray(17) - &H33) Mod 16
fx = (aray(16) - &H33) \ 16: gx = (aray(16) - &H33) Mod 16
Text1(71).Text = CStr(bx) + CStr(cx) + CStr(dx) + CStr(ex) + CStr(fx) + CStr(gx)
bx = (aray(15) - &H33) \ 16: cx = (aray(15) - &H33) Mod 16
dx = (aray(14) - &H33) \ 16: ex = (aray(14) - &H33) Mod 16
fx = (aray(13) - &H33) \ 16: gx = (aray(13) - &H33) Mod 16
Text1(71).Text = Text1(71).Text + CStr(bx) + CStr(cx) + CStr(dx) + CStr(ex) + CStr(fx) + CStr(gx)
'Else
' Check1(27).Value = vbChecked
' Frame2.Visible = True
' Frame3.Visible = False
' Text1(83).ForeColor = &HFF&
' Text1(84).ForeColor = &HFF&
' Text1(82).ForeColor = &HFF&
' dx = (aray(17) - &H33) \ 16: ex = (aray(17) - &H33) Mod 16
' Text1(82).Text = Left(CStr(Year(Now)), 2) + CStr(dx) + CStr(ex) '年份
' fx = aray(16) - &H33
' If fx > &H39 Then
' Text1(84).Text = Chr(fx)
' Else
' Text1(84).Text = CStr(fx)
' End If
' bx = (aray(15) - &H33) \ 16: cx = (aray(15) - &H33) Mod 16
' dx = (aray(14) - &H33) \ 16: ex = (aray(14) - &H33) Mod 16
' fx = (aray(13) - &H33) \ 16: gx = (aray(13) - &H33) Mod 16
' Text1(83).Text = CStr(bx) + CStr(cx) + CStr(dx) + CStr(ex) + CStr(fx) + CStr(gx)
'End If
Case "67F3" '读设备码
bx = (aray(18) - &H33) \ 16: cx = (aray(18) - &H33) Mod 16
dx = (aray(17) - &H33) \ 16: ex = (aray(17) - &H33) Mod 16
fx = (aray(16) - &H33) \ 16: gx = (aray(16) - &H33) Mod 16
hx = (aray(15) - &H33) \ 16: ix = (aray(15) - &H33) Mod 16
jx = (aray(14) - &H33) \ 16: kx = (aray(14) - &H33) Mod 16
lx = (aray(13) - &H33) \ 16: mx = (aray(13) - &H33) Mod 16
Text1(75).ForeColor = &HFF&
Text1(75).Text = CStr(bx) + CStr(cx) + CStr(dx) + CStr(ex) + CStr(fx) + CStr(gx) + CStr(hx) + CStr(ix) + CStr(jx) + CStr(kx) + CStr(lx) + CStr(mx)
Case "63F4" '读循环显示项目数
hx = (aray(13) - &H33) \ 16: ix = (aray(13) - &H33) Mod 16
Text1(76).ForeColor = &HFF&
Text1(76).Text = CStr(hx) + CStr(ix)
Case "43F9" '读第01项循环显示项目
fx = (aray(14) - &H33) \ 16: gx = (aray(14) - &H33) Mod 16
hx = (aray(13) - &H33) \ 16: ix = (aray(13) - &H33) Mod 16
Text1(77).ForeColor = &HFF&
Text1(77).Text = CStr(fx) + CStr(gx) + CStr(hx) + CStr(ix)
Case "44F9" '读第02项循环显示项目
fx = (aray(14) - &H33) \ 16: gx = (aray(14) - &H33) Mod 16
hx = (aray(13) - &H33) \ 16: ix = (aray(13) - &H33) Mod 16
Text1(78).ForeColor = &HFF&
Text1(78).Text = CStr(fx) + CStr(gx) + CStr(hx) + CStr(ix)
Case "45F9" '读第03项循环显示项目
fx = (aray(14) - &H33) \ 16: gx = (aray(14) - &H33) Mod 16
hx = (aray(13) - &H33) \ 16: ix = (aray(13) - &H33) Mod 16
Text1(79).ForeColor = &HFF&
Text1(79).Text = CStr(fx) + CStr(gx) + CStr(hx) + CStr(ix)
Case "44F9" '读第04项循环显示项目
fx = (aray(14) - &H33) \ 16: gx = (aray(14) - &H33) Mod 16
hx = (aray(13) - &H33) \ 16: ix = (aray(13) - &H33) Mod 16
Text1(80).ForeColor = &HFF&
If (aray(13) Or aray(14)) = 0 Then
Text1(80).Text = "无"
Else
Text1(80).Text = CStr(fx) + CStr(gx) + CStr(hx) + CStr(ix)
End If
Case "53E3" '最近反向起始时间
bx = (aray(16) - &H33) \ 16: cx = (aray(16) - &H33) Mod 16
dx = (aray(15) - &H33) \ 16: ex = (aray(15) - &H33) Mod 16
fx = (aray(14) - &H33) \ 16: gx = (aray(14) - &H33) Mod 16
hx = (aray(13) - &H33) \ 16: ix = (aray(13) - &H33) Mod 16
Text1(81).ForeColor = &HFF&
Text1(81).Text = CStr(bx) + CStr(cx) + "-" + CStr(dx) + CStr(ex) + " " + CStr(fx) + CStr(gx) + ":" + CStr(hx) + CStr(ix)
bx = (aray(20) - &H33) \ 16: cx = (aray(20) - &H33) Mod 16
dx = (aray(19) - &H33) \ 16: ex = (aray(19) - &H33) Mod 16
fx = (aray(18) - &H33) \ 16: gx = (aray(18) - &H33) Mod 16
hx = (aray(17) - &H33) \ 16: ix = (aray(17) - &H33) Mod 16
Text1(82).ForeColor = &HFF&
Text1(82).Text = bx + cx + dx + ex + fx + gx + hx + ix
End Select
End If
Else
GoTo err_line1
End If
End Sub
Private Sub chang_color()
For i = 65 To 84
Text1(i).ForeColor = &H80000008
Next
End Sub
Private Sub clr_select_Click() '取消选择
If end_s Then
For i = 17 To 30
Check1(i).Value = vbUnchecked
Next
End If
End Sub
Private Sub all_select_Click() '全选
If end_s Then
For i = 17 To 30
Check1(i).Value = vbChecked
Next
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -