📄 chuanganqi.frm
字号:
VERSION 5.00
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
Object = "{48E59290-9880-11CF-9754-00AA00C00908}#1.0#0"; "MSINET.OCX"
Begin VB.Form Form1
BorderStyle = 1 'Fixed Single
Caption = "基于以太网的温度监测系统"
ClientHeight = 7635
ClientLeft = 4635
ClientTop = 1755
ClientWidth = 10410
Icon = "chuanganqi.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 7635
ScaleWidth = 10410
Begin VB.Timer Timer4
Interval = 1000
Left = 8160
Top = 5760
End
Begin VB.PictureBox Picture1
Height = 5535
Left = -120
ScaleHeight = 5475
ScaleWidth = 10515
TabIndex = 10
Top = 0
Width = 10575
End
Begin VB.Timer Timer3
Interval = 1500
Left = 3600
Top = 5760
End
Begin VB.CommandButton Command3
Caption = "关于"
Height = 495
Left = 4320
TabIndex = 9
Top = 6960
Width = 1335
End
Begin VB.ListBox List2
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 960
ItemData = "chuanganqi.frx":08CA
Left = 6120
List = "chuanganqi.frx":08CC
MultiSelect = 1 'Simple
TabIndex = 8
Top = 6240
Width = 3975
End
Begin VB.ListBox List1
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 660
ItemData = "chuanganqi.frx":08CE
Left = 1200
List = "chuanganqi.frx":08D0
TabIndex = 7
Top = 6480
Width = 2535
End
Begin VB.Timer Timer2
Interval = 2500
Left = 3000
Top = 5760
End
Begin VB.Timer Timer1
Interval = 3000
Left = 2400
Top = 5760
End
Begin VB.CommandButton Command2
Caption = "退出"
Height = 495
Left = 4320
TabIndex = 4
Top = 6360
Width = 1335
End
Begin VB.CommandButton Command1
Caption = "开始"
Height = 495
Left = 4320
TabIndex = 3
Top = 5760
Width = 1335
End
Begin VB.TextBox Text1
Enabled = 0 'False
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 1320
TabIndex = 1
Top = 5760
Width = 855
End
Begin InetCtlsObjects.Inet Inet1
Left = 5760
Top = 5640
_ExtentX = 1005
_ExtentY = 1005
_Version = 393216
End
Begin MSWinsockLib.Winsock Winsock1
Left = 7560
Top = 5640
_ExtentX = 741
_ExtentY = 741
_Version = 393216
Protocol = 1
End
Begin VB.Label Label5
Height = 375
Left = 8880
TabIndex = 11
Top = 7320
Width = 1575
End
Begin VB.Label Label4
Height = 255
Left = 0
TabIndex = 6
Top = 7440
Width = 6855
End
Begin VB.Label Label3
Caption = "结果列表："
Height = 375
Left = 6240
TabIndex = 5
Top = 5760
Width = 1215
End
Begin VB.Label Label2
Caption = "采集主机："
Height = 375
Left = 120
TabIndex = 2
Top = 6480
Width = 975
End
Begin VB.Label Label1
Caption = "连接数："
Height = 375
Left = 240
TabIndex = 0
Top = 5760
Width = 735
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 程序名: 温度传感器主机端
' 程序员： 黄荣舜，闫继伟
' 指导老师: 黄培灿
' 作用：
' 主机端通过网络UDP协议被动连接，当主机端运行后开放10000端口接受客户机连接，最大连接数为10，连接后在主界面上显示温度变化与波型图。
'
' 运行环境：VB6.0开发，基于Windows NT 平台
'
'
'
'
'
''''''''''''''''''''''''''''''''''''CopyLeft(c) 软件学院计算机科学与技术系嵌入式系统实验室（8B307）'''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim LoopTimes As Long '记录打印坐标的次数
Dim WhichIP As Integer '为画图时不同步所做的标志量
Dim Draw_X_count As Integer 'x坐标转换
Dim Draw_Count As Integer
Dim DegreeQueue As String '保留温度的集合
Dim ResultlistLen As Long '保存结果列表里面的总字符串长度
Dim IPleng As Integer '保存TEXT2里输出数据的总字节数
Dim ConnectNumber As Integer '保存连接个数
Dim Rdata As String '接收到的数据包
Dim Draw_Flag As Integer '画函数过程中的标志量
Dim SOH As Integer, STX As Integer, ETX As Integer, EOT As Integer, ENQ As Integer, ACK As Integer '网络传输过程中的数据报头
'Dim num As Integer '使用哪一个SOCK
Dim IPstr(11) As String '保留客户机IP ' 这四个数据的对应关系 IPstr保存连接到本机的客户机IP
Dim IPFlag(11) As Integer '客户机是否联通的标志号，为1则正在联通，为0则
Dim DegreeArray(11) As String '保存温度 'degreearray保存与IP对应的温度值，退若一IP在ipstr里0位，则它对应的温度在这个数据中的0位
Dim bakY(11) As String '保存上一次收到的温度 ' 保存degreearray的上一次数据
Dim bakX(11) As Integer '保存X轴当画满一屏后的更新值 ' 保存X轴的上一次坐标，baky bakx用于画图函数
Dim IPColor(11) As String
Dim Color(11) As String
Dim Cgdegree As String '保存本次温度
'Dim x As Integer
Private Sub Init() '初始化变量
Dim i As Integer
LoopTimes = 1
'Draw_X_count = 0
DegreeQueue = ""
ResultlistLen = 0
IPleng = 0
Rdata = ""
Draw_Flag = 0
Picture1.Cls
Call Draw_ZB(10)
Form1.Text1.Text = ConnectNumber
If IPstr(0) = "" Then
ConnectNumber = 0
End If
Color(0) = vbBlack
Color(1) = vbBlue
Color(2) = vbRed
Color(3) = vbGreen
Color(4) = vbWhite '4以后没有赋值，连接数大于4请一定改之，否则出错
For i = 1 To 10 Step 1
DegreeArray(i) = ""
bakY(i) = ""
bakX(i) = 0
Next
End Sub
Private Function Find_Color(IPnumber As Integer) As String '梆定IP与颜色
Dim i As Integer
Dim CompVal As Integer
CompVal = 1
For i = 0 To ConnectNumber Step 1
CompVal = StrComp(IPColor(i), IPstr(IPnumber))
If CompVal = 0 Then
Find_Color = Color(i)
Exit For
End If
Next
End Function
Private Sub Insert_IPColor(RMIP As String)
Dim i As Integer
Dim CompVal As Integer
CompVal = 1
For i = 0 To ConnectNumber Step 1
CompVal = StrComp(IPColor(i), RMIP)
If CompVal = 0 Then '若IP存在则退出子函数
Exit Sub
End If
Next
For i = 0 To 10 Step 1 '不存在则给IP分配颜色
If IPColor(i) = "" Then
IPColor(i) = RMIP
Exit For
End If
Next
End Sub
Private Function Find_Which_Color() As Integer '些函数作用为查找到IP对应的颜色
Dim i, j As Integer
Dim FoundColor As String
Dim CompVal As Integer
CompVal = 1
For j = 0 To ConnectNumber Step 1
If IPstr(i) <> "" Then
FoundColor = Find_Color(j)
For i = 0 To 10 Step 1
CompVal = StrComp(Color(j), FoundColor)
If CompVal = 0 Then
Find_Which_Color = j
Exit For
End If
Next
Exit For
End If
Next
End Function
Private Sub Draw_ZB(XValue As Long) '画出坐标系,xvalue参数用于X轴的动态显示 ，坐标原点位置在x:2000 y:5000
Dim a As Integer
Dim Flag As Integer
Dim xx As Integer
''''''''''''''''''''''''''''''''''
Flag = 1000
a = 10 '坐标原点
Picture1.CurrentX = 0
Picture1.CurrentY = 100
xx = 0
''''''''''''''''''''''''''''''''''
For y = 100 To 5500 Step 100 '画Y方向表格
Picture1.Line (xx, y)-(10500, y), 62200
Next
''''''''''''''''''''''''''''''''''
Picture1.CurrentX = 0
Picture1.CurrentY = 100
y = 100
For xx = 0 To 10500 Step 100 '画X方向表格
Picture1.Line (xx, y)-(xx, 5500), 62200
Next
''''''''''''''''''''''''''''''''''
Picture1.Line (0, 100)-(10500, 100), vbRed
Picture1.Line (0, 5500)-(10500, 5500), vbRed
Picture1.Line (2000, 100)-(2000, 5500), vbBlack 'y 轴
Picture1.Line (0, 5000)-(10500, 5000), vbBlack 'x轴
''''''''''''''''''''''''''''''''''
Picture1.CurrentX = 2000 '原点
Picture1.CurrentY = 5100
Picture1.Print (XValue - 10)
''''''''''''''''''''''''''''''''''
y = 5000 '画X正半轴
For xx = 2000 To 10000 Step 100
Picture1.Line (xx, y)-(xx, y + 50), vbBlack
If Flag = 1000 Then
Picture1.Line (xx + 1000, y)-(xx + 1000, y + 100), vbBlack
Picture1.Print XValue
XValue = XValue + 10
Flag = 0
End If
Flag = Flag + 100
Next
''''''''''''''''''''''''''''''''''
CurrentX = 2000 '画Y正半轴
Flag = 1000
a = 10
xx = 2000
For y = 5000 To 100 Step -100
Picture1.Line (xx, y)-(xx + 50, y), vbBlack
If Flag = 1000 And y <> 1000 Then
Picture1.Line (xx, y - 1000)-(xx + 100, y - 1000), vbBlack
Picture1.Print a
a = a + 10
Flag = 0
End If
Flag = Flag + 100
Next
End Sub
Public Sub delay(pausetime As Single) '延时子函数
Dim start
start = Timer
Do While Timer < start + pausetime
DoEvents
Loop
End Sub
Private Sub Draw_Function(Degree As String, xx As Integer, m As String, IPstrnumber As Integer)
'各参数作用:degree 是温度值,N.xx为上一温度的坐标,COLORNUM为颜色标志, colornum与客户机IP一一对应，所以下面会使用这个值来表示ipnum
Dim y As Integer
Dim bakYY As Integer
Dim YDegree As Integer
Draw_Flag = Draw_Flag + 1
''''''''''''''''''''''''''''''''''
abcd = xx Mod 10100 '使坐标轴每刷新一次X的值能从坐标原点开始
If abcd = 0 Then
xx = 2100
End If
''''''''''''''''''''''''''''''''''
If Degree = "" Then
YDegree = 0
Else
YDegree = Int(CSng(Degree) * 100)
End If
''''''''''''''''''''''''''''''''''
If m = "" Then
bakYY = 0
Else
bakYY = Int(CSng(m) * 100) '保存上一个温度值用来画两点间的线
End If
''''''''''''''''''''''''''''''''''
y = 5000
n = xx - 100
'PSet Step(xx, 5000 - YDegree), color(Colornum) '在坐标轴上打印出温度来
''''''''''''''''''''''''''''''''''
If bakY(IPstrnumber) <> "" Then '不从原点画起
' If Colornum = 0 Then
'Draw_X_count = Draw_X_count + 1
' End If
'Picture1.PSet (xx, 5000 - YDegree), Find_Color(Colornum)
Picture1.Line (n, 5000 - bakYY)-(xx, 5000 - YDegree), Find_Color(IPstrnumber)
Call Print_Status("X:" & (xx - 2000) / 100 & " Y:" & YDegree / 100)
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'If IPstrnumber = 0 Then
'Draw_Count = LoopTimes / ConnectNumber
'''''''''''''''''''''''''''''''''''''''''''''''
abcdef = LoopTimes Mod 80 '坐标画满后清屏
If abcdef = 0 Then
'LoopTimes = LoopTimes + 1
'Draw_X_count = 1
Picture1.Cls
Draw_X_count = Int((LoopTimes / 10)) * 10
Call Draw_ZB(Draw_X_count + 10)
End If
' End If
''''''''''''''''''''''''''''''''''''''''''''''''''''''
Else
bakYY = YDegree
bakY(IPstrnumber) = YDegree
n = xx
End If
''''''''''''''''''''''''''''''''''
Print_Status ("LoopTimes: " & LoopTimes)
xx = xx + 100
bakX(IPstrnumber) = xx
End Sub
Private Sub Send_ENQ()
SOH = 1 '标题开始
ENQ = 5 '请求
Winsock1.SendData Chr(SOH) & Chr(ENQ)
End Sub
Private Sub Send_ALL_Msg() '发送两开发板发送来的温度字符串
Dim IPstrNum As Integer
Dim Dtime As String
Dim Timen As String
Dim abcdef As Integer
Timen = Time()
Dtime = Date & Chr(9) & Timen & Chr(9)
DegreeQueue = Title
SOH = 1 '标题开始
STX = 2 '正文开始
ETX = 3 '正文结束
EOT = 4 '传输结束
ENQ = 5 '请求
ACK = 6 '收到通知
''''''''''''''''''''''''''''''''''
For IPstrNum = 0 To ConnectNumber Step 1 '此段作用是把客户机的记录做好格式后发送出去
If IPstr(IPstrNum) <> "" Then
DegreeQueue = DegreeQueue & Chr(10) & Dtime & IPstr(IPstrNum) & Chr(9) & DegreeArray(IPstrNum) & "'C" & Chr(10)
End If
Next
''''''''''''''''''''''''''''''''''
For IPstrNum = 0 To ConnectNumber Step 1 '向所有IP发送记录
If IPstr(IPstrNum) <> "" Then
'Call Connect_Host(IPstr(IPnum))
Winsock1.RemoteHost = IPstr(IPstrNum)
Winsock1.RemotePort = 10000
Form1.Winsock1.SendData Chr(SOH) & "RECORD" & Chr(STX) & DegreeQueue & Chr(ETX) & Chr(EOT)
Call Print_Status("RECORD:" & DegreeQueue)
End If
''''''''''''''''''''''''''''''''''
Next
'把信息写到文件中
Open "msg.txt" For Append As #1 '追加
Print #1, DegreeQueue
Close #1
DegreeQueue = ""
''''''''''''''''''''''''''''''''''
LoopTimes = LoopTimes + 1 '统计一共进入了多少次画图函数
''''''''''''''''''''''''''''''''''
For IPstrNum = 0 To ConnectNumber Step 1 '画图
If IPstr(IPstrNum) <> "" Then
Call Draw_Function(DegreeArray(IPstrNum), bakX(IPstrNum), bakY(IPstrNum), IPstrNum)
bakY(IPstrNum) = DegreeArray(IPstrNum)
End If
Next
''''''''''''''''''''''''''''''''''''''''''''''
End Sub
Private Sub Local_Active() '程序启动时绑定本地10000端口
On Error GoTo ErrorN
With Form1.Winsock1
.LocalPort = "10000"
.Bind "10000"
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -