form0.frm

采用VB编写的用于采集PC机串口数据

If BB(i) >= Val(Text6) Then TH3 = TH3 + 1
If BB(i) < Val(Text6) Then TL3 = TL3 + 1
Next i

For i = CInt(T8.Text) + 213 To CInt(T8.Text) + 71 * 3 + 70
If BB(i) >= Val(Text6) Then TH4 = TH4 + 1
If BB(i) < Val(Text6) Then TL4 = TL4 + 1
Next i

For i = CInt(T8.Text) + 284 To CInt(T8.Text) + 71 * 4 + 70
If BB(i) >= Val(Text6) Then TH5 = TH5 + 1
If BB(i) < Val(Text6) Then TL5 = TL5 + 1
Next i

For i = CInt(T8.Text) + 355 To 425
If BB(i) >= Val(Text6) Then TH6 = TH6 + 1
If BB(i) < Val(Text6) Then TL6 = TL6 + 1
Next i

For i = 0 To CInt(T8.Text) - 1
If BB(i) >= Val(Text6) Then TH6 = TH6 + 1
If BB(i) < Val(Text6) Then TL6 = TL6 + 1
Next i


For i = CInt(T8.Text) To CInt(T8.Text) + 70 '141
If CC(i) >= 2 * Val(Text6) Then CH1 = CH1 + 1
If CC(i) < 2 * Val(Text6) Then CL1 = CL1 + 1
Next i

For i = CInt(T8.Text) + 71 To 141
If CC(i) >= 2 * Val(Text6) Then CH2 = CH2 + 1
If CC(i) < 2 * Val(Text6) Then CL2 = CL2 + 1
Next i


For i = 0 To CInt(T8.Text) - 1
If CC(i) >= 2 * Val(Text6) Then CH2 = CH2 + 1
If CC(i) < 2 * Val(Text6) Then CL2 = CL2 + 1
Next i

FX = Abs(Val(CH1.Text) + Val(CL2.Text) - Val(CH2.Text) - Val(CL1.Text))

F1 = Abs(Val(TH1.Text) + Val(TL2.Text) - Val(TH2.Text) - Val(TL1.Text))

F2 = Abs(Val(TH2.Text) + Val(TL3.Text) - Val(TH3.Text) - Val(TL2.Text))

F3 = Abs(Val(TH3.Text) + Val(TL4.Text) - Val(TH4.Text) - Val(TL3.Text))

F4 = Abs(Val(TH4.Text) + Val(TL5.Text) - Val(TH5.Text) - Val(TL4.Text))

F5 = Abs(Val(TH5.Text) + Val(TL6.Text) - Val(TH6.Text) - Val(TL5.Text))



If Val(FX.Text) >= k Then k = Val(FX.Text): J = II



Next II
HScroll2.Value = J
'HScroll2.Value = J
Dim EE As Double
Dim DD As Double
EE = 0
DD = 0
For i = CInt(T8) To CInt(T8) + 67
EE = CC(i) + EE
Next i
EE = EE / 68


For i = CInt(T8) + 71 To 139


DD = CC(i) + DD

Next i

For i = 1 To CInt(T8) - 1


DD = CC(i) + DD

Next i

DD = DD / 68


SUB0.Text = Abs(DD - EE) / 2

kmax = BB(1)
kmin = BB(1)
For i = 1 To 420
If BB(i) > kmax Then kmax = BB(i)
If BB(i) < kmin Then kmin = BB(i)

Next i

Ts = kmax - kmin
Command9.Enabled = True

End Sub

Private Sub Form_Load()
On Error GoTo ERR
T = MScom.Settings
P = MScom.CommPort
MScom.PortOpen = True
S.FillStyle = 0

Exit Sub
ERR:
MsgBox "串口无效,需要重新设置"
S.FillStyle = 1

End Sub

Private Sub HScroll1_Change()
Label6.Caption = HScroll1.Value
If HScroll1.Value > 2 Then
   Picture1.ScaleWidth = 10000 / (HScroll1.Value - 2)
Else
   If HScroll1.Value = 2 Then
      Picture1.ScaleWidth = 10000
   Else
      Picture1.ScaleWidth = 10000 * (2 - HScroll1.Value)
   End If
End If 'Picture1.Refresh
End Sub

Private Sub HScroll2_Change()
T8 = HScroll2.Value
Command8_Click

'Timer3.Enabled = True

End Sub

Private Sub MScom_OnComm()
On Error GoTo ERR
If MScom.CommEvent = 2 Then
   TT = MScom.Input
 If Left(TT, 1) = Chr(2) Then
   KK = Mid(TT, 3, 4)
   Select Case Mid(TT, 2, 1)
      Case "0"
           Command5_Click
      Case "1"
            O1 = True
           If Val("&H" + KK) >= 0 Then
               Y = Val("&H" + KK)
            Else
               Y = 65536 + Val("&H" + KK)
            End If
            Text3 = 10 * (Y * 0.076296273689993 - 2500)
            X = X + 20
            Picture1.Line (Picture1.ScaleLeft + 100 + X, Picture1.CurrentY)-(Picture1.ScaleLeft + 100 + X + 20, -((Y - 32767) * (11 - VScroll1.Value)) + CLng(V.Value) * 2)
            L0.Caption = Val(L0.Caption) + 1
      Case "2"
            O2 = True
           If Val("&H" + KK) >= 0 Then
               Y = Val("&H" + KK)
            Else
               Y = 65536 + Val("&H" + KK)
            End If
            Text3 = 10 * (Y * 3.81481368449965E-02 - 1250)

            X = X + 20
            Picture1.Line (Picture1.ScaleLeft + 100 + X, Picture1.CurrentY)-(Picture1.ScaleLeft + 100 + X + 20, -((Y - 32767) * (11 - VScroll1.Value)) + CLng(V.Value) * 2)
            L0.Caption = Val(L0.Caption) + 1
            
      Case "3"
            O3 = True
            If Val("&H" + KK) >= 0 Then
               Y = Val("&H" + KK)
            Else
               Y = 65536 + Val("&H" + KK)
            End If
            
            
            Text3 = 10 * (Y * 0.0023842585528 - 78.125)
            X = X + 20
            Picture1.Line (Picture1.ScaleLeft + 100 + X, Picture1.CurrentY)-(Picture1.ScaleLeft + 100 + X + 20, -((Y - 32767) * (11 - VScroll1.Value)) + CLng(V.Value) * 2)
            L0.Caption = Val(L0.Caption) + 1
            Text7.Text = Val(Text7.Text) + 1
            Text5.Text = Val(Text5.Text) + Y
            Text6.Text = Val(Text5.Text) / Val(Text7.Text)
            BB(CInt(Val(Text7.Text))) = Y
            
            CC(CInt(TC.Text)) = CC(CInt(TC.Text)) + Y
            TC.Text = Val(TC.Text) + 1
            If Val(TC.Text) = 142 Then TC = 0
            
            

      Case "4"
            O4 = True
           If Val("&H" + KK) >= 0 Then
               Y = Val("&H" + KK)
            Else
               Y = 65536 + Val("&H" + KK)
            End If
            Text3 = 10 * (Y * 0.0005960646382 - 19.53125)
            X = X + 20
            Picture1.Line (Picture1.ScaleLeft + 100 + X, Picture1.CurrentY)-(Picture1.ScaleLeft + 100 + X + 20, -((Y - 32767) * (11 - VScroll1.Value)) + CLng(V.Value) * 2)
            L0.Caption = Val(L0.Caption) + 1
      Case "5"
            Text4.Text = Val("&H" + KK) / 15
            
            If Picture2.Visible Then Command9_Click
      Case "8"
            Text8.Text = Val("&H" + Left(KK, 2))
            Text9.Text = Val("&H" + Right(KK, 2))
            
            'Command9_Click
            
            
      Case "9"
            Text10.Text = Val("&H" + Left(KK, 2))
            Text11.Text = 142 - Val("&H" + Right(KK, 2))
           
      End Select
 End If
End If
Exit Sub
ERR:
'Command5_Click

End Sub










Private Sub P_Click()
Command4_Click
End Sub

Private Sub Timer1_Timer()
Image1.Picture = Picture1.Image


If X > Picture1.ScaleWidth Then
     
     
     Text2.Text = CLng(Text2.Text) + 1
     SavePicture Picture1.Image, Trim(Text1.Text) + Trim(Text2.Text) + ".BMP"
     A = Picture1.CurrentY
     
     X = 100
     Y = Picture1.ScaleHeight / 2
     
     Picture1.Cls
     Picture1.Line (Picture1.ScaleLeft + 100, Picture1.ScaleHeight / 2 - 1 * Picture1.ScaleHeight / 78 / 2)-(Picture1.ScaleWidth - 300, Picture1.ScaleHeight / 2 - 1 * Picture1.ScaleHeight / 78 / 2)

     'Picture1.CurrentX = 100
     'Picture1.CurrentY = 0
     'Picture1.Print "Y/A"
     'Picture1.Print Picture1.ScaleHeight
     'Picture1.CurrentY = Picture1.ScaleHeight / 2
     
     'Picture1.Line (Picture1.ScaleLeft + 100, Picture1.ScaleHeight / 2 + 1 * Picture1.ScaleHeight / 781 / (CInt(Label7.Caption)))-(Picture1.ScaleWidth - 300, Picture1.ScaleHeight / 2 + 1 * Picture1.ScaleHeight / 781 / (CInt(Label7.Caption)))

     'Picture1.Line (Picture1.ScaleLeft + 100, Picture1.ScaleHeight / 2 - 1 * Picture1.ScaleHeight / 781 / (CInt(Label7.Caption)))-(Picture1.ScaleWidth - 300, Picture1.ScaleHeight / 2 - 1 * Picture1.ScaleHeight / 781 / (CInt(Label7.Caption)))
     'Picture1.Line (Picture1.ScaleLeft + 100, Picture1.ScaleHeight / 2)-(Picture1.ScaleWidth - 300, Picture1.ScaleHeight / 2)
     'Picture1.Print "X/T"

     Picture1.CurrentY = A
End If
End Sub

Private Sub Timer2_Timer()
Timer2.Enabled = False

     Picture1.Refresh
     'Picture1.CurrentX = 100
     'Picture1.CurrentY = 0
     'Picture1.Print "Y/A"
     'Picture1.Print Picture1.ScaleHeight
     Picture1.CurrentY = Picture1.ScaleHeight / 2
     
     
     'Picture1.Line (Picture1.ScaleLeft + 100, Picture1.ScaleTop)-(Picture1.ScaleLeft + 100, Picture1.ScaleHeight)
     'Picture1.Line (Picture1.ScaleLeft + 100, Picture1.ScaleHeight / 2)-(Picture1.ScaleWidth - 300, Picture1.ScaleHeight / 2)
     'Picture1.Print "X/T"


X = Picture1.ScaleWidth + 1
Picture1.AutoRedraw = True
End Sub



Private Sub Timer3_Timer()
On Error GoTo PPR
Timer3.Enabled = False
Text1.Text = App.Path + "\BMP\"
Text1.ToolTipText = Text1.Text
MkDir App.Path + "\BMP"

PPR:
Timer1.Enabled = True
Timer2.Enabled = True
Timer3.Enabled = False

'Command9_Click
End Sub

Private Sub Timer4_Timer()
Timer4.Enabled = False
If MScom.Input <> Chr(0) Then MsgBox "下载失败！请重新复位仪器。": Exit Sub
ReDim CCHR(0) As Byte

CCHR(0) = CByte(Val(I1.Text) * 32767 / 25000000)
MScom.Output = CCHR()

CCHR(0) = CByte(Val(T1.Text))
MScom.Output = CCHR()

CCHR(0) = CByte(Val(G1.Text) / 10)
MScom.Output = CCHR()


CCHR(0) = CByte(Val(I2.Text) * 32767 * 2 / 25000000)
MScom.Output = CCHR()

CCHR(0) = CByte(Val(T2.Text))
MScom.Output = CCHR()

CCHR(0) = CByte(Val(G2.Text) / 10)
MScom.Output = CCHR()

CCHR(0) = CByte(Val(I3.Text) * 32767 * 32 / 25000000)
MScom.Output = CCHR()

CCHR(0) = CByte(Val(T3.Text))
MScom.Output = CCHR()

CCHR(0) = CByte(Val(G3.Text) / 10)
MScom.Output = CCHR()

CCHR(0) = CByte(Val(Y1.Text) * 71 / 100)
MScom.Output = CCHR()

CCHR(0) = CByte(Val(R.Text) * 256 / 10000)
MScom.Output = CCHR()



MsgBox "下载设置完成，仪器将自动复位。"
End Sub

Private Sub Timer5_Timer()
Timer5.Enabled = False
If MScom.Input <> Chr(0) Then MsgBox "下载失败！请重新复位仪器。": Exit Sub
ReDim CCHR(0) As Byte

CCHR(0) = CByte(Val(L10.Text) * 10)
MScom.Output = CCHR()
CCHR(0) = CByte(Val(L20.Text) * 20)
MScom.Output = CCHR()
CCHR(0) = CByte(Val(L30.Text) * 30)
MScom.Output = CCHR()
CCHR(0) = CByte(Val(L40.Text) * 40)
MScom.Output = CCHR()
CCHR(0) = CByte(Val(L50.Text) * 50)
MScom.Output = CCHR()

CCHR(0) = CByte(Val(H10.Text) * 10)
MScom.Output = CCHR()

CCHR(0) = CByte(Val(H20.Text) * 20)
MScom.Output = CCHR()

CCHR(0) = CByte(Val(H30.Text) * 30)
MScom.Output = CCHR()

CCHR(0) = CByte(Val(H40.Text) * 40)
MScom.Output = CCHR()

CCHR(0) = CByte(Val(H50.Text) * 50)
MScom.Output = CCHR()

CCHR(0) = CByte(Val(RZD.Text))
MScom.Output = CCHR()



MsgBox "下载设置完成，仪器将自动复位。"

End Sub

Private Sub VScroll1_Change()
Label7.Caption = 11 - VScroll1.Value
End Sub

Private Sub Y1_Change()
Y2 = Y1
Y3 = Y1
End Sub

Private Sub Y2_Change()
Y1 = Y2
Y3 = Y2
End Sub

Private Sub Y3_Change()
Y1 = Y3
Y2 = Y3
End Sub