Attribute VB_Name = "modMapPointFunctions"
Option Explicit
'*************************************************************************
'  This source code is provided "as is" and as an unsupported sample of
'  a Microsoft Visual Basic application that incorporates the MapPoint 2002
'  object model and ActiveX control. It can only  be used in accordance with
'  the terms and conditions of the Microsoft MapPoint 2002 and
'  Microsoft Visual Basic End User License Agreements.
'*************************************************************************

Public Sub PaintShapes(oShapeOrShapes As Object, _
              Optional bSendToBack As Boolean = True)
'**********************************************************************************
    ' Author: SHP 2/22/2001
    ' Abstract: Given either a single shape or a collection of shapes, applies
    '           a fill color and (optionally) sets the shapes to display behind
    '           any other objects in the map (roads, etc.)
    ' Assumptions:
    ' Notes:
'**********************************************************************************
    
    Dim iColorIndex As Integer
    Dim omShape As MapPoint.Shape
    Dim iShapeCount As Integer
    
    If Not oShapeOrShapes Is Nothing Then
    
        iColorIndex = 1 ' used to select next forecolor...
        
        'This is a bit of overloading -- if we're passed a Shape object,
        'then we'll paint just that one.  If we're passed a collection
        'of shapes, then we'll loop through all of them.
        If TypeOf oShapeOrShapes Is MapPoint.Shape Then
        
            PaintThisShape oShapeOrShapes, iColorIndex
            
            If bSendToBack = True Then
                SendShapeToBack oShapeOrShapes
            End If
            
        ElseIf (TypeOf oShapeOrShapes Is Collection) Or (TypeOf oShapeOrShapes Is MapPoint.Shapes) Then
        
            For Each omShape In oShapeOrShapes
                PaintThisShape omShape, iColorIndex
                
                If bSendToBack = True Then
                    SendShapeToBack omShape
                End If
                
                If iColorIndex = 5 Then
                    iColorIndex = 1 'Reset to start over again in Fill.Forcolor options...
                Else
                    iColorIndex = iColorIndex + 1
                End If
                iShapeCount = iShapeCount + 1
                frmSpatialDataImport.lblRecordCount.Caption = "Shape Count: " & iShapeCount
            Next omShape
        End If
    End If
    
End Sub

Private Sub PaintThisShape(omShape As MapPoint.Shape, _
                           iColorIndex As Integer)
'**********************************************************************************
    ' Author: SHP 2/22/2001
    ' Abstract: Applies a fill color to a shape.
    ' Assumptions:
    ' Notes:
'**********************************************************************************
    
    If Not omShape Is Nothing Then
        With omShape
            Select Case iColorIndex
                Case 1
                    .Fill.ForeColor = &HC0FFC0
                Case 2
                    .Fill.ForeColor = &HC0C0FF
                Case 3
                    .Fill.ForeColor = &H80FFFF
                Case 4
                    .Fill.ForeColor = &HFFC0C0
                Case 5
                    .Fill.ForeColor = &HFF80FF
            End Select
            
            .Line.ForeColor = vbBlack
            .Line.Weight = 0
            .Fill.Visible = True
            .SizeVisible = False
        End With
    End If
    
End Sub

Public Sub SendShapeToBack(omShape As MapPoint.Shape)
'**********************************************************************************
    ' Author: SHP 2/22/2001
    ' Abstract: Sets the Z-Order of a shape such that it displays behind any roads
    '           or other objects.
    ' Assumptions:
    ' Notes:
'**********************************************************************************
    
    If Not omShape Is Nothing Then
        With omShape
            'Why do we have to do both?
            .ZOrder geoSendBehindRoads
            .ZOrder geoSendToBack
        End With
    End If
    
End Sub

Public Sub UpdateStatus(sStatusText As String)

    Dim sPreviousStatus As String
    
    If Not frmSpatialDataImport Is Nothing Then
        If Len(sStatusText) = 0 Then
            frmSpatialDataImport.lblStatus.Caption = sStatusText
        Else
            sPreviousStatus = frmSpatialDataImport.lblStatus.Caption
            If Len(sPreviousStatus) = 0 Then
                frmSpatialDataImport.lblStatus.Caption = sStatusText
            Else
                frmSpatialDataImport.lblStatus.Caption = sPreviousStatus & vbCrLf & sStatusText
            End If
        End If
        DoEvents
    End If
    
End Sub

' Compute latitude and longitude given a location object
' Author: Gilles Kohl
' (gilles@compuserve.com)
'
' This code is copyrighted freeware - use freely, but please leave this
' header intact. Suggestions and comments welcome.

Function Arccos(x As Double) As Double
   Arccos = Atn(-x / Sqr(-x * x + 1)) + 2 * Atn(1)
End Function

Sub CalcPos(objMap As MapPoint.Map, locX As MapPoint.Location, dblLat As Double, dblLon As Double)
Static locNorthPole As MapPoint.Location
Static locSouthPole As MapPoint.Location
Static locSantaCruz As MapPoint.Location ' Center of western hemisphere
Static dblHalfEarth As Double ' Half circumference of the earth (as a sphere)
Static dblQuarterEarth As Double ' Quarter circumference of the earth (as a sphere)
Static Pi As Double
Dim lat_rad As Double
Dim d_lat As Double
Dim dblNew As Double

    ' Check if initialization already done
    If locNorthPole Is Nothing Then
        Set locNorthPole = objMap.GetLocation(90, 0)
        Set locSouthPole = objMap.GetLocation(-90, 0)
        Set locSantaCruz = objMap.GetLocation(0, -90)
        
        ' Compute distance between north and south poles == half earth circumference
        dblHalfEarth = objMap.Distance(locNorthPole, locSouthPole)
        
        ' Quarter of that is the max distance a point may be away from locSantaCruz and still be in western hemisphere
        dblQuarterEarth = dblHalfEarth / 2
        Pi = 3.14159265358979
    End If

    ' Compute latitude from distance to north pole
    dblLat = 90 - 180 * objMap.Distance(locNorthPole, locX) / dblHalfEarth

    ' Compute great circle distance to locX from point on Greenwich meridian and computed Latitude
    d_lat = objMap.Distance(objMap.GetLocation(dblLat, 0), locX)

    ' convert latitude to radian
    lat_rad = (dblLat / 180) * Pi

    ' Compute Longitude from great circle distance
    ' KEY EQUATION
    dblLon = 180 * Arccos((Cos((d_lat * 2 * Pi) / (2 * dblHalfEarth)) - Sin(lat_rad) * Sin(lat_rad)) / (Cos(lat_rad) * Cos(lat_rad))) / Pi

    ' Correct longitude sign if located in western hemisphere
    If objMap.Distance(locSantaCruz, locX) < dblQuarterEarth Then dblLon = -dblLon
    
    Set locNorthPole = Nothing
    Set locSouthPole = Nothing
    Set locSantaCruz = Nothing

End Sub