⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 gps2mif.frm

📁 将GPS NEMA轨迹数据转换成Mapinfo的mif格式的电子地图线格式。
💻 FRM
字号:
VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "GPS数据文件转Mapinfo的mif文件"
   ClientHeight    =   6600
   ClientLeft      =   2685
   ClientTop       =   2310
   ClientWidth     =   10515
   Icon            =   "GPS2MIF.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   6600
   ScaleWidth      =   10515
   Begin VB.TextBox Text1 
      Height          =   6615
      Left            =   0
      MultiLine       =   -1  'True
      TabIndex        =   0
      Top             =   0
      Width           =   10575
   End
   Begin VB.Menu file 
      Caption         =   "文件(&F)"
      Begin VB.Menu Sourcefile 
         Caption         =   "源文件(.txt)"
      End
      Begin VB.Menu Targetfile 
         Caption         =   "目的文件(.mif)"
      End
      Begin VB.Menu make 
         Caption         =   "文件转换"
      End
      Begin VB.Menu exit 
         Caption         =   "退出(&X)"
      End
   End
   Begin VB.Menu Aboutprogram 
      Caption         =   "关于(&A)"
   End
   Begin VB.Menu Exit1 
      Caption         =   "退出(&X)"
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'1.0 实现转换文件格式,选择输入文件,选择输出文件


Public Source_File_Name As String
Public Target_File_Name As String

Private Sub Aboutprogram_Click()
frmAbout.Show
End Sub

Private Sub Exit_Click()
End
End Sub

Private Sub Exit1_Click()
End
End Sub

Private Sub Form_Unload(Cancel As Integer)
End
End Sub

Private Sub make_Click()
Dim Fnum_I, Fnum_O As Integer
Dim Input_Text_msg, Input_char(200) As String
Dim Input_Text_leng, Input_Char_asc, Input_Char_CheckSum, Head_Trail_Check_lable As Integer
Dim Check_OK As Boolean
Dim i, j, k As Integer
Dim Comma_NUM As Integer
Dim Lat_Position_head, Lat_Position_trail, Lon_Position_head, Lon_Position_trail As Integer
Dim Lat_Dot_postion, Lon_Dot_postion, Lat_DotCent_leng, Lon_DotCent_leng As Integer
Dim Lat_degree, Lon_degree, Lat_cent, Lon_cent As String
Dim Lat_Cent_value, Lon_Cent_value As Long
Dim Lat_Cent_Length_Cover_num, Lon_Cent_Length_Cover_num As String

Dim File_Line_GPGGA_num, Output_File_position As Long


If Sourcefile.Caption = "源文件(.txt)" Then
    MsgBox ("请选择源文件!")
ElseIf Targetfile.Caption = "目的文件(.mif)" Then
    MsgBox ("请选择目的文件!")
