form1.frm

用于嵌入式系统的数据采集

      Width           =   1095
   End
   Begin VB.Label Label2 
      Caption         =   "踏板"
      Height          =   255
      Index           =   0
      Left            =   360
      TabIndex        =   14
      Top             =   960
      Width           =   855
   End
   Begin VB.Label Label1 
      Caption         =   "气压"
      Height          =   255
      Left            =   360
      TabIndex        =   13
      Top             =   720
      Width           =   735
   End
   Begin VB.Label LblDuty 
      Caption         =   "0"
      Height          =   375
      Left            =   1440
      TabIndex        =   12
      Top             =   1200
      Width           =   1095
   End
   Begin VB.Label LblInputCount 
      Caption         =   "0"
      Height          =   255
      Left            =   1440
      TabIndex        =   7
      Top             =   240
      Width           =   1095
   End
   Begin VB.Label LblPanel 
      Caption         =   "0"
      Height          =   255
      Left            =   1200
      TabIndex        =   6
      Top             =   960
      Width           =   1095
   End
   Begin VB.Label LblAirPress 
      Caption         =   "0"
      Height          =   255
      Left            =   1200
      TabIndex        =   5
      Top             =   720
      Width           =   495
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim VarSerialData As Variant
Dim ByteSerialData() As Byte
Dim IntSerialData As Byte
'Dim Revdata As Integer
Dim Revdata() As Integer   'Integer



Private Sub CmdClearText_Click()
Text1.Text = ""
End Sub

Private Sub CmdCloseSPort_Click()
If MSComm1.PortOpen = True Then
MSComm1.PortOpen = False
End If
End Sub

Private Sub CmdCloseVIn_Click()
MSComm1.Output = Chr(4)
End Sub

Private Sub CmdCloseVOut_Click()
MSComm1.Output = Chr(2)
End Sub

Private Sub CmdExit_Click()
If MSComm1.PortOpen = True Then
MSComm1.PortOpen = False
End If
End
End Sub

Private Sub CmdFenli_Click()
MSComm1.Output = Chr(6)
End Sub

Private Sub CmdInjian_Click()
MSComm1.Output = Chr(8)
End Sub

Private Sub CmdInjian1_Click()
MSComm1.Output = Chr(12)
End Sub

Private Sub CmdInPlus_Click()
MSComm1.Output = Chr(7)
End Sub

Private Sub CmdInPlus1_Click()
MSComm1.Output = Chr(11)
End Sub

Private Sub CmdJiehe_Click()
MSComm1.Output = Chr(5)
End Sub

Private Sub CmdOpen_Click()
Dim i As Long


CommonDialog1.Flags = &H2
CommonDialog1.Filter = "文本文件(*.txt)|*.txt"
CommonDialog1.ShowOpen
FileNumber = FreeFile   ' 取得未使用的文件号。
Open CommonDialog1.FileName For Input As #1
'FileLe = FileLen(CommonDialog1.FileName)
ReDim IntFileData(100000, IntNmEcuData)
 Do While Not EOF(1)
  
   
    
   Input #1, IntFileData(i, 0), IntFileData(i, 1), IntFileData(i, 2), IntFileData(i, 3), IntFileData(i, 4), IntFileData(i, 5), _
       IntFileData(i, 6), IntFileData(i, 7), IntFileData(i, 8), IntFileData(i, 9), IntFileData(i, 10), IntFileData(i, 11), _
       IntFileData(i, 12), IntFileData(i, 13), IntFileData(i, 14)
    
 i = i + 1
 Loop
 Close #1
  FileLen = i - 1
  ReDim FileAirPress(FileLen), FilePanel(FileLen), FilePos(FileLen)
   Draw
  
  

End Sub
Private Sub Draw()
Dim i As Integer
Dim x1, x2 As Integer

Do
  If i = FileLen + 1 Then
  Exit Sub
  End If
  FileAirPress(i) = IntFileData(i, 1) * 256 + IntFileData(i, 2)
  FilePanel(i) = IntFileData(i, 3) * 256 + IntFileData(i, 4)
  FilePos(i) = IntFileData(i, 5) * 256 + IntFileData(i, 6)
  If i > 0 Then
   
  x2 = x1 + 1
  Picture1.Line (x1, FileAirPress(i - 1))-(x2, FileAirPress(i)), QBColor(0)
 x1 = x1 + 1
  End If
  i = i + 1
  
  Loop


End Sub

Private Sub CmdOpenSPort_Click()
If MSComm1.PortOpen = False Then
MSComm1.PortOpen = True
End If
Timer1.Enabled = True

End Sub

Private Sub CmdOpenVIn_Click()
MSComm1.Output = Chr(3)
End Sub

Private Sub CmdOpenVOut_Click()

MSComm1.Output = Chr(1)
End Sub

Private Sub CmdOutjian_Click()
MSComm1.Output = Chr(10)
End Sub

Private Sub CmdOutPlus_Click()
MSComm1.Output = Chr(9)
End Sub

Private Sub CmdSave_Click()
Dim i As Integer
CommonDialog1.Flags = &H2
CommonDialog1.Filter = "文本文件(*.txt)|*.txt"
'CommonDialog1.ShowSave
CommonDialog1.FileName = App.Path + "\data\" + Format(Now, "mmddhhmm") + ".txt"
'If CommonDialog1.FileName <> "" Then
FileNumber = FreeFile   ' 取得未使用的文件号。
'If CommonDialog1.FileName = "" Then
If Dir(App.Path & "\Data", vbDirectory) = "" Then
MkDir (App.Path & "\Data")
End If
Open CommonDialog1.FileName For Output As #FileNumber
'Open frmmain.Text1.Text & myfilename & ".txt" For Output As #7
 '       today = Format(Now, "yyyy,mm dd,h m s")
 For i = 0 To NmData
        Write #FileNumber, IntSaveData(i, 0), IntSaveData(i, 1), IntSaveData(i, 2), IntSaveData(i, 3), IntSaveData(i, 4), _
        IntSaveData(i, 5), IntSaveData(i, 6), IntSaveData(i, 7), IntSaveData(i, 8), IntSaveData(i, 9), IntSaveData(i, 10), _
        IntSaveData(i, 11), IntSaveData(i, 12), IntSaveData(i, 13), IntSaveData(i, 14)
 Next i
  Close #FileNumber
End Sub


Private Sub Command1_Click()
MSComm1.Output = Chr(13)
End Sub

Private Sub Command2_Click()
MSComm1.Output = Chr(14)
End Sub

Private Sub Form_Load()
Call SciInitial
PicInit
BlFindHeand = 0
ReDim IntSaveData(1000000, IntNmEcuData)
ReDim Revdata(IntNmEcuData)
Image1.Picture = LoadPicture(App.Path + "\black arrow up.bmp")
Image2.Picture = LoadPicture(App.Path + "\black arrow down.bmp")

End Sub

Private Sub SciInitial()
 MSComm1.CommPort = 1                               'serialport
 MSComm1.Settings = "19200,n,8,1"
 MSComm1.InBufferSize = 30000
 MSComm1.OutBufferSize = 128
 MSComm1.RThreshold = 0
 MSComm1.InputLen = 1
 MSComm1.InputMode = comInputModeBinary

 'serialadtimelong = 30000 '5 minutes
End Sub


Private Sub FindHead()
 Dim i As Integer
 'Dim exitflag As Integer
 i = 0
 Do
    Do
        i = i + 1
        If i > 39 Then
            MsgBox "No SciHead in data from ECU!", 48
            End              'Exit Sub
        End If
        GetSerialData
     Loop Until IntSerialData = SciHead
Loop Until IntSerialData = SciHead
i = 0
For i = 1 To IntNmEcuData
GetSerialData
Next i
BlFindHead = 1
End Sub


Private Sub GetSerialData()
Do
Loop Until MSComm1.InBufferCount <> 0
VarSerialData = MSComm1.Input
ByteSerialData = VarSerialData
IntSerialData = ByteSerialData(0)
End Sub


Private Sub HScPicture_Change()
Picture1.Cls
Picture2.Cls
Picture3.Cls
Picture4.Cls
Picture1.Line (HScPicture.Value, Picture1.ScaleTop)-(HScPicture.Value, Picture1.ScaleTop + Picture1.ScaleHeight), QBColor(0)
Picture2.Line (HScPicture.Value, Picture2.ScaleTop)-(HScPicture.Value, Picture2.ScaleTop + Picture2.ScaleHeight), QBColor(0)
Picture3.Line (HScPicture.Value, Picture3.ScaleTop)-(HScPicture.Value, Picture3.ScaleTop + Picture3.ScaleHeight), QBColor(0)
Picture4.Line (HScPicture.Value, Picture4.ScaleTop)-(HScPicture.Value, Picture4.ScaleTop + Picture4.ScaleHeight), QBColor(0)
Draw
End Sub

Private Sub LblOutDuty_Click()

End Sub

Private Sub Timer1_Timer()
Static x1, x2 As Integer
Dim i As Integer
'If MSComm1.PortOpen = True Then
'FindHead
'End If

If MSComm1.PortOpen = True Then
If BlFindHead = 0 Then
FindHead
End If
'GetSerialData


For i = 0 To IntNmEcuData '?????????????
        GetSerialData
        Revdata(i) = IntSerialData
        'Text1.Text = Text1.Text + Str(IntSerialData)
       
        IntSaveData(NmData, i) = Revdata(i)
    Next i
     
        

'If Revdata(1) <> SciHead Then

Airpress = Revdata(1) * 256 + Revdata(2)
Panel = Revdata(3) * 256 + Revdata(4)
If Revdata(5) < 10 Then
PosCounter = Revdata(5) * 256 + Revdata(6)
End If
Duty = Revdata(7) * 256 + Revdata(8)


Select Case Revdata(9)   ' 判断 Number 的值。
Case 0  ' Number 的值在 1 到 5 之间，包含1 和 5 。
   ValveIn = 0
ValveOut = 0
' 下一个 Case 子句是本示例中唯一判断值为 True 的子句。
Case 1   ' Number 的值在 6 到 8 之间。
   ValveIn = 0
ValveOut = 1
Case 2
ValveIn = 1
ValveOut = 0
Case 3
ValveIn = 1
ValveOut = 1
Case Else   ' 其他数值。
   ValveIn = 0
ValveOut = 0
End Select

'ValveOut = Revdata(9) Mod 1
'ValveIn = (Revdata(9) / 2) Mod 2 '''''''''''''''''''''''''''''''''''''''??????????????????????????????????????????????????????????????
CmdBack = Revdata(10)
LblInFlag.Caption = Revdata(11)
LblOutFlag.Caption = Revdata(12)
'OutDuty = Revdata(13) * 256 + Revdata(14)
If ValveIn = 1 Then
Image1.Picture = LoadPicture("red arrow up.bmp")
Else
Image1.Picture = LoadPicture("black arrow up.bmp")
End If
If ValveOut = 1 Then
Image2.Picture = LoadPicture("red arrow down.bmp")
Else
Image2.Picture = LoadPicture("black arrow down.bmp")
End If
LblAirPress.Caption = Format(Airpress / 1024 * 10, "0.00")
Label16.Caption = Airpress
LblPanel.Caption = Panel
LblDuty.Caption = Duty
LblPosCounter.Caption = PosCounter
LblInputCount.Caption = MSComm1.InBufferCount
LblCmdBack.Caption = CmdBack
LblOutDuty.Caption = OutDuty
LblInDuty.Caption = InDuty

NmData = NmData + 1


x2 = x1 + 1
Picture1.Line (x1, Panel_last)-(x2, Panel), QBColor(0)
Picture2.Line (x1, Airpress_last)-(x2, Airpress), QBColor(0)
Picture3.Line (x1, Duty_last)-(x2, Duty), QBColor(0)
Picture4.Line (x1, PosCounter_last)-(x2, PosCounter), QBColor(0)
Picture5.Line (x1, ValveIn_last)-(x2, ValveIn), QBColor(0)
Picture6.Line (x1, ValveOut_last)-(x2, ValveOut), QBColor(0)
Panel_last = Panel
Duty_last = Duty
Airpress_last = Airpress
PosCounter_last = PosCounter
ValveIn_last = ValveIn
ValveOut_last = ValveOut
x1 = x1 + 1
If x2 = 2000 Then
Picture1.Cls
Picture2.Cls
Picture3.Cls
Picture4.Cls
Picture6.Cls
Picture5.Cls
x1 = 0
End If

End If


'End If
End Sub
Private Sub PicInit()
Picture1.Cls
Picture1.DrawWidth = 1
Picture1.BackColor = QBColor(15)
Picture1.ScaleMode = 0
Picture1.ScaleLeft = 0
Picture1.ScaleTop = 1000
Picture1.ScaleWidth = 2000
Picture1.ScaleHeight = -1000

Picture2.Cls
Picture2.DrawWidth = 1
Picture2.BackColor = QBColor(15)
Picture2.ScaleMode = 0
Picture2.ScaleLeft = 0
Picture2.ScaleTop = 500
Picture2.ScaleWidth = 2000
Picture2.ScaleHeight = -500

Picture3.Cls
Picture3.DrawWidth = 1
Picture3.BackColor = QBColor(15)
Picture3.ScaleMode = 0
Picture3.ScaleLeft = 0
Picture3.ScaleTop = 20000
Picture3.ScaleWidth = 2000
Picture3.ScaleHeight = -20000

Picture4.Cls
Picture4.DrawWidth = 1
Picture4.BackColor = QBColor(15)
Picture4.ScaleMode = 0
Picture4.ScaleLeft = 0
Picture4.ScaleTop = 700
Picture4.ScaleWidth = 2000
Picture4.ScaleHeight = -700

Picture5.Cls
Picture5.DrawWidth = 2
Picture5.BackColor = QBColor(15)
Picture5.ScaleMode = 0
Picture5.ScaleLeft = 0
Picture5.ScaleTop = 3
Picture5.ScaleWidth = 2000
Picture5.ScaleHeight = -3

Picture6.Cls
Picture6.DrawWidth = 2
Picture6.BackColor = QBColor(15)
Picture6.ScaleMode = 0
Picture6.ScaleLeft = 0
Picture6.ScaleTop = 3
Picture6.ScaleWidth = 2000
Picture6.ScaleHeight = -3

End Sub