📄 frminvehunit.frm
字号:
Width = 975
End
Begin VB.Label Label8
Caption = "纬度："
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 6840
TabIndex = 17
Top = 3000
Width = 1095
End
Begin VB.Label Label7
Caption = "经度:"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 6840
TabIndex = 16
Top = 2400
Width = 975
End
Begin VB.Label Label6
Caption = "状态/请求"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 6840
TabIndex = 15
Top = 1800
Width = 975
End
Begin VB.Label Label5
Caption = "车辆编号："
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 6840
TabIndex = 9
Top = 1200
Width = 1215
End
Begin VB.Label Label4
Caption = "回传的请求/运行状态信息："
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 735
Left = 120
TabIndex = 7
Top = 5280
Width = 1215
End
Begin VB.Label Label3
Caption = "回传的所有信息："
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 735
Left = 120
TabIndex = 5
Top = 1800
Width = 1095
End
Begin VB.Label Label2
Caption = "回传的定位信息："
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 120
TabIndex = 3
Top = 4320
Width = 1095
End
Begin VB.Label Label1
Caption = "调度指令："
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 120
TabIndex = 1
Top = 1080
Width = 1215
End
End
Attribute VB_Name = "FrmInVehUnit"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Command1_Click()
Dim CtrlInstruction(1 To 2), Instru As String
Dim TempValue As Integer
TempValue = Int(6 * Rnd + 1)
Text9.Text = 0
Select Case TempValue
Case 1
CtrlInstruction(1) = b2q("#CTR,01,K") & vbCrLf
CtrlInstruction(2) = b2q("#CTR,01,N") & vbCrLf
Instru = CtrlInstruction(1) & CtrlInstruction(2)
Timer1.Interval = 5000
Case 2
CtrlInstruction(1) = b2q("#CTR,01,D") & vbCrLf
CtrlInstruction(2) = b2q("#CTR,01,P") & vbCrLf
Instru = CtrlInstruction(1) & CtrlInstruction(2)
Timer1.Interval = 0
Case 3
CtrlInstruction(1) = b2q("#CTR,01,K") & vbCrLf
CtrlInstruction(2) = b2q("#CTR,01,L") & vbCrLf
Instru = CtrlInstruction(1) & CtrlInstruction(2)
Timer1.Interval = 5000
Case 4
CtrlInstruction(1) = b2q("#CTR,01,D") & vbCrLf
CtrlInstruction(2) = b2q("#CTR,01,N") & vbCrLf
Instru = CtrlInstruction(1) & CtrlInstruction(2)
Timer1.Interval = 0
Case 5
CtrlInstruction(1) = b2q("#CTR,01,D") & vbCrLf
CtrlInstruction(2) = b2q("#CTR,01,L") & vbCrLf
Instru = CtrlInstruction(1) & CtrlInstruction(2)
Timer1.Interval = 0
Case 6
CtrlInstruction(1) = b2q("#CTR,01,K") & vbCrLf
CtrlInstruction(2) = b2q("#CTR,01,P") & vbCrLf
Instru = CtrlInstruction(1) & CtrlInstruction(2)
Timer1.Interval = 5000
End Select
MSComm1.Output = Instru
Text1.Text = Instru
End Sub
Private Sub Command2_Click()
MSComm1.PortOpen = False
Unload Me
End Sub
Private Sub Command3_Click()
Dim delID As String
Dim I As Integer
delID = InputBox$("请输入待删除的的VehicleNumber:", "删除")
If delID <> "" And RichTextBox1 <> "" Then
If MsgBox("真的要删除吗？", vbYesNo, "删除信息") = vbYes Then
Adodc1.Recordset.MoveFirst
Do Until Adodc1.Recordset.EOF
If Trim(Adodc1.Recordset!vehicleid) = delID Then
Adodc1.Recordset.Delete
End If
Adodc1.Recordset.MoveNext
Loop
End If
End If
End Sub
Private Sub Form_Load()
Text1.Text = ""
Text2.Text = ""
Text3.Text = ""
Text4.Text = ""
Text5.Text = ""
Text6.Text = ""
Text7.Text = ""
Text9.Text = 0
RichTextBox1.Text = ""
RichTextBox2.Text = ""
RichTextBox3.Text = ""
MSComm1.CommPort = 1
MSComm1.Settings = "1200,N,8,1"
MSComm1.InputLen = 0
MSComm1.InBufferSize = 1024
MSComm1.PortOpen = True
MSComm1.InBufferCount = 0
MSComm1.OutBufferCount = 0
Timer1.Interval = 0
End Sub
Private Sub Timer1_Timer()
Dim ReceiveStr, Response As String
Static OldStr As String
Dim BeginPosition As Integer
Dim I As Integer, Pos(0 To 15) As Integer
Dim MessStr(1 To 16) As String
Text9.Text = Text9.Text + 1
ReceiveStr = MSComm1.Input
RichTextBox2.Text = ReceiveStr
BeginPosition = InStr(1, ReceiveStr, "#MOVE", vbTextCompare)
ReceiveStr = Right$(ReceiveStr, Len(ReceiveStr) - BeginPosition)
RichTextBox1.Text = ReceiveStr
'若有效串的长度少于 95 退出本子程序,等待下一次显示
If (Len(ReceiveStr) < 85) Then
OldStr = ReceiveStr
Exit Sub
End If
RichTextBox2.Text = OldStr & ReceiveStr
BeginPosition = InStr(1, ReceiveStr, "#MOVE", vbTextCompare)
'取各参数
Pos(0) = 0
For I = 1 To 15
Pos(I) = InStr(Pos(I - 1) + 1, ReceiveStr, ",", vbTextCompare)
Next I
For I = 1 To 14
MessStr(I) = Mid$(ReceiveStr, Pos(I) + 1, Pos(I + 1) - Pos(I) - 1)
Next I
MessStr(15) = Right$(ReceiveStr, 4)
MessStr(16) = "MOVE"
Dim cnn1 As ADODB.Connection
Dim rstTemp As ADODB.Recordset
Dim cmdDispatch As Command
'创建新的连接对象,打开连接
Set cnn1 = New ADODB.Connection
cnn1.ConnectionString = "DSN=dispatch.mdb"
cnn1.CursorLocation = adUseClient
cnn1.Mode = adModeUnknown
cnn1.Open
'创建新的纪录集对象
Set rstTemp = New ADODB.Recordset
rstTemp.CursorType = adOpenKeyset
rstTemp.LockType = adLockOptimistic
Set rstTemp.ActiveConnection = cnn1
'创建新的的命令对象
rstTemp.Open "TransferData", cnn1, , , adCmdTable
Dim TimeValue As Single
Adodc1.Recordset.AddNew
Adodc1.Recordset.Fields("Start") = MessStr(16)
Adodc1.Recordset.Fields("VehicleID") = MessStr(1)
Adodc1.Recordset.Fields("Order") = MessStr(2)
Adodc1.Recordset.Fields("Field#") = MessStr(3) & "," & MessStr(4)
Adodc1.Recordset.Fields("Status") = MessStr(5)
Adodc1.Recordset.Fields("NoOfSP") = MessStr(6)
Adodc1.Recordset.Fields("Seed") = MessStr(7)
Adodc1.Recordset.Fields("DOP*100") = MessStr(8)
Adodc1.Recordset.Fields("Latitude") = MessStr(9)
Adodc1.Recordset.Fields("Longitude") = MessStr(10)
Adodc1.Recordset.Fields("Altitude") = MessStr(11)
Adodc1.Recordset.Fields("Localdate") = MessStr(12)
Adodc1.Recordset.Fields("Speed") = MessStr(13)
Adodc1.Recordset.Fields("TrueCorse") = MessStr(14)
Adodc1.Recordset.Fields("MagneticCourse") = MessStr(15)
Adodc1.Recordset.Update
Text2.Text = MessStr(1)
Text3.Text = "回传信息"
Text4.Text = MessStr(10)
Text5.Text = MessStr(9)
Text6.Text = MessStr(13)
Text7.Text = MessStr(12)
OldStr = Right$(ReceiveStr, Len(ReceiveStr) - Pos(1))
If RichTextBox2.Text = "" And Text9.Text > 5 Then
Text9.Text = 0
Response = MsgBox("通信失败！请检查车载机是否工作正常！继续通信吗？", 53, "错误消息框")
If Response = vbCancel Then
Timer1.Interval = 0: Command1.Enabled = True: Exit Sub
End If
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -