?? frmmain.frm
字號:
Private Sub cmdOpenCOM_Click()
'判斷端口號碼是否落在1--16之間
If cmbCOM.ListIndex >= 0 And cmbCOM.ListIndex <= 16 Then
MSComm1.CommPort = cmbCOM.ListIndex + 1
Shpled.FillColor = &HC000&
Else
MsgBox "指定通信端口時(shí)發(fā)生錯(cuò)誤！", vbCritical + vbOKOnly, "系統(tǒng)信息"
Exit Sub
End If
'激活錯(cuò)誤檢測機(jī)制
On Error GoTo comErr
MSComm1.Settings = "9600,n,8,1" '設(shè)定通信參數(shù)
MSComm1.PortOpen = True '打開通信端口
cmdOpenCOM.Enabled = False '將此按鈕設(shè)為禁用狀態(tài)
cmdStart.Enabled = True '激活【開始檢測】按鈕
lblMsg.Caption = "請點(diǎn)擊【開始檢測】按鈕執(zhí)行檢測工作"
Exit Sub
comErr:
MsgBox "打開通信端口時(shí)發(fā)生錯(cuò)誤！請確定通信端口存在且正常。", vbCritical + vbOKOnly, "系統(tǒng)信息"
End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'單擊【開始檢測】按鈕后激活此事件
'將定時(shí)器激活或關(guān)閉，并顯示對應(yīng)的文字在按鈕上，以指示用戶操作
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub cmdStart_Click()
Timer1.Enabled = Not Timer1.Enabled
If Timer1.Enabled Then
cmdStart.Caption = "停止檢測"
lblMsg.Caption = "系統(tǒng)正在進(jìn)行檢測中"
Else
cmdStart.Caption = "開始檢測"
lblMsg.Caption = "系統(tǒng)已停止檢測"
End If
End Sub
Private Sub Command1_Click()
Dim num As Integer
'Dim outaddr(0) As Byte
'Dim outcode(0) As Byte
Dim outdata(0) As Byte
'Dim Data As Integer
'Dim Data1 As Integer
'Dim Data3 As Integer
'Dim i As Integer
'Dim sentnum(0 To 1) As Integer
'Dim outdata(0 To 1) As Byte
Data1 = Val(Text1.Text)
'Data11 = Val(Mid(Text1.Text, 3, 4))
'Data111 = Data11 + 200
'Data1 = (Data / 10) * 16
'Data2 = Data % 10
'Data3 = Data1 + Data2
'outaddr(0) = CByte(0) '地址
'outcode(0) = CByte(Data111) '命令字
outdata(0) = CByte(Data1) '數(shù)據(jù)
'MSComm1.OutBufferCount = 0
'MSComm1.Output = outaddr() '動(dòng)態(tài)數(shù)組
MSComm1.OutBufferCount = 0
MSComm1.Output = outdata() '動(dòng)態(tài)數(shù)組
'MSComm1.OutBufferCount = 0
'MSComm1.Output = outcode() '動(dòng)態(tài)數(shù)組
'sentnum(0) = Val(Text1.Text)
'sentnum(1) = Val(Text2.Text)
'outdata(0) = CByte(sentnum(0))
'outdata(1) = CByte(sentnum(1))
MSComm1.OutBufferCount = 0 '發(fā)送緩沖區(qū)清空
'MSComm1.Output = outdata() '動(dòng)態(tài)數(shù)組
Text4.SetFocus
End Sub
Private Sub Command2_Click()
Dim num As Integer
'Dim outaddr(0) As Byte
'Dim outcode(0) As Byte
Dim outdata(0) As Byte
'Dim Data2 As Integer
Dim Data3 As Single
'Dim i As Integer
'Dim sentnum(0 To 1) As Integer
'Dim outdata(0 To 1) As Byte
Data2 = Val(Text2.Text)
Data3 = Data2 + 100
'Data21 = Val(Mid(Text2.Text, 3, 4))
'Data22 = Data21 + 210
'Data1 = (Data / 10) * 16
'Data2 = Data % 10
'Data3 = Data1 + Data2
'outaddr(0) = CByte(0) '地址
'outcode(0) = CByte(Data22) '命令字
outdata(0) = CByte(Data3) '數(shù)據(jù)
'MSComm1.OutBufferCount = 0
'MSComm1.Output = outaddr() '動(dòng)態(tài)數(shù)組
MSComm1.OutBufferCount = 0
MSComm1.Output = outdata() '動(dòng)態(tài)數(shù)組
'MSComm1.OutBufferCount = 0
'MSComm1.Output = outcode() '動(dòng)態(tài)數(shù)組
'sentnum(0) = Val(Text1.Text)
'outdata(0) = CByte(sentnum(0))
'outdata(1) = CByte(sentnum(1))
MSComm1.OutBufferCount = 0 '發(fā)送緩沖區(qū)清空
'MSComm1.Output = outdata() '動(dòng)態(tài)數(shù)組
Text3.SetFocus
End Sub
Private Sub Command3_Click()
pic_count = pic_count + 1
SavePicture picVoltage.Image, "d:\" & Str(Date) & "Picture_" & Trim(Str(pic_count)) & ".jpg" ' 保存圖片
MsgBox "數(shù)據(jù)及曲線保存于D:\...中"
End Sub
Private Sub Command4_Click()
NowX = 1
picVoltage.Cls '清除圖形
picVoltage.PSet (0, ValueStr) '設(shè)定起點(diǎn)
End Sub
Private Sub Command5_Click()
Dim num As Integer
'Dim outaddr(0) As Byte
'Dim outcode(0) As Byte
Dim outdata(0) As Byte
'Dim Data2 As Integer
'Dim i As Integer
'Dim sentnum(0 To 1) As Integer
'Dim outdata(0 To 1) As Byte
Data5 = Val(Text3.Text)
Data51 = Data5 + 210
'outaddr(0) = CByte(0) '地址
'outcode(0) = CByte(Data22) '命令字
outdata(0) = CByte(Data51) '數(shù)據(jù)
'MSComm1.OutBufferCount = 0
'MSComm1.Output = outaddr() '動(dòng)態(tài)數(shù)組
MSComm1.OutBufferCount = 0
MSComm1.Output = outdata() '動(dòng)態(tài)數(shù)組
'MSComm1.OutBufferCount = 0
'MSComm1.Output = outcode() '動(dòng)態(tài)數(shù)組
'sentnum(0) = Val(Text1.Text)
'sentnum(1) = Val(Text2.Text)
'outdata(0) = CByte(sentnum(0))
'outdata(1) = CByte(sentnum(1))
MSComm1.OutBufferCount = 0 '發(fā)送緩沖區(qū)清空
'MSComm1.Output = outdata() '動(dòng)態(tài)數(shù)組
Text1.SetFocus
End Sub
Private Sub Command6_Click()
Dim num As Integer
'Dim outaddr(0) As Byte
'Dim outcode(0) As Byte
Dim outdata(0) As Byte
'Dim Data2 As Integer
'Dim i As Integer
'Dim sentnum(0 To 1) As Integer
'Dim outdata(0 To 1) As Byte
Data6 = Val(Text4.Text)
Data61 = Data6 + 200
'outaddr(0) = CByte(0) '地址
'outcode(0) = CByte(Data22) '命令字
outdata(0) = CByte(Data61) '數(shù)據(jù)
'MSComm1.OutBufferCount = 0
'MSComm1.Output = outaddr() '動(dòng)態(tài)數(shù)組
MSComm1.OutBufferCount = 0
MSComm1.Output = outdata() '動(dòng)態(tài)數(shù)組
'MSComm1.OutBufferCount = 0
'MSComm1.Output = outcode() '動(dòng)態(tài)數(shù)組
'sentnum(0) = Val(Text1.Text)
'sentnum(1) = Val(Text2.Text)
'outdata(0) = CByte(sentnum(0))
'outdata(1) = CByte(sentnum(1))
MSComm1.OutBufferCount = 0 '發(fā)送緩沖區(qū)清空
'MSComm1.Output = outdata() '動(dòng)態(tài)數(shù)組
End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'窗體的Load事件
'輸入圖形暫時(shí)設(shè)為灰色，表示無狀態(tài)信息進(jìn)入
'將通訊端口號碼及站號填入Combo控件；并默認(rèn)二者的選項(xiàng)是第一個(gè)
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub Form_Load()
Dim i%
MaxPlotNo = 100
cmbCOM.Clear
cmbCOM.AddItem "COM1"
cmbCOM.AddItem "COM2"
cmbCOM.AddItem "COM3(USB)"
cmbCOM.AddItem "COM4(USB)"
cmbCOM.AddItem "COM5"
cmbCOM.AddItem "COM6"
cmbCOM.AddItem "COM7"
cmbCOM.AddItem "COM8"
' cmbCOM.AddItem "COM9"
' cmbCOM.AddItem "COM10"
' cmbCOM.AddItem "COM11"
'cmbCOM.AddItem "COM12"
' cmbCOM.AddItem "COM12"
'cmbCOM.AddItem "COM14"
' cmbCOM.AddItem "COM15"
'cmbCOM.AddItem "COM16"
cmbCOM.ListIndex = 0
cmdStart.Enabled = False
'以下設(shè)定繪圖范圍，(Xmin,YMax)-(XMax,YMin)
picVoltage.Scale (0, 100)-(MaxPlotNo, 0)
picVoltage.DrawWidth = 2.5 '使用三個(gè)像素寬度的畫筆
h = Shp1.Height '溫度計(jì)初始高度
tp = Shp1.Top
h1 = Shape2.Height '溫度計(jì)初始高度
tp1 = Shape2.Top
pic_count = 0
End Sub
Private Sub Text1_Change()
Dim message
If Text1.Text = "" Then
Text1.Text = 0
End If
'If Text1.Text < 0 Or Text1.Text > 99 Then
'message = MsgBox("數(shù)據(jù)超出范圍，請重新輸入", 64, "提示")
'Text1.Text = 0
'End If
If Len(Text1.Text) > 1 Then
Command1.SetFocus
End If
End Sub
Private Sub Text2_Change()
Dim message
If Text2.Text = "" Then
Text2.Text = 0
End If
'If Text2.Text < 0 Or Text2.Text > 99 Then
'message = MsgBox("數(shù)據(jù)超出范圍，請重新輸入", 64, "提示")
'Text2.Text = 0
'End If
If Len(Text2.Text) > 1 Then
Command2.SetFocus
End If
End Sub
Private Sub Text3_Change()
Dim message
If Text3.Text = "" Then
Text3.Text = 0
End If
If Len(Text3.Text) > 0 Then
Command5.SetFocus
End If
End Sub
Private Sub Text4_Change()
Dim message
If Text4.Text = "" Then
Text4.Text = 0
End If
If Len(Text4.Text) > 0 Then
Command6.SetFocus
End If
End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'定時(shí)器的Timer事件引發(fā)后，就不斷地執(zhí)行其中的程序。
'將模擬讀值命令送出，再取得返回字符串并判斷。
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub Timer1_Timer()
Dim Buf$, ValueStr As Single, ValueStr1 As Single, ValueStr2 As Single, Pos1%
Buf$ = Buf$ + MSComm1.Input
TimeDelay 960
ValueStr = Val(Mid(Buf, Pos1 + 1, 7)) '分離出正號以后的數(shù)值
ValueStr1 = Val(Mid(Buf, Pos1 + 8, 12)) '分離出正號以后的數(shù)值
ValueStr2 = Val(Mid(Buf, Pos1 + 14, 18)) '分離出正號以后的數(shù)值
ValueStr3 = Val(Mid(Buf, Pos1 + 20, 22)) '分離出正號以后的數(shù)值 gaowen
ValueStr4 = Val(Mid(Buf, Pos1 + 23, 25)) '分離出正號以后的數(shù)值 diwen
lblValue.Caption = Format(ValueStr, "000.00") & "℃" '顯示在畫面上
Shp1.Height = (ValueStr / 130) * h + 0.15 * h '模擬溫度計(jì)水銀柱
Shp1.Top = tp + (h - Shp1.Height)
Shape2.Height = 0.65 * h1 'h1 - 0.15 * h1 模擬溫度計(jì)水銀柱
Shape2.Top = tp1 + (h1 - Shape2.Height)
Label1(29).Visible = False
Label1(30).Visible = False
If ValueStr3 > 0 Then
Shape2.Height = 0.85 * h1 'h1 - 0.15 * h1 模擬溫度計(jì)水銀柱
Shape2.Top = tp1 + (h1 - Shape2.Height)
Label1(29).Visible = True
Label1(30).Visible = False
End If
If ValueStr4 > 0 Then
Shape2.Height = 0.15 * h1 'h1 - 0.85 * h1 模擬溫度計(jì)水銀柱
Shape2.Top = tp1 + (h1 - Shape2.Height)
Label1(29).Visible = False
Label1(30).Visible = True
End If
' ValueStr1 = Val(Mid(Buf1, Pos2 + 1, 3)) '分離出正號以后的數(shù)值
' ValueStr2 = Val(Mid(Buf2, Pos3 + 1, 3)) '分離出正號以后的數(shù)值
Label4.Caption = Format(ValueStr1, "00.00") & "℃" '顯示設(shè)置的高溫?cái)?shù)據(jù)
Label5.Caption = Format(ValueStr2, "00.00") & "℃" '顯示設(shè)置的低溫?cái)?shù)據(jù)
If NowX = 0 Then
picVoltage.Cls '清除圖形
picVoltage.PSet (0, ValueStr) '設(shè)定起點(diǎn)
Else
'以下判斷現(xiàn)在的讀值是否大于前一次的讀值，若是，則以紅色繪線
'若否，則以藍(lán)色繪線
If ValueStr > PreValue + 0.01 Then
picVoltage.Line -(NowX, ValueStr), RGB(255, 0, 0) '由上一次的位置畫至此點(diǎn)
ElseIf ValueStr < PreValue + 0.01 Then
picVoltage.Line -(NowX, ValueStr), RGB(0, 0, 255) '由上一次的位置畫至此點(diǎn)
' ElseIf ValueStr = PreValue Then
' picVoltage.Line -(NowX, ValueStr), RGB(0, 255, 0) '由上一次的位置畫至此點(diǎn)
End If
End If
PreValue = ValueStr
NowX = NowX + 1 '位置加1
If NowX > MaxPlotNo Then NowX = 0 '超過范圍則數(shù)值歸零
Label3.Caption = "當(dāng)前時(shí)間：" & Date & " " & Time
If (ValueStr > ValueStr2 And ValueStr < ValueStr1) Then '溫度正常
Shp1.BackColor = &HFF0000 '變回藍(lán)色
Shp1.FillColor = &HFF0000
Shape9.FillColor = &HFF0000
Shape9.BorderColor = &HFF0000
Label1(23).Visible = False
Label1(24).Visible = False
' MMControl1.Command = "close"
ElseIf (ValueStr <= ValueStr2 And ValueStr < ValueStr1) Then '溫度低于下限
Shp1.BackColor = &HFFFF& '變回黃色
Shp1.FillColor = &HFFFF&
Shape9.FillColor = &HFFFF&
Shape9.BorderColor = &HFFFF&
Label1(23).Visible = True
Label1(24).Visible = False
Else '溫度高于上限
Shp1.BackColor = &HFF& '變回紅色
Shp1.FillColor = &HFF&
Shape9.FillColor = &HFF&
Shape9.BorderColor = &HFF&
Label1(23).Visible = False
Label1(24).Visible = True
' MMControl1.Command = "close"
End If
'End Select
End Sub
?? 快捷鍵說明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -