frmtrakker.ebf

evc与mapx mobile 在PDA上开发的GPS接收器。你的电脑上最好有evc++4.0和ppc2003模拟器

'set the point
Set ptVehiclePoint = CreateObject(cPOINTobject)
ptVehiclePoint.Set Map1.CenterX, Map1.CenterY
'add a point at the center of the map
Set ftrVehicle = Map1.Layers(cMapTempLayerPoints).AddFeature(Map1.FeatureFactory.CreateSymbol(ptVehiclePoint))

'set the styles of the symbol
ftrVehicle.Style.SymbolFont = "Map Symbols"
ftrVehicle.Style.SymbolFont.Size = 7
ftrVehicle.Style.SymbolCharacter = 35
ftrVehicle.Style.SymbolFontColor = miColorRed
ftrVehicle.Style.SymbolFontHalo = True
ftrVehicle.Style.SymbolFontBackColor = miColorBlack

'update the symbol or the changes won't display
ftrVehicle.Update

Map1.AutoRedraw = True

End Sub

Private Sub CreateMenuBarButtons()
'//////////////////////////////////////////////////////////////////////////////
' SUB CreateMenuBarButtons()
'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
' Creates the menusbar buttons, loads the images
'//////////////////////////////////////////////////////////////////////////////

    
    Dim btnSpacer As MenuBarButton
    Dim btnGo As MenuBarButton
    Dim btnCompass As MenuBarButton
    
    ' Add a spacer
    Set btnSpacer = MenuBar1.Controls.AddButton
    btnSpacer.Width = 80
    btnSpacer.Style = mbrSeparator
    
    ' Go/Stop
    
    ImageList1.ImageHeight = 16
    ImageList1.ImageWidth = 16
        
    ImageList1.Add cPathToMapsAndData & "go.bmp"
    ImageList1.Add cPathToMapsAndData & "Pause.bmp"
    ImageList1.Add cPathToMapsAndData & "E.bmp"
    ImageList1.Add cPathToMapsAndData & "NE.bmp"
    ImageList1.Add cPathToMapsAndData & "N.bmp"
    ImageList1.Add cPathToMapsAndData & "NW.bmp"
    ImageList1.Add cPathToMapsAndData & "W.bmp"
    ImageList1.Add cPathToMapsAndData & "SW.bmp"
    ImageList1.Add cPathToMapsAndData & "S.bmp"
    ImageList1.Add cPathToMapsAndData & "SE.bmp"
    ImageList1.Add cPathToMapsAndData & "compassBlank.bmp"
    
    MenuBar1.ImageList = ImageList1.hImageList
    
    Set btnGo = MenuBar1.Controls.AddButton("btnGo")
    btnGo.Image = 1
    btnGo.Style = mbrDefault
    bMoving = False
    Set btnCompass = MenuBar1.Controls.AddButton("btnCompass")
    btnCompass.Image = 11
    btnCompass.Style = mbrDefault
    ' Once the menus and buttons have been added to the MenuBar,
    ' you should release the objects
    Set btnSpacer = Nothing
    Set btnGo = Nothing
    Set btnCompass = Nothing

End Sub

Private Sub Form_OKClick()
    App.End
End Sub

Private Sub CreateMenus()
'//////////////////////////////////////////////////////////////////////////////
' SUB CreateMenus()
'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
' Creates the menus
'//////////////////////////////////////////////////////////////////////////////

Dim mnuMain As MenuBarLib.MenuBarMenu
Dim mnuFile As MenuBarLib.MenuBarMenu
Dim mnuZoom As MenuBarLib.MenuBarMenu

    Set mnuFile = MenuBar1.Controls.AddMenu("File", "mnuFile")
    Set mnuMain = MenuBar1.Controls.AddMenu("Display", "mnuMain")
    Set mnuZoom = MenuBar1.Controls.AddMenu("Zoom", "mnuZoom")

    mnuFile.Items.Add 1, cMnuInputFile, cMnuInputFileLabel
    mnuFile.Items.Add 2, cMenuAboutApplication, cMenuAboutApplicationLabel
    mnuFile.Items.Add 3, cMenuEnd, cMenuEndLabel
    'add this back in to read Live GPS
    'mnuFile.Items.Add 2, cMnuInputLive, cMnuInputLiveLabel

    mnuMain.Items.Add 1, cMnuDisplayPoint, cMnuDisplayPointLabel
    mnuMain.Items.Add 2, cMnuDisplayPoints, cMnuDisplayPointsLabel
    mnuMain.Items.Add 3, cMnuDisplayPointAndLine, cMnuDisplayPointAndLineLabel
    mnuMain.Items.Add 4, cMnuDisplayLine, cMnuDisplayLineLabel
    
    mnuMain.Items.Add 5, "Recenter", "--Recenter Map"
    mnuMain.Items(5).Style = mbrMenuSeparator
    mnuMain.Items.Add 6, cMnuRecenterAlways, cMnuRecenterAlwaysLabel
    mnuMain.Items.Add 7, cMnuRecenterByPoint, cMnuRecenterByPointLabel
    mnuMain.Items.Add 8, cMnuRecenterNever, cMnuRecenterNeverLabel
    
    mnuZoom.Items.Add 1, cMapZoom5mile, cMapZoom5mileLabel
    mnuZoom.Items.Add 2, cMapZoom1mile, cMapZoom1mileLabel
    mnuZoom.Items.Add 3, cMapZoom1_2mile, cMapZoom1_2mileLabel
    mnuZoom.Items.Add 4, cMapZoom1_4mile, cMapZoom1_4mileLabel
    mnuZoom.Items.Add 5, cMapZoom1_10mile, cMapZoom1_10mileLabel
    
mnuMain.Items(cMnuDisplayPoint).Checked = True 'check single point
mnuMain.Items(cMnuRecenterByPoint).Checked = True 'check never recenter
mnuZoom.Items(cMapZoom1_2mile).Checked = True 'check never recenter
   
 
    ' Once the menus and buttons have been added to the MenuBar,
    ' you should release the objects
    Set mnuMain = Nothing
    
End Sub


Private Sub MenuBar1_ButtonClick(ByVal Button As MenuBarLib.MenuBarButton)
'//////////////////////////////////////////////////////////////////////////////
' SUB MenuBar1_ButtonClick()
'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
' respond to the user clicking a menu button
' the only thing here, is the "Go/Pause" button
'//////////////////////////////////////////////////////////////////////////////

Dim btnGoStop As MenuBarButton
Set btnGoStop = MenuBar1.Controls.Item("btnGo")

If Button.Key = "btnGo" Then
    If bFileIsOpen Then
        If bMoving Then
            btnGoStop.Image = 1
            bMoving = False
            btnGoStop.ToolTip = "Start Drive"
            Timer1.Enabled = False
        Else
            btnGoStop.Image = 2
            bMoving = True
            btnGoStop.ToolTip = "Pause Drive"
            Timer1.Enabled = True
        End If
    End If
End If

Set btnGoStop = Nothing
End Sub

Private Sub menuBar1_MenuClick(ByVal Item As MenuBarLib.Item)
'//////////////////////////////////////////////////////////////////////////////
' SUB MenuBar1_MenuClick()
'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
' respond to the user choosing menu options.
'  these mostly deal with either getting or displaying the data
'//////////////////////////////////////////////////////////////////////////////

Dim mnuMain As MenuBarLib.MenuBarMenu
Set mnuMain = MenuBar1.Controls("mnuMain")
Dim mnuZoom As MenuBarLib.MenuBarMenu
Set mnuZoom = MenuBar1.Controls("mnuZoom")

Select Case Item.Key
    Case cMenuAboutApplication
        ShowAbout
    Case cMenuEnd
        'end the application
        App.End
    'If the user picked how to diplay (point, points, line, point and line)
    Case cMnuDisplayPoint, cMnuDisplayPoints, cMnuDisplayPointAndLine, cMnuDisplayLine
        ' uncheck everything
        mnuMain.Items(cMnuDisplayPoint).Checked = False
        mnuMain.Items(cMnuDisplayPoints).Checked = False
        mnuMain.Items(cMnuDisplayPointAndLine).Checked = False
        mnuMain.Items(cMnuDisplayLine).Checked = False
        'check the item the user just picked
        mnuMain.Items(Item.Key).Checked = True
        'set the info as to how to display vehicle
        VehicleInfo(cVehicleMarkerType) = Item.Key
        
   
        
     'If hte user picked how to recenter map
    Case cMnuRecenterAlways, cMnuRecenterByPoint, cMnuRecenterNever
        ' uncheck everything
        mnuMain.Items(cMnuRecenterAlways).Checked = False
        mnuMain.Items(cMnuRecenterByPoint).Checked = False
        mnuMain.Items(cMnuRecenterNever).Checked = False
        'check the item the user just picked
        mnuMain.Items(Item.Key).Checked = True
        'set the variable on how to recenter map
        sCenter = Item.Key

   
    Case cMnuInputFile
        'user chose to open new file
        Dim sFile As String
        'get the filename
        sFile = GetFileName()
        'if use DID pick a file, then continue
        If sFile <> "" Then
            'open the text file
            OpenTextFile File1, sFile, bFileIsOpen
            'read the first line of the text file
            GetFirstLine
            'reset the layers (clear the temp vehicle and line layers)
            InitializeLayers
            'tell the user that they can start
            MsgBox "When the map displays, click the start button to view GPS data", , "To Start"
        End If
        
'set the map zoom, update the checked item correctly on the menu
    Case cMapZoom5mile
        Map1.Zoom = 5
        mnuZoom.Items(cMapZoom5mile).Checked = True
        mnuZoom.Items(cMapZoom1mile).Checked = False
        mnuZoom.Items(cMapZoom1_2mile).Checked = False
        mnuZoom.Items(cMapZoom1_4mile).Checked = False
        mnuZoom.Items(cMapZoom1_10mile).Checked = False
    Case cMapZoom1mile
        Map1.Zoom = 1
        mnuZoom.Items(cMapZoom5mile).Checked = False
        mnuZoom.Items(cMapZoom1mile).Checked = True
        mnuZoom.Items(cMapZoom1_2mile).Checked = False
        mnuZoom.Items(cMapZoom1_4mile).Checked = False
        mnuZoom.Items(cMapZoom1_10mile).Checked = False
    Case cMapZoom1_2mile
        Map1.Zoom = 0.5
        mnuZoom.Items(cMapZoom5mile).Checked = False
        mnuZoom.Items(cMapZoom1mile).Checked = False
        mnuZoom.Items(cMapZoom1_2mile).Checked = True
        mnuZoom.Items(cMapZoom1_4mile).Checked = False
        mnuZoom.Items(cMapZoom1_10mile).Checked = False
    Case cMapZoom1_4mile
        Map1.Zoom = 0.25
        mnuZoom.Items(cMapZoom5mile).Checked = False
        mnuZoom.Items(cMapZoom1mile).Checked = False
        mnuZoom.Items(cMapZoom1_2mile).Checked = False
        mnuZoom.Items(cMapZoom1_4mile).Checked = True
        mnuZoom.Items(cMapZoom1_10mile).Checked = False
    Case cMapZoom1_10mile
        Map1.Zoom = 0.1
        mnuZoom.Items(cMapZoom5mile).Checked = False
        mnuZoom.Items(cMapZoom1mile).Checked = False
        mnuZoom.Items(cMapZoom1_2mile).Checked = False
        mnuZoom.Items(cMapZoom1_4mile).Checked = False
        mnuZoom.Items(cMapZoom1_10mile).Checked = True
    Case cMnuInputLive
        'read from GPS
    End Select



Set mnuMain = Nothing
Set mnuZoom = Nothing

End Sub
Sub GetFirstLine()
'//////////////////////////////////////////////////////////////////////////////
' SUB GetFirstLine()
'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
' read the first line from the text file.
' set the values for the start X,Y (basically, "prime the pump" so the draw line functions work
'//////////////////////////////////////////////////////////////////////////////

Dim strInputLine As String
Dim bRC As Boolean

strInputLine = File1.LineInputString
'If there is text
If Len(strInputLine) > 0 Then
    'get the X,Y and time from the NMEA string
    bRC = ParseNMEAMessage(strInputLine, VehicleInfo(cVehicleCurX), VehicleInfo(cVehicleCurY), VehicleInfo(cVehicleCurrentDate))
    'center the map on the vehicle's location
    Map1.ZoomTo Map1.Zoom, VehicleInfo(cVehicleCurX), VehicleInfo(cVehicleCurY)
End If


End Sub



Private Sub Timer1_Timer()
'//////////////////////////////////////////////////////////////////////////////
' Sub Timer1_Timer
'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
' This Sub gets called every XX (2 by default) seconds.  It will read the next line from
'the text file.  If the text file is done, it will tell the user, stop the trip and close the file
'If the input line is valid, it will call the processInput sub, which will interpret the GPS message
'and draw the point and/or line on the map
'//////////////////////////////////////////////////////////////////////////////

Dim bRC As Boolean
Dim sInputLine As String

'If we are at the end of the file
If File1.EOF Then
    'turn off the timer
    Timer1.Enabled = False
    'close the input file
    bRC = CloseTextFile(File1, bFileIsOpen)
    'set the variable
    bMoving = False
    'tell the user
    MsgBox "that was the entire trip", vbOKOnly, "Load Another..."

    'set the image to change from the pause button to a start button
    Dim btnGoStop As MenuBarButton
    Set btnGoStop = MenuBar1.Controls.Item("btnGo")
    btnGoStop.Image = 1
    btnGoStop.ToolTip = "Load another GPS file"
    
Else
    'read the next line
    sInputLine = File1.LineInputString
    'If there is text there, call the processInput function
    If Len(sInputLine) > 0 Then processInput (sInputLine)
End If


End Sub
Function GetFileName() As String
'//////////////////////////////////////////////////////////////////////////////
'  FUNCTION GetFileName
'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
' presents the user with the FileOpen common dialog
' it returns the name and path of the file that the user picked
'//////////////////////////////////////////////////////////////////////////////

Dim sFile As String

'set the properties
CommonDialog1.DialogTitle = "Open GPS Data File"
CommonDialog1.Filter = "Text Files (*.txt)|*.txt|GPS Files (*.gps)|*.gps"
CommonDialog1.ShowOpen
'get the name
sFile = CommonDialog1.FileName
'Tell the user that it was a bad idea to cancel!
If sFile = "" Then MsgBox "You shouldn't have cancelled!"
'return the name of the file
GetFileName = sFile
End Function