frmtrakker.ebf

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

VERSION 5.00
Object = "{25C953A7-5464-11D1-A714-00AA0044064C}#1.0#0"; "MSCEFILE.DLL"
Object = "{F7DEA2C9-BA8F-446E-A292-B4840F3BD661}#1.0#0"; "mscemenubar.dll"
Object = "{E491F001-98EC-11D1-9B3D-00C04FAD5AEC}#1.0#0"; "msceimagelist.dll"
Object = "{A32A88B3-817C-11D1-A762-00AA0044064C}#1.0#0"; "mscecomdlg.dll"
Object = "{57B04826-35E8-4F1E-9F23-46443667723F}#5.0#0"; "mapx50.dll"
Begin VB.Form frmTrakker 
   Appearance      =   0  'Flat
   BackColor       =   &H80000005&
   Caption         =   "GPS Tracker"
   ClientHeight    =   4545
   ClientLeft      =   60
   ClientTop       =   840
   ClientWidth     =   3585
   ForeColor       =   &H80000008&
   ScaleHeight     =   4545
   ScaleWidth      =   3585
   ShowOK          =   -1  'True
   Begin MapXLib.Map Map1 
      Height          =   4215
      Left            =   0
      TabIndex        =   0
      Top             =   0
      Width           =   3615
      _Version        =   500010
      _ExtentX        =   6376
      _ExtentY        =   7435
      _StockProps     =   1
      MapCatalog.GeoDictionary=   "Empty GeoDictKeyName {01A9504B-CE13-4415-A5A0-51D8C2F15204}"
      GeoSet          =   "Empty GeosetName {9A9AC2F4-8375-44d1-BCEB-476AE986F190}"
      GeoSetUserName  =   "United States"
      DefaultStyle.TextFontBackColor=   16777215
      DefaultStyle.SupportsBitmapSymbols=   -1  'True
      DefaultStyle.SymbolChar=   55
      DefaultStyle.SymbolFontBackColor=   16777215
      BeginProperty DefaultStyle.TextFont {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "Arial"
         Size            =   9.75
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      BeginProperty DefaultStyle.SymbolFont {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "Map Symbols"
         Size            =   14.25
         Charset         =   2
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      DefaultStyle.LineStyle=   1
      DefaultStyle.LineWidth=   1
      DefaultStyle.RegionColor=   16777215
      DefaultStyle.LinePattern=   2
      DefaultStyle.RegionBackColor=   16777215
      DefaultStyle.RegionBorderStyle=   1
      DefaultStyle.RegionBorderWidth=   1
      Title.Visible   =   0   'False
      Title.Text      =   "Empty Title {01A9504B-CE13-4415-A5A0-51D8C2F15204}"
      Title.Style.TextFontBackColor=   16777215
      Title.Style.TextFontOpaque=   -1  'True
      Title.Style.SymbolChar=   0
      BeginProperty Title.Style.TextFont {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "Arial"
         Size            =   11.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      BeginProperty Title.Style.SymbolFont {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "Arial"
         Size            =   11.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Title.X         =   3201
      Title.Y         =   -741
      Map.NumericCoordSys.ProjectionInfo=   "frmTrakker.frx":0000
      Map.DisplayCoordSys.ProjectionInfo=   "frmTrakker.frx":0130
   End
   Begin CEComDlgCtl.CommonDialog CommonDialog1 
      Left            =   2040
      Top             =   1680
      _cx             =   847
      _cy             =   847
      CancelError     =   0   'False
      Color           =   0
      DefaultExt      =   ""
      DialogTitle     =   ""
      FileName        =   ""
      Filter          =   ""
      FilterIndex     =   0
      Flags           =   0
      HelpCommand     =   0
      HelpContext     =   ""
      HelpFile        =   ""
      InitDir         =   ""
      MaxFileSize     =   256
      FontBold        =   0   'False
      FontItalic      =   0   'False
      FontName        =   ""
      FontSize        =   10
      FontUnderline   =   0   'False
      Max             =   0
      Min             =   0
      FontStrikethru  =   0   'False
   End
   Begin CEImageListCtl.ImageList ImageList1 
      Left            =   1200
      Top             =   2880
      _cx             =   990
      _cy             =   990
      ImageWidth      =   0
      ImageHeight     =   0
   End
   Begin MenuBarLib.MenuBar MenuBar1 
      Left            =   0
      Top             =   3720
      _cx             =   1508
      _cy             =   1085
      Enabled         =   -1  'True
      NewButton       =   -1  'True
   End
   Begin FILECTLCtl.File File1 
      Left            =   1560
      Top             =   3840
      _cx             =   1000
      _cy             =   1000
   End
   Begin VBCE.Timer Timer1 
      Left            =   3000
      Top             =   3840
      _cx             =   847
      _cy             =   847
      Enabled         =   0   'False
      Interval        =   4000
   End
End
Attribute VB_Name = "frmTrakker"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
    
Dim sCenter As String
Dim sDisplayStyle As String
Dim bMoving As Boolean
Dim bFileIsOpen As Boolean
Dim VehicleInfo(10)



Sub processInput(strInputLine As String)
'//////////////////////////////////////////////////////////////////////////////
' Sub processInput
'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
' this accepts a  GPS NMEA message, which is in the format
' $GPRMC,222344,A, 3854.621,N, 7703.701,W,0.0,,191101,0.0,E,*79
'//////////////////////////////////////////////////////////////////////////////

On Error Resume Next

Dim dblX As Double
Dim dblY As Double
Dim bRC As Boolean
Dim iImageNum As Integer
Dim fVehicle As MapXLib.Feature
Dim fVehiclePrev As MapXLib.Feature

'the parseNMEA message function will pull the lat, long and time out of a NMEA message.  If you want/need more or less inforamtion from the NMEA message for your application, modify this function accordingly
bRC = ParseNMEAMessage(strInputLine, dblX, dblY, VehicleInfo(cVehicleCurrentDate))

'set the "previous" vehicle location to what is now the current
VehicleInfo(cVehiclePrevX) = VehicleInfo(cVehicleCurX)
VehicleInfo(cVehiclePrevY) = VehicleInfo(cVehicleCurY)
' update the "current" vehicle location
VehicleInfo(cVehicleCurX) = dblX
VehicleInfo(cVehicleCurY) = dblY
'get the angle of direction
VehicleInfo(cVehicleDirectionAngle) = ComputeAngle(VehicleInfo(cVehiclePrevX), VehicleInfo(cVehiclePrevY), dblX, dblY)
'get the text value (East, West, etc) from a given angle
GetDirectionsFromAngle VehicleInfo(cVehicleDirectionAngle), VehicleInfo(cVehicleDirection)


'If we are drawing a point ( or point and line) we need to update the location of the point
If VehicleInfo(cVehicleMarkerType) = cMnuDisplayPoint Or VehicleInfo(cVehicleMarkerType) = cMnuDisplayPointAndLine Then
 'get a pointer to the vehicle (it will always be the first feature on this layer)
 Set fVehicle = Map1.Layers(cMapTempLayerPoints).AllFeatures(1)
 'update it's location
 fVehicle.Point.Set VehicleInfo(cVehicleCurX), VehicleInfo(cVehicleCurY)
 'if you do not update this, the changes will not take effect
 fVehicle.Update
End If

'If we are suppossed to be drawing "point trails"
If VehicleInfo(cVehicleMarkerType) = cMnuDisplayPoints Then
 'make a copy of the current vehicle
 Set fVehiclePrev = Map1.Layers(cMapTempLayerPoints).AddFeature(Map1.Layers(cMapTempLayerPoints).AllFeatures(1))
 'set the color of the previous location to light gray
 fVehiclePrev.Style.SymbolFontColor = miColorLightGray
 ''NOTE : you can do creative things here with the color, such as determine the distance between the
 ''   current and previous points (map1.distance x1,y1,x2,y2) and check your time and change the color
 ''   based on speed.  if you have altitude information, you can have the color a different shade
 ''   depending on the altitude. be creative.  This sample was written as a simple teaching tool to
 ''   show you how to display GPS data.  It is not showing off all of the functionality and ability of the MapXMobile control
 
 'update
 fVehiclePrev.Update
 
 'get a pointer to the vehicle (it will always be the first feature on this layer)
 Set fVehicle = Map1.Layers(cMapTempLayerPoints).AllFeatures(1)
  'update it's location
 fVehicle.Point.Set VehicleInfo(cVehicleCurX), VehicleInfo(cVehicleCurY)
  'commmit it
 fVehicle.Update
End If


'if we need to draw a line (if the choice is "points and line" the point was already taken care of)
If VehicleInfo(cVehicleMarkerType) = cMnuDisplayPointAndLine Or VehicleInfo(cVehicleMarkerType) = cMnuDisplayLine Then
 Dim pts As MapXLib.Points
 'create a points collection (this will describe the endpoints of the line)
 Set pts = CreateObject(cPOINTSobject)
 'add the starting point (previous location)
 pts.AddXY VehicleInfo(cVehiclePrevX), VehicleInfo(cVehiclePrevY)
 'add the ending point (current location)
 pts.AddXY VehicleInfo(cVehicleCurX), VehicleInfo(cVehicleCurY)
 'add the line based on the points collection
 Map1.Layers(cMapTempLayerLines).AddFeature Map1.FeatureFactory.CreateLine(pts)
End If


'should we recenter map?
Select Case sCenter
    Case cMnuRecenterAlways
        Map1.ZoomTo Map1.Zoom, VehicleInfo(cVehicleCurX), VehicleInfo(cVehicleCurY)
    Case cMnuRecenterNever
        'do nothing
    Case cMnuRecenterByPoint
        If Not (Map1.IsPointVisible(VehicleInfo(cVehicleCurX), VehicleInfo(cVehicleCurY))) Then
            Map1.ZoomTo Map1.Zoom, VehicleInfo(cVehicleCurX), VehicleInfo(cVehicleCurY)
        End If
End Select


'get the correct image for the compass arrow
Select Case UCase(VehicleInfo(cVehicleDirection))
    Case "EAST"
        iImageNum = 3
    Case "NORTHEAST"
        iImageNum = 4
    Case "NORTH"
        iImageNum = 5
    Case "NORTHWEST"
        iImageNum = 6
    Case "WEST"
        iImageNum = 7
    Case "SOUTHWEST"
        iImageNum = 8
    Case "SOUTH"
        iImageNum = 9
    Case "SOUTHEAST"
        iImageNum = 10
    Case Else
        iImageNum = 11
End Select

Dim btnCompass As MenuBarButton
'get a reference to the button
Set btnCompass = MenuBar1.Controls.Item("btnCompass")
'set the proper image
btnCompass.Image = iImageNum
Set btnCompass = Nothing

End Sub



Private Sub Form_Load()

Call CreateMenuBarButtons
Call CreateMenus

'set the geoset
Map1.GeoSet = cPathToMapsAndData & "GPSApp.gst"

'set the zoom
Map1.Zoom = 0.5

'Set  Re-Center mode to only recenter when neccessary
sCenter = cMnuRecenterByPoint

'set Draw mode
VehicleInfo(cVehicleMarkerType) = cMnuDisplayPoint

'set the inerval seconds
Timer1.Interval = ciTimerInterval

'set two globals
bFileIsOpen = False
bMoving = False

'tell the user how to start application
MsgBox "go to the File menu to open the GPS file to track", , "To open a GPS file"

End Sub
Sub InitializeLayers()
'//////////////////////////////////////////////////////////////////////////////
' SUB InitializeLayers()
'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
' Adds the right layers to the map
' creates the layers that will hold the lines and points for the display
'//////////////////////////////////////////////////////////////////////////////


Dim ptVehiclePoint As MapXLib.Point
Dim ftrVehicle As MapXLib.Feature


On Error Resume Next
'remove any temp layers
Map1.Layers.Remove cMapTempLayerPoints
Map1.Layers.Remove cMapTempLayerLines
On Error GoTo 0

'turn off the autoredraw
Map1.AutoRedraw = False

'call a function to create a temporary layer for the lines to be drawn to
CreateTempLayer Map1, cMapTempLayerLines

'set the style for the lines that may be drawn to this layer
Map1.Layers(cMapTempLayerLines).OverrideStyle = True
Map1.Layers(cMapTempLayerLines).Style.LineColor = miColorRed
Map1.Layers(cMapTempLayerLines).Style.LineWidth = 3

    
'call a function to create a temporary layer for the vehicle to be drawn to
CreateTempLayer Map1, cMapTempLayerPoints
    
'set the point layer as an animation layer for smoother redrawing
Set Map1.Layers.AnimationLayer = Map1.Layers(cMapTempLayerPoints)