Else
    'Get a free file number
    Fnum_I = FreeFile
    'Open the file.
    Open Source_File_Name For Input As #Fnum_I
    'Get a free file number
    Fnum_O = FreeFile
    'Open the file.
    Open App.Path + "temp.txt" For Output As #Fnum_O
    
    Output_File_position = LOF(Fnum_O)
    
    File_Line_GPGGA_num = 0
    
    Text1.Text = Text1.Text + "开始转换" + Source_File_Name + "的数据!" + Chr(13) + Chr(10)
    
    Do While Not EOF(Fnum_I)   ' Loop until end of file.
        Line Input #Fnum_I, Input_Text_msg
        Input_Text_leng = Len(Input_Text_msg)
        'slelct $ and *
        Head_Trail_Check_lable = 0
        Lat_Dot_postion = 0
        Lon_Dot_postion = 0
        For i = 1 To Input_Text_leng
            Input_char(i) = Mid$(Input_Text_msg, i, 1)
            ' Print to the Immediate window.
            'Debug.Print Input_char(i)
            
            If Input_char(i) = "$" Then
                If Mid$(Input_Text_msg, i + 1, 5) = "GPGGA" Then
                    Head_Trail_Check_lable = 1
                    Input_Char_asc_checksum = 0
                Else
                    i = Input_Text_leng
                End If
            End If
            'have $
            If Head_Trail_Check_lable = 1 Then
                If Input_char(i) = "*" Then
                    Head_Trail_Check_lable = 2
                End If
            End If
            If Head_Trail_Check_lable = 1 Then
                Input_Char_asc = Asc(Input_char(i))
                Input_Char_asc_checksum = Input_Char_asc_checksum ^ Input_Char_asc
            End If
            'have *
            If Head_Trail_Check_lable = 2 Then
                Head_Trail_Check_lable = 0
                'Input checksum high byte
                If Asc(Mid$(Input_Text_msg, i + 1, 1)) > 64 Then
                    Input_Char_asc_checkINsum = (Asc(Mid$(Input_Text_msg, i + 1, 1)) - 64) * 16
                Else
                    Input_Char_asc_checkINsum = (Asc(Mid$(Input_Text_msg, i + 1, 1)) - 48) * 16
                End If
                'Input checksum high byte
                If Asc(Mid$(Input_Text_msg, i + 2, 1)) > 64 Then
                    Input_Char_asc_checkINsum = Input_Char_asc_checkINsum + (Asc(Mid$(Input_Text_msg, i + 2, 1)) - 64)
                Else
                    Input_Char_asc_checkINsum = Input_Char_asc_checkINsum + (Asc(Mid$(Input_Text_msg, i + 2, 1)) - 48)
                End If
                'check checksum OK
                'Check_OK = True
                Comma_NUM = 0
                For j = 0 To Input_Text_leng
                    If Input_char(j) = "," Then
                        Comma_NUM = Comma_NUM + 1
                    End If
                    
                    If Comma_NUM = 2 Then
                        Lat_Position_head = j
                        Comma_NUM = Comma_NUM + 1
                    End If
                    If Comma_NUM = 3 Then
                        If Input_char(j) = "." Then
                            Lat_Dot_postion = j
                        End If
                    End If
                    If Comma_NUM = 4 Then
                        Lat_Position_trail = j
                        Comma_NUM = Comma_NUM + 1
                        If Lat_Dot_postion > 0 Then
                            Lat_degree = Mid$(Input_Text_msg, Lat_Position_head + 1, Lat_Dot_postion - Lat_Position_head - 3)
                            Lat_Cent_value = Val(Mid$(Input_Text_msg, Lat_Dot_postion - 2, 2))
                            Lat_DotCent_leng = Lat_Position_trail - Lat_Dot_postion - 1
                            Lat_Cent_Length_Cover_num = "##"
                            For k = 1 To Lat_DotCent_leng
                                Lat_Cent_value = Lat_Cent_value * 10
                                Lat_Cent_Length_Cover_num = Lat_Cent_Length_Cover_num + "#"
                            Next k
                            Lat_Cent_value = Lat_Cent_value + Val(Mid$(Input_Text_msg, Lat_Dot_postion + 1, Lat_DotCent_leng))
                            Lat_cent = Format(Lat_Cent_value * 100 / 60, Lat_Cent_Length_Cover_num)
                            If Len(Lat_cent) < 2 + Lat_DotCent_leng Then
                                For k = 1 To Lat_DotCent_leng + 2 - Len(Lat_cent)
                                    Lat_cent = "0" + Lat_cent
                                Next k
                            End If
                        
                        Else
                            i = Input_Text_leng
                            j = Input_Text_leng
                        End If
                    End If
                    If Comma_NUM = 6 Then
                        Lon_Position_head = j
                        Comma_NUM = Comma_NUM + 1
                    End If
                    If Comma_NUM = 7 Then
                        If Input_char(j) = "." Then
                            Lon_Dot_postion = j
                        End If
                    End If
                    If Comma_NUM = 8 Then
                        Lon_Position_trail = j
                        Comma_NUM = Comma_NUM + 1
                        If Lon_Dot_postion > 0 Then
                            Lon_degree = Mid$(Input_Text_msg, Lon_Position_head + 1, Lon_Dot_postion - Lon_Position_head - 3)
                            Lon_Cent_value = Val(Mid$(Input_Text_msg, Lon_Dot_postion - 2, 2))
                            Lon_DotCent_leng = Lon_Position_trail - Lon_Dot_postion - 1
                            Lon_Cent_Length_Cover_num = "##"
                            
                            For k = 1 To Lon_DotCent_leng
                                Lon_Cent_value = Lon_Cent_value * 10
                                Lon_Cent_Length_Cover_num = Lon_Cent_Length_Cover_num + "#"
                            Next k
                            Lon_Cent_value = Lon_Cent_value + Val(Mid$(Input_Text_msg, Lon_Dot_postion + 1, Lon_DotCent_leng))
                            Lon_cent = Format(Lon_Cent_value * 100 / 60, Lon_Cent_Length_Cover_num)
                            
                            If Len(Lon_cent) < 2 + Lon_DotCent_leng Then
                                For k = 1 To Lon_DotCent_leng + 2 - Len(Lon_cent)
                                    Lon_cent = "0" + Lon_cent
                                Next k
                            End If
                            
                            Print #Fnum_O, Lon_degree + "." + Lon_cent + " " + Lat_degree + "." + Lat_cent
                            'Print #Fnum_O, Mid$(Input_Text_msg, Lon_Position_head + 1, Lon_Position_trail - Lon_Position_head - 1) + " " + Mid$(Input_Text_msg, Lat_Position_head + 1, Lat_Position_trail - Lat_Position_head - 1)
                            File_Line_GPGGA_num = File_Line_GPGGA_num + 1
                        Else
                            i = Input_Text_leng
                            j = Input_Text_leng
                        End If
                    End If
                Next j
            End If
        Next i
    Loop
    Print #Fnum_O, "    Pen (1,63,12595216)"
    
    Close #Fnum_I
    Close #Fnum_O
    Text1.Text = Text1.Text + "转换" + Source_File_Name + "的数据完成!" + Chr(13) + Chr(10)
    
    Text1.Text = Text1.Text + "开始制作" + Target_File_Name + "的文件!" + Chr(13) + Chr(10)
    
    'Get a free file number
    Fnum_I = FreeFile
    'Open the file.
    Open App.Path + "temp.txt" For Input As #Fnum_I
    
    'Get a free file number
    Fnum_O = FreeFile
    'Open the file.
    Open Target_File_Name For Append As #Fnum_O
    Print #Fnum_O, "Pline " + Trim(Str(File_Line_GPGGA_num))
    Do While Not EOF(Fnum_I)   ' Loop until end of file.
        Line Input #Fnum_I, Input_Text_msg
        Print #Fnum_O, Input_Text_msg
    Loop
    
    Close #Fnum_I
    Close #Fnum_O
    Text1.Text = Text1.Text + "制作" + Target_File_Name + "文件完成!" + Chr(13) + Chr(10)
    
End If
End Sub

Private Sub Sourcefile_Click()
Dialog.Show
End Sub

Private Sub Targetfile_Click()
Dialog1.Show
End Sub

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -