MapForums

    Imports System.Math

    Private Function CalculateArea(ByVal ID As String) As String

        Dim con As New System.Data.SqlClient.SqlConnection(ConnString)
        con.Open()
        Dim cmd As New System.Data.SqlClient.SqlCommand
        Dim da As New System.Data.SqlClient.SqlDataAdapter
        Dim ds As New DataSet
        Dim dr As DataRow
        Dim MyItem As ListViewItem
        Dim xCoord() As Double
        Dim yCoord() As Double
        Dim n As Integer
        Dim x, y, dist As Double

        cmd = con.CreateCommand
        cmd.CommandText = "SELECT * FROM Shapes WHERE ID = '" & ID & "' ORDER BY point"
        cmd.CommandType = CommandType.Text
        da.SelectCommand = cmd
        da.Fill(ds, "Coords")

        ReDim xCoord(ds.Tables("Coords").Rows.Count)
        ReDim yCoord(ds.Tables("Coords").Rows.Count)

        For n = 0 To UBound(xCoord)
            If n = UBound(xCoord) Then
                xCoord(n) = xCoord(0)
            Else
                xCoord(n) = ds.Tables("Coords").Rows(n).Item("Lat")
            End If

            If n = UBound(yCoord) Then
                yCoord(n) = yCoord(0)
            Else
                yCoord(n) = ds.Tables("Coords").Rows(n).Item("Lon")
            End If

        Next

        For n = 0 To UBound(xCoord)
            x += xCoord(n)
        Next

        x = x / (UBound(xCoord) + 1)

        dist = DistanceFrom(x, x, 0, 1)

        For n = 0 To UBound(xCoord)
            xCoord(n) = xCoord(n) * 69.11
        Next

        For n = 0 To UBound(yCoord)
            yCoord(n) = yCoord(n) * dist
        Next
        CalculateArea = Format(AreaByCoordinates(xCoord, yCoord), "#00.000 sqMiles")

    End Function
    Function AreaByCoordinates(ByVal Xcoord() As Double, ByVal Ycoord() As Double) As Double
        Dim I As Long
        Dim Xold As Double
        Dim Yold As Double
        Dim Yorig As Double
        Dim ArrayUpBound As Long
        Dim x, y As Double

        ArrayUpBound = UBound(Xcoord)
        Xold = Xcoord(ArrayUpBound)
        Yorig = Ycoord(ArrayUpBound)
        Yold = 0.0#

        For I = LBound(Xcoord) To ArrayUpBound
            x = Xcoord(I)
            y = Ycoord(I) - Yorig
            AreaByCoordinates = AreaByCoordinates + (Xold - x) * (Yold + y)
            Xold = x
            Yold = y
        Next

        AreaByCoordinates = Abs(AreaByCoordinates) / 2
    End Function
    Function DistanceFrom(ByVal lat1 As Double, ByVal lat2 As Double, ByVal lon1 As Double, ByVal lon2 As Double) As Double
        Dim theta, dist As Double
        theta = lon1 - lon2
        dist = Sin(deg2rad(lat1)) * Sin(deg2rad(lat2)) + Cos(deg2rad(lat1)) * Cos(deg2rad(lat2)) * Cos(deg2rad(theta))
        dist = Acos(dist)
        dist = rad2deg(dist)
        DistanceFrom = dist * 60 * 1.1515

    End Function
    Function deg2rad(ByVal deg As Double) As Double
        deg2rad = CDbl(deg * PI / 180)
    End Function
    Function rad2deg(ByVal rad As Double) As Double
        rad2deg = CDbl(rad * 180 / PI)
    End Function