frmmain.frm

主要对汽车电子行业全天候时间调整

VERSION 5.00
Begin VB.Form frmmain 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "GPS对时"
   ClientHeight    =   6510
   ClientLeft      =   150
   ClientTop       =   435
   ClientWidth     =   9510
   Icon            =   "frmmain.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   6510
   ScaleWidth      =   9510
   StartUpPosition =   2  '屏幕中心
   Begin VB.Timer Timer3 
      Enabled         =   0   'False
      Interval        =   1000
      Left            =   4800
      Top             =   3480
   End
   Begin VB.PictureBox txtmbw 
      BackColor       =   &H80000012&
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   4455
      Left            =   360
      ScaleHeight     =   4395
      ScaleWidth      =   8835
      TabIndex        =   5
      Top             =   1800
      Width           =   8895
   End
   Begin VB.Timer Timer2 
      Interval        =   1000
      Left            =   5040
      Top             =   2640
   End
   Begin VB.Timer Timer1 
      Interval        =   1000
      Left            =   3600
      Top             =   2760
   End
   Begin VB.PictureBox MSComm1 
      Height          =   480
      Left            =   4125
      ScaleHeight     =   420
      ScaleWidth      =   1140
      TabIndex        =   7
      Top             =   2160
      Width           =   1200
   End
   Begin VB.CheckBox chkmbw 
      Caption         =   "通讯报文显示"
      BeginProperty Font 
         Name            =   "楷体_GB2312"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   300
      Left            =   360
      TabIndex        =   3
      Top             =   1440
      Width           =   2055
   End
   Begin VB.PictureBox GPSMx 
      Height          =   480
      Left            =   495
      ScaleHeight     =   420
      ScaleWidth      =   1140
      TabIndex        =   4
      Top             =   1800
      Width           =   1200
   End
   Begin VB.Label Label4 
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   9.75
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   1560
      TabIndex        =   6
      Top             =   960
      Width           =   2295
   End
   Begin VB.Label Label3 
      Alignment       =   2  'Center
      AutoSize        =   -1  'True
      Caption         =   "系统时间:"
      BeginProperty Font 
         Name            =   "楷体_GB2312"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   360
      TabIndex        =   2
      Top             =   960
      Width           =   1095
   End
   Begin VB.Image Image1 
      Height          =   525
      Left            =   2940
      Picture         =   "frmmain.frx":2CFA
      Stretch         =   -1  'True
      Top             =   120
      Width           =   4200
   End
   Begin VB.Label Label1 
      Alignment       =   2  'Center
      AutoSize        =   -1  'True
      Caption         =   "GPS时间:"
      BeginProperty Font 
         Name            =   "楷体_GB2312"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   4335
      TabIndex        =   0
      Top             =   975
      Width           =   1080
   End
   Begin VB.Label labsystimer 
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   9.75
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   5595
      TabIndex        =   1
      Top             =   990
      Width           =   3135
   End
   Begin VB.Menu mnufile 
      Caption         =   "文件"
      Begin VB.Menu mnuStart 
         Caption         =   "开始转发"
         Visible         =   0   'False
      End
      Begin VB.Menu mnuStop 
         Caption         =   "停止转发"
         Visible         =   0   'False
      End
      Begin VB.Menu mnuSet 
         Caption         =   "设置"
         Visible         =   0   'False
      End
      Begin VB.Menu mnuExit 
         Caption         =   "退出"
      End
   End
End
Attribute VB_Name = "frmmain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
    Dim tempe(72) As Integer
    Dim temp As String
    Dim xsbuf As String
    Dim xsdata As String
    Dim recBuf As Variant
    Dim reclen As Integer
    Dim h As Integer

Sub ProcessReceInfo(receBuffer As Variant)
    On Error GoTo ErrHandler:
    Dim tempyear As String
    Dim tempmonth As Integer
    Dim tempdat As String
    Dim tempmin As String
    Dim tempsec As Integer
    Dim tempstr, tempstr1, tempchar As String
    Dim i
    Dim tempxs As String
    Dim tempdata As String
    Dim sendstr As String

If (recBuf(0) = 36 And recBuf(70) = 13 And recBuf(71) = 10) Then
        tempyear = (receBuffer(57) - &H30) * 10 & (receBuffer(58) - &H30)
        tempstr = Trim(Str(tempyear))
    If Len(tempstr) < 2 Then
        tempstr = "0" & tempstr
    End If
    tempdata = "20" & tempstr & "-"

    tempmonth = (receBuffer(55) - &H30) * 10 + (receBuffer(56) - &H30)
    tempstr = Trim(Str(tempmonth))
    If Len(tempstr) < 2 Then
        tempstr = "0" & tempstr
    End If
    tempdata = tempdata & tempstr & "-"

    tempdat = (receBuffer(53) - &H30) * 10 + (receBuffer(54) - &H30)
    tempstr = Trim(Str(tempdat))
    If Len(tempstr) < 2 Then
        tempstr = "0" & tempstr
    End If
    tempdata = tempdata & tempstr & " "

    tempxs = (receBuffer(29) - &H30) * 10 + (receBuffer(30) - &H30)
    tempstr = Trim(Str(tempxs))
    If Len(tempstr) < 2 Then
        tempstr = "0" & tempstr
    End If
    tempdata = tempdata & tempstr & ":"

    tempxs = (receBuffer(9) - 48) * 10 + (receBuffer(10) - 48)
    tempstr = Trim(Str(tempxs))
    If Len(tempstr) < 2 Then
        tempstr = "0" & tempstr
    End If
    tempdata = tempdata & tempstr & ":"

    tempxs = (receBuffer(11) - 48) * 10 + (receBuffer(12) - 48)
    tempstr = Trim(Str(tempxs))
    If Len(tempstr) < 2 Then
        tempstr = "0" & tempstr
    End If
    tempdata = tempdata & tempstr
    labsystimer.Caption = tempdata
    Dim tempinterval
        Dim tdate As Date
        tdate = tempdata
        Date = tdate
        Time = tdate

End If
labsystimer.Caption = Format(Now, "yyyy-mm-dd hh:nn:ss")
ErrHandler:
    Call SendMassageInfo
 
End Sub
Sub rbw()
If chkmbw.Value = 1 Then
    Dim tempstr, tempstr1 As String
    Dim tempchar, alinestr As String
    Dim strtext As String
        If Len(txtmbw.Text) > 4000 Then
            txtmbw.Text = ""
        End If
        txtmbw.SelColor = vbMagenta
        tempstr1 = "Rx:" & xsbuf
        txtmbw.SelHangingIndent = 520
        txtmbw.SelStart = Len(txtmbw.Text)
        txtmbw.SelText = tempstr1 & vbCrLf
        Timer3.Enabled = True
        
End If

End Sub

Private Sub Form_Activate()
    chkmbw.Value = 1
End Sub

Private Sub Form_Load()

    MSComm6.PortOpen = True
    Label4.ForeColor = vbMagenta
    labsystimer.ForeColor = vbMagenta
    Label4.Caption = Format(Now, "yyyy-mm-dd hh:nn:ss")
'    txtmbw.Text = ""
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    If UnloadMode = vbFormControlMenu Then
        Cancel = True
    End If
End Sub
Private Sub mnuExit_Click()
    FrmExit.Show
End Sub

Private Sub Timer1_Timer()
    On Error GoTo ErrHandler:
    MSComm1.InputMode = comInputModeBinary
    recBuf = MSComm1.Input
    reclen = Len(recBuf)
    xsbuf = " "
    
    If reclen = 36 And recBuf(0) = 36 And recBuf(70) = 13 And recBuf(71) = 10 Then
    Dim i, j As Integer
        For j = 0 To reclen * 2 - 1
            tempe(j) = recBuf(j)
        Next j
        For i = 0 To 71
            temp = Hex(tempe(i))
                If Len(temp) < 2 Then
                    temp = 0 & temp
                End If
            xsbuf = xsbuf & " " & temp
        Next i
        'xsdata = Mid(xsbuf, 29, 11)
    Call rbw
    Call ProcessReceInfo(recBuf)
    End If
ErrHandler:
        Call SendMassageInfo
    
End Sub

Private Sub SendMassageInfo()
    
    h = h + 1
    If h > 10 Then
    h = 0
    End If
End Sub


Private Sub Timer2_Timer()
    Label4.ForeColor = vbMagenta
    Label4.Caption = Format(Now, "yyyy-mm-dd hh:nn:ss")
    'labsystimer.Caption = Format(Now, "yyyy-mm-dd hh:nn:ss")
End Sub

Private Sub Timer3_Timer()
    labsystimer.Caption = Format(Now, "yyyy-mm-dd hh:nn:ss")
End Sub