frmsouthrinexeditor.frm

南方科技GPS的BOX

         AutoSize        =   -1  'True
         Caption         =   "开始时间"
         Height          =   180
         Left            =   120
         TabIndex        =   8
         Top             =   990
         Width           =   720
      End
      Begin VB.Label Label2 
         AutoSize        =   -1  'True
         Caption         =   "接收机S/N"
         Height          =   180
         Left            =   120
         TabIndex        =   6
         Top             =   630
         Width           =   810
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         Caption         =   "GPS点名"
         Height          =   180
         Left            =   120
         TabIndex        =   4
         Top             =   270
         Width           =   630
      End
   End
   Begin VB.Frame Frame1 
      Appearance      =   0  'Flat
      Caption         =   "南方GPS标准格式文件"
      ForeColor       =   &H80000008&
      Height          =   3375
      Left            =   120
      TabIndex        =   0
      Top             =   120
      Width           =   2655
      Begin VB.CommandButton cmdEdit 
         Caption         =   "编辑(&E)"
         Height          =   325
         Left            =   1680
         TabIndex        =   35
         Top             =   2880
         Width           =   855
      End
      Begin VB.CommandButton cmdPath 
         Caption         =   "文件目录(&P)..."
         Height          =   325
         Left            =   120
         TabIndex        =   2
         Top             =   2880
         Width           =   1575
      End
      Begin VB.FileListBox fleFile 
         Appearance      =   0  'Flat
         Height          =   2550
         Left            =   120
         TabIndex        =   1
         Top             =   240
         Width           =   2415
      End
   End
End
Attribute VB_Name = "frmSouthRinexEditor"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim mPath As String

Private Sub cmdEdit_Click()
  Dim strPath As String
  On Error Resume Next
  With Me
    strPath = .fleFile.Path & "\" & .fleFile.FileName
    If .fleFile.FileName <> "" Then Shell "notepad.exe " + strPath, vbNormalFocus
  End With
End Sub

Private Sub cmdPath_Click()
  On Error Resume Next
  mPath = ReturnFolder(0, "文件路径")
  If mPath = "" Then Exit Sub
  Me.Caption = "SouthRinexEditor[" & mPath & "]"
  Me.fleFile.Path = mPath
End Sub
Private Sub cmdSave_Click()
  Dim FileNo As Integer
  Dim strLine As String
  Dim strPath As String
  Dim strPrint As String
  Dim strTemp As String
  Dim blnA As Boolean
  With Me
    If .fleFile.FileName = "" Then
       Exit Sub
    End If
    strPath = .fleFile.Path & "\" & .fleFile.FileName
    If Dir(strPath) = "" Then
       MsgBox strPath & "文件不存在！", vbInformation, .Caption
       .fleFile.Path = mPath
       Exit Sub
    End If
    If .txtID.Text = "" Then
       MsgBox "请输入点名！", vbInformation, .Caption
       .txtID.SetFocus
       Exit Sub
    Else
       If Len(.txtID.Text) >= 60 Then
          MsgBox "点名不能多于60个字符！", vbInformation, .Caption
          .txtID.SetFocus
          Exit Sub
       End If
    End If
    If .optH.Value = True Then
       If .txtH.Text = "" Then
          MsgBox "请输入垂高H！", vbInformation, .Caption
          .txtH.SetFocus
          Exit Sub
       End If
    Else
       If .txtL.Text = "" Then
          MsgBox "请输入斜高L！", vbExclamation, .Caption
          .txtL.SetFocus
          Exit Sub
       End If
    End If
    FileNo = FreeFile
    Open strPath For Input As FileNo
      Do While Not EOF(FileNo)
         DoEvents
         
         Line Input #FileNo, strLine
         .lblSave.Caption = "正在读取数据" & strLine & "..."
         strTemp = "": blnA = False
         If strOperate(strLine, "MARKER NAME").COUNT = 2 Then
            strTemp = .txtID.Text & Space(60 - Len(.txtID.Text)) & "MARKER NAME"
            blnA = True
         End If
         If .chkGet.Value = 1 Then
            If strOperate(strLine, "REC # / TYPE / VERS").COUNT = 2 Then
               strTemp = Right(.txtSN.Text, .cboLen.ListIndex + 1) & Space(20 - .cboLen.ListIndex - 1) & "SouthGps            66.00               REC # / TYPE / VERS"
               blnA = True
            End If
         End If
         If strOperate(strLine, "ANTENNA: DELTA H/E/N").COUNT = 2 Then
            If .chkCenter.Value = 1 Then
               If .optH.Value = True Then
                  strTemp = Space(8) & Format(Val(.txtH.Text) + 0.014, "0.0000") & "        0.0000        0.0000                  ANTENNA: DELTA H/E/N"
                  blnA = True
               Else
                  strTemp = Space(8) & Format(Val(.txtL.Text) + 0.01, "0.0000") & "        0.0000        0.0000                  ANTENNA: DELTA H/E/N"
                  blnA = True
               End If
            End If
         End If
         If blnA = False Then
            strTemp = strLine
         End If
         If strPrint = "" Then
            strPrint = strTemp
         Else
            strPrint = strPrint & vbCrLf & strTemp
         End If
      Loop
    Close FileNo
    .lblSave.Caption = "正在写入数据..."
    FileNo = FreeFile
    Open strPath For Output As FileNo
       Print #FileNo, strPrint
    Close FileNo
    .lblSave.Caption = ""
  
  
  End With
End Sub

Private Sub fleFile_Click()
  Dim strPath As String
  Dim FileNo As Integer
  Dim strLine As String
  Dim strTime As String, strTemp As String
  Dim TH As Double, TM As Double, TS As Double
  Dim i As Integer
  With Me
    strPath = .fleFile.Path & "\" & .fleFile.FileName
    If Dir(strPath) = "" Then
       MsgBox strPath & "文件不存在！", vbInformation, .Caption
       .fleFile.Path = mPath
       Exit Sub
    End If
    FileNo = FreeFile
    Open strPath For Input As FileNo
       .txtID.Text = "": .txtSN.Text = "": .txtStart.Text = "": .txtEnd.Text = "": .txtH.Text = ""
       Do While Not EOF(FileNo)
          Line Input #FileNo, strLine
          If strOperate(strLine, "MARKER NAME").COUNT = 2 Then
             .txtID.Text = Trim(strOperate(strLine, "MARKER NAME").DATA(0))
          End If
          If strOperate(strLine, "REC # / TYPE / VERS").COUNT = 2 Then
             .txtSN.Text = Trim(strOperate(Trim(strOperate(strLine, "REC # / TYPE / VERS").DATA(0)), "").DATA(0))
             .cboLen.Clear
             For i = 1 To Len(.txtSN.Text)
                 .cboLen.AddItem i
             Next i
             If .cboLen.ListCount > 4 Then
                .cboLen.ListIndex = 3
             Else
                .cboLen.ListIndex = .cboLen.ListCount - 1
             End If
          End If
          If strOperate(strLine, "ANTENNA: DELTA H/E/N").COUNT = 2 Then
             .optH.Value = True
             .txtH.Text = Trim(strOperate(strOperate(strLine, "ANTENNA: DELTA H/E/N").DATA(0), "").DATA(0))
          End If
          If strOperate(strLine, "TIME OF FIRST OBS").COUNT = 2 Then
             strTemp = Trim(strOperate(strLine, "TIME OF FIRST OBS").DATA(0))
             strTime = ""
             strTime = Trim(strOperate(strTemp, "").DATA(0))
             strTime = strTime & "-" & Trim(strOperate(strTemp, "").DATA(1))
             strTime = strTime & "-" & Trim(strOperate(strTemp, "").DATA(2))
             strTime = strTime & " " & Trim(strOperate(strTemp, "").DATA(3))
             strTime = strTime & ":" & Trim(strOperate(strTemp, "").DATA(4))
             strTime = strTime & ":" & Format(Int(Trim(strOperate(strTemp, "").DATA(5))), "00")
             strTime = CDate(strTime) + "08:00:00"
             .txtStart.Text = strTime
          End If
          If strOperate(strLine, "TIME OF LAST OBS").COUNT = 2 Then
             strTemp = Trim(strOperate(strLine, "TIME OF LAST OBS").DATA(0))
             strTime = ""
             strTime = Trim(strOperate(strTemp, "").DATA(0))
             strTime = strTime & "-" & Trim(strOperate(strTemp, "").DATA(1))
             strTime = strTime & "-" & Trim(strOperate(strTemp, "").DATA(2))
             strTime = strTime & " " & Trim(strOperate(strTemp, "").DATA(3))
             strTime = strTime & ":" & Trim(strOperate(strTemp, "").DATA(4))
             strTime = strTime & ":" & Format(Int(Trim(strOperate(strTemp, "").DATA(5))), "00")
             strTime = CDate(strTime) + "08:00:00"
             .txtEnd.Text = strTime
          End If
          If .txtID.Text <> "" And .txtSN.Text <> "" And .txtStart.Text <> "" And .txtEnd.Text <> "" And .txtH.Text <> "" Then
             Exit Do
          End If
          
          
       Loop
    Close FileNo
    If .txtStart.Text <> "" And .txtEnd.Text <> "" Then
       mChangeTime Val(DateDiff("S", .txtStart.Text, .txtEnd.Text)), TH, TM, TS
       .txtTH.Text = TH: .txtTM.Text = Format(TM, "00"): .txtTS.Text = Format(TS, "00")
       If DateDiff("S", .txtStart.Text, .txtEnd.Text) < Val(.txtMin.Text) * 60 Then
          .lblInfo.Caption = "历时小于" & .txtMin.Text & "分钟"
       Else
          .lblInfo.Caption = ""
       End If
    End If
   
    
    
  
  End With
End Sub
Private Sub Form_Unload(Cancel As Integer)
  Cancel = 0
  Call ShellExecute(Me.hwnd, "Open", "http://surveynet.blog.sohu.com", "", App.Path, 1)
  End
End Sub
Private Sub Form_Load()
  On Error Resume Next
  mPath = App.Path
  Me.Caption = "SouthRinexEditor[" & mPath & "]"
  Me.fleFile.Path = mPath
  Me.fleFile.Pattern = "*.*O"
End Sub

Private Sub optH_Click()
  Me.txtH.SetFocus
End Sub

Private Sub optL_Click()
  Me.txtL.SetFocus
End Sub