国产一级a片免费看高清,亚洲熟女中文字幕在线视频,黄三级高清在线播放,免费黄色视频在线看

//窗體 程序

 

Option Explicit

Dim DataFromCom As Single '從串口讀過來的實時值
Dim DataFromComLast As Single '上次的串口值
Dim TimeCount As Integer
'Dim strBuff As String

Private Sub PicScale(picX As PictureBox) '調整圖像框的坐標系
picX.Scale (0, picX.ScaleHeight)-(picX.ScaleWidth, -picX.ScaleHeight)
End Sub

Private Sub PicMidleLine(picX As PictureBox) '在圖像框中畫一條中線
picX.Line (0, 0)-(picX.ScaleWidth, 0), vbWhite '畫出中線
End Sub

Private Sub Combo1_Click()
If MSComm1.PortOpen = True Then  '如果串口打開先關閉后再進行其他操作
   MSComm1.PortOpen = False
 End If
MSComm1.CommPort = Combo1.ListIndex + 1 '讀取com口號
End Sub

Private Sub Command1_Click()

 On Error GoTo uerror      '發(fā)現錯誤跳轉到錯誤處理
 
 If Command1.Caption = "關閉串口" Then
        MSComm1.PortOpen = False
        Command1.Caption = "打開串口"  '按鈕文字改變
        Shape1.FillColor = &HFFFFC0    '燈顏色改變
        Command2.Caption = "開始測溫"
        Timer1.Enabled = False '關閉定時器
        Shape2.FillColor = vbWhite '指示燈
 Else
     
       MSComm1.PortOpen = True
       Command1.Caption = "關閉串口"
       Shape1.FillColor = &HFF

 End If
 Exit Sub
 

uerror:

    MsgBox " 無效串口號"
   
End Sub

Private Sub Command2_Click()
If MSComm1.PortOpen = False Then GoTo uerror '發(fā)現錯誤跳轉到錯誤處理

If Command2.Caption = "開始測溫" Then
   Command2.Caption = "停止測溫"
   Shape2.FillColor = vbGreen
   Timer1.Enabled = True

Else
   Command2.Caption = "開始測溫"
   Timer1.Enabled = False

   Shape2.FillColor = vbWhite
End If
Exit Sub

uerror:
    MsgBox " 串口未打開"
End Sub

Private Sub Command3_Click()
Unload Form1
End Sub

Private Sub Form_Load()
Dim i As Integer

PicScale Picture1 '調整圖像框的坐標系
PicMidleLine Picture1 '在圖像框中畫一條中線
 Label3.Caption = "使用11.0592M晶振"
Timer1.Enabled = False '停止定時器

If MSComm1.PortOpen = True Then
   MSComm1.PortOpen = False
Else
End If

For i = 1 To 16
    Combo1.AddItem ("com" & CStr(i)) '用for循環(huán)在combobox中添加com1到com16 十六個串口
Next

Combo1.ListIndex = 0 '運行則combobox中默認為com1
'Combo1.Text = Combo1.List(0) '運行則combobox中默認為com1

MSComm1.CommPort = Combo1.ListIndex + 1
MSComm1.Settings = "9600,n,8,1"
   Command1.Caption = "打開串口"
   Shape1.FillColor = &HFFFFC0

End Sub

Private Sub DrawRealLine(picX As PictureBox, TimeCountX As Integer, DataFromComX As Single, DataFromComLastX As Single, coloruser)

If TimeCountX - 1 >= 0 Then
picX.Line ((TimeCountX - 1) * 100, DataFromComLastX)-(TimeCountX * 100, DataFromComX), coloruser

End If

End Sub

Private Sub Timer1_Timer()
Dim strBuff As String

   strBuff = strBuff + MSComm1.Input '讀入到緩沖區(qū)
   TimeDelay 500
 
   Label1.Caption = strBuff
   DataFromCom = Val(strBuff)
 
   Label3.Caption = Now

   TimeCount = TimeCount + 1 '時間軸 加1

DrawRealLine Picture1, TimeCount, DataFromCom * 30, DataFromComLast * 30, &HFFFF&     '畫出實時的曲線4
If TimeCount > 100 Then
   Picture1.Cls
   TimeCount = 0
   PicMidleLine Picture1 '在圖像框中畫一條中線

End If
DataFromComLast = DataFromCom
End Sub

 

 

 

 

 

 

 

 

 

 

 

 

//添加模塊 程序

Declare Function GetTickCount Lib "kernel32" () As Long

Sub TimeDelay(t As Long)
  '時間延遲子程序，單位是毫秒(ms)
  Dim TT&
  TT = GetTickCount()
  Do
   DoEvents
  Loop Until GetTickCount() - TT >= t
End Sub

'等待RS字符串返回，或是時間到達
'Comm是通信控件名稱
'RS是欲等待的字符
'DT是最長的等待時間
'正常時返回值是所得的完整字符串，不正常時返回值是空字符串
Function WaitRS(Comm As MSComm, RS As String, DT As Long) As String
  Dim Buf$, TT As Long
  Buf = ""
  TT = GetTickCount
  Do
    Buf = Buf & Comm.Input
  Loop Until InStr(1, Buf, RS) > 0 Or GetTickCount - TT >= DT
  If InStr(1, Buf, RS) > 0 Then
    WaitRS = Buf
  Else
    WaitRS = ""
  End If
End Function

本站僅提供存儲服務，所有內容均由用戶發(fā)布，如發(fā)現有害或侵權內容，請點擊舉報。