With many thanks to Gilles Kohl [MVP]
Option Explicit
Dim oMpApp As MapPoint.Application
Dim WithEvents oMap As MapPoint.Map
Private Sub Form_Load()
' Try to attach to running instance of MapPoint
On Error Resume Next
Set oMpApp = GetObject(, "MapPoint.Application")
On Error GoTo 0
If oMpApp Is Nothing Then
' Attaching failed - try creating an object
On Error Resume Next
Set oMpApp = CreateObject("MapPoint.Application")
On Error GoTo 0
If oMpApp Is Nothing Then
MsgBox "Could not create MapPoint object"
End
End If
' make the app visible
oMpApp.Visible = True
End If
' Ensure MapPoint survives when app terminates
oMpApp.UserControl = True
' Retrieve the active map
Set oMap = oMpApp.ActiveMap
End Sub
Private Sub oMap_MouseMove(ByVal Button As Long, ByVal Shift As Long,
ByVal X As Long, ByVal Y As Long)
If Not oMap.ActiveRoute.IsCalculated Then Exit Sub
Dim oLoc As MapPoint.Location
Set oLoc = oMap.XYToLocation(X, Y)
' For GPS use, change into Set oLoc = oMap.GetLocation(dblLat,
dblLon, 0)
Dim dblDist As Double
dblDist = oMap.ActiveRoute.Directions.DistanceTo(oLoc)
Text1.Text = Str(dblDist)
If dblDist < 0.05 Then
Text1.BackColor = vbGreen
Else
Text1.BackColor = vbRed
End If
End Sub



LinkBack URL
About LinkBacks
Reply With Quote
Bookmarks