📄 frmcomm.frm
字号:
VERSION 5.00
Object = "{648A5603-2C6E-101B-82B6-000000000014}#1.1#0"; "MSCOMM32.OCX"
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Object = "{D959C709-8613-11D1-9840-002078110E7D}#1.0#0"; "as97Popup.ocx"
Object = "{C7AE747C-B9E4-11D7-B0E3-D8165009166E}#7.0#0"; "XPForm.ocx"
Begin VB.Form frmread
BorderStyle = 0 'None
Caption = "数据录入"
ClientHeight = 4965
ClientLeft = 3450
ClientTop = 1770
ClientWidth = 5220
Icon = "frmComm.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MDIChild = -1 'True
MinButton = 0 'False
ScaleHeight = 4965
ScaleWidth = 5220
ShowInTaskbar = 0 'False
Begin VB.Timer Timer1
Enabled = 0 'False
Interval = 1000
Left = 3240
Top = 480
End
Begin VB.PictureBox picpgb2
Appearance = 0 'Flat
AutoRedraw = -1 'True
BackColor = &H80000005&
BorderStyle = 0 'None
ForeColor = &H80000008&
Height = 285
Left = 240
ScaleHeight = 19
ScaleMode = 0 'User
ScaleWidth = 295
TabIndex = 14
Top = 4080
Visible = 0 'False
Width = 4425
End
Begin MSComctlLib.ProgressBar ProgressBar1
Height = 375
Left = 360
TabIndex = 13
Top = 3240
Visible = 0 'False
Width = 4095
_ExtentX = 7223
_ExtentY = 661
_Version = 393216
Appearance = 1
End
Begin as97Popup.asPopup asPopup3
Height = 255
Left = 2280
Top = 3720
Width = 615
_ExtentX = 1085
_ExtentY = 450
Caption = "查看"
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
BackColor = 14737632
MaskColor = 12632319
ScaleWidth = 41
ScaleMode = 0
ScaleHeight = 17
End
Begin VB.ComboBox Combo1
Height = 300
Left = 2040
TabIndex = 12
Text = "1"
Top = 720
Width = 1215
End
Begin MSCommLib.MSComm MSComm1
Left = 4560
Top = 4320
_ExtentX = 1005
_ExtentY = 1005
_Version = 393216
DTREnable = -1 'True
End
Begin as97Popup.asPopup asPopup2
Height = 255
Left = 3240
Top = 3720
Width = 735
_ExtentX = 1296
_ExtentY = 450
Caption = "退出"
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
BackColor = 12648447
ScaleWidth = 49
ScaleMode = 0
ScaleHeight = 17
End
Begin as97Popup.asPopup asPopup1
Height = 255
Left = 1200
Top = 3720
Width = 735
_ExtentX = 1296
_ExtentY = 450
Caption = "读入"
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
BackColor = 12648447
ScaleWidth = 49
ScaleMode = 0
ScaleHeight = 17
End
Begin XP窗体控件.XPForm XPForm1
Height = 2055
Left = 3600
Top = 2280
Width = 4215
_ExtentX = 7435
_ExtentY = 3625
Caption = "数据录入"
Icon = "frmComm.frx":08CA
AlwaysOnTop = 0 'False
ShowFormSize = 0 'False
End
Begin VB.TextBox Text1
Enabled = 0 'False
Height = 300
Left = 2040
TabIndex = 6
Top = 1440
Width = 1215
End
Begin VB.TextBox Text2
Enabled = 0 'False
Height = 300
Left = 2040
TabIndex = 5
Top = 2040
Width = 1095
End
Begin VB.TextBox Text3
Enabled = 0 'False
Height = 300
Left = 2040
TabIndex = 4
Top = 2640
Width = 1095
End
Begin VB.Frame Frame2
BackColor = &H00BDD2C2&
Caption = "状态"
BeginProperty Font
Name = "楷体_GB2312"
Size = 10.5
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 2295
Left = 3840
TabIndex = 0
Top = 720
Width = 975
Begin VB.Shape Shape1
FillColor = &H00C0C0C0&
Height = 255
Left = 480
Shape = 3 'Circle
Top = 1680
Width = 255
End
Begin VB.Shape Shape2
FillColor = &H00C0C0C0&
Height = 255
Left = 480
Shape = 3 'Circle
Top = 1080
Width = 255
End
Begin VB.Shape Shape3
BackColor = &H00BDD2C2&
BorderStyle = 6 'Inside Solid
FillColor = &H00BDD2C2&
FillStyle = 0 'Solid
Height = 255
Left = 480
Shape = 3 'Circle
Top = 480
Width = 255
End
Begin VB.Label Label7
BackStyle = 0 'Transparent
Caption = "读入"
Height = 255
Left = 0
TabIndex = 3
Top = 500
Width = 375
End
Begin VB.Label Label8
BackStyle = 0 'Transparent
Caption = "出错"
Height = 255
Left = 0
TabIndex = 2
Top = 1080
Width = 375
End
Begin VB.Label Label9
BackStyle = 0 'Transparent
Caption = "完成"
Height = 255
Left = 0
TabIndex = 1
Top = 1680
Width = 375
End
End
Begin VB.Image imgpgb1
Appearance = 0 'Flat
Height = 285
Left = 1680
Top = 4080
Visible = 0 'False
Width = 540
End
Begin VB.Label Label12
BackStyle = 0 'Transparent
Height = 405
Left = 2520
TabIndex = 11
Top = 3090
Width = 615
End
Begin VB.Label Label1
BackStyle = 0 'Transparent
Caption = "请选择端口号："
Height = 300
Left = 720
TabIndex = 10
Top = 720
Width = 1335
End
Begin VB.Label Label2
BackStyle = 0 'Transparent
Caption = "读入采集器号："
Height = 300
Left = 600
TabIndex = 9
Top = 1440
Width = 1335
End
Begin VB.Label Label3
BackStyle = 0 'Transparent
Caption = "读入记录累计："
Height = 255
Left = 480
TabIndex = 8
Top = 2640
Width = 1335
End
Begin VB.Label Label4
BackStyle = 0 'Transparent
Caption = "共有记录数"
Height = 255
Left = 600
TabIndex = 7
Top = 1920
Width = 1335
End
End
Attribute VB_Name = "frmread"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim flag As Boolean
Public answer As Integer
Dim bang_num As String
Dim Count_Total As Integer
Dim mon_time As String
Dim Time_Date() As String
Dim Time_Time() As String
Dim Niu() As String
Dim Xia_Biao As Integer
Dim receive(9) As Byte
Dim inTinputlen As Integer
Dim flag_end As Boolean
Dim distance As Integer
Dim length As Single
Private Sub asPopup1_Click(Cancel As Boolean)
On Error Resume Next
asPopup2.Enabled = False
Dim strtxt As String
Dim i As Integer
answer = 0
'picpgb2.Visible = True
'Timer1.Enabled = True
flag = False
flag_end = False
Shape3.FillStyle = 0
Shape3.FillColor = "&H0000FFFF"
Shape1.FillStyle = 0
Shape1.FillColor = "&h00c0c0c0"
Shape2.FillStyle = 0
Shape2.FillColor = "&h00c0c0c0"
Xia_Biao = 0
strtxt = "0"
Text3.Text = "0"
MSComm1.CommPort = strfile
MSComm1.InBufferSize = 1024
MSComm1.OutBufferSize = 512
MSComm1.InputMode = comInputModeBinary
MSComm1.InputLen = 9
MSComm1.PortOpen = True
inTinputlen = 9
MSComm1.Output = strtxt
TimeDelay 600
MSComm1.InBufferCount = 0
On Error GoTo err_write
liqin ("55")
TimeDelay 60
ReDim byTinput(9) As Byte
byTinput = MSComm1.Input
For i = 2 To 9
receive(i - 2) = byTinput(i - 1)
Next
Call GetDisplayText
If flag = True Then
Exit Sub
End If
MSComm1.InBufferCount = 0
liqin ("04")
TimeDelay 60
MSComm1.InputMode = comInputModeBinary
MSComm1.InputLen = 9
ReDim byTinput(9) As Byte
byTinput = MSComm1.Input
For i = 2 To 9
receive(i - 2) = byTinput(i - 1)
Next
Call Display
Dim k As Integer
For k = 1 To 5100
Call Niu_Hao
Call Display
If flag_end = True Then
k = 5500
End If
Next
MSComm1.PortOpen = False
ProgressBar1.Visible = False
asPopup2.Enabled = True
Exit Sub
err_write:
Shape3.FillStyle = 0
asPopup2.Enabled = True
Shape3.FillColor = "&h00c0c0c0"
Shape2.FillStyle = 0
Shape2.FillColor = "&H000000ff"
frmmsg.Top = frmread.Top + 600
frmmsg.Left = frmread.Left + 5320
Timer1.Enabled = False
MSComm1.PortOpen = False
frmmsg.msg.MsgChar = "端口或硬件有故障，请检查后重新读入数据！"
frmmsg.Show
End Sub
Private Sub asPopup2_Click(Cancel As Boolean)
Unload Me
End Sub
Private Sub Command1_Click()
frmresult.Show
End Sub
Private Sub asPopup3_Click(Cancel As Boolean)
frmresult.Show
End Sub
Private Sub combo1_Click()
Open App.Path & "\savecom.txt" For Output As #1
strfile = Combo1.Text
Print #1, strfile
Close (1)
End Sub
Private Sub Form_Load()
On Error Resume Next
Dim i As Integer
XPForm1.Make
For i = 1 To 4
Combo1.AddItem i
Next i
Open App.Path & "\savecom.txt" For Input As #1
fp
Input #1, strfile
Combo1.Text = strfile
Close (1)
'Combo1.Text = "1"
intport = Combo1.Text
strset = "9600,n,8,1"
asPopup3.Enabled = False
asPopup3.BackColor = &HE0E0E0
ProgressBar1.Visible = False
Dim str1 As Integer
If Rp = False Then
str1 = GetSetting(appname:="MyApp", Section:="times_2", Key:="Value", Default:="0")
str1 = str1 + 1
SaveSetting "MyApp", "times_2", "Value", str1
If str1 > 100 Then
MsgBox "请您注册，或与供应商联系"
asPopup1.Enabled = False
End If
End If
End Sub
Public Sub GetDisplayText()
On Error Resume Next
Dim n As Integer
Dim intValue As Integer
Dim intHighHex As Integer
Dim intLowHex As Integer
Dim strSingleChr As String * 1
Dim intAddress As Integer
Dim intAddressArray(8) As Integer
Dim intHighAddress As Integer
Dim strhex, strAscii As String
Dim result(16) As String
Dim i As Integer
Dim time1 As String
i = 0
'设置初值
strhex = ""
For n = 1 To 8
intValue = receive(n - 1)
intHighHex = intValue \ 16
intLowHex = intValue - intHighHex * 16
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -