Sub GetCloseItems(l as location, range As Float) As Map
Dim multi As Float = 1.1
Dim p1 As Location = calculateDerivedPosition(l,Main.range*multi,0)
Dim p2 As Location = calculateDerivedPosition(l,Main.range*multi,90)
Dim p3 As Location = calculateDerivedPosition(l,Main.range*multi,180)
Dim p4 As Location = calculateDerivedPosition(l,Main.range*multi,270)
Dim strSql As String = printf(" Latitude > %f and Latitude < %f and Longitude < %f and Longitude > %f",Array As Object(p3.Latitude,p1.Latitude,p2.Longitude,p4.Longitude))
'etc
End Sub
Sub toRadians(d As Double) As Double
Return (d*cPI)/180
End Sub
Sub toDegrees(R As Double) As Double
Return (R*180)/cPI
End Sub
Sub calculateDerivedPosition(loc As Location, range As Double, bearing As Double) As Location
Dim EarthRadius As Int = 6371000
Dim latA As Double = toRadians(loc.Latitude)
Dim lonA As Double = toRadians(loc.Longitude)
Dim angularDistance As Double = range / EarthRadius
Dim trueCourse As Double = toRadians(bearing)
Dim lat As Double= ASin(Sin(latA) * Cos(angularDistance) + Cos(latA) * Sin(angularDistance) * Cos(trueCourse))
Dim dlon As Double = ATan2(Sin(trueCourse) * Sin(angularDistance) * Cos(latA), Cos(angularDistance) - Sin(latA) * Sin(lat))
Dim lon As Double = ((lonA + dlon + cPI) Mod (cPI * 2)) - cPI
lat = toDegrees(lat)
lon = toDegrees(lon)
Dim newloc As Location
newloc.Initialize
newloc.Latitude=lat
newloc.Longitude=lon
Return newloc
End Sub
Sub pointIsInCircle(pointForCheck As Location, center As Location,radius As Double)
If (getDistanceBetweenTwoPoints(pointForCheck, center) <= radius) Then
Return True
Else
Return False
End If
End Sub
Sub getDistanceBetweenTwoPoints(p1 As Location, p2 As Location) As Double
Dim R As Double = 6371000
Dim dLat As Double = toRadians(p2.Latitude - p1.Latitude)
Dim dLon As Double = toRadians(p2.Longitude - p1.Longitude)
Dim lat1 As Double = toRadians(p1.Latitude)
Dim lat2 As Double = toRadians(p2.Latitude)
Dim a As Double = Sin(dLat / 2) * Sin(dLat / 2) + Sin(dLon / 2) * Sin(dLon / 2) * Cos(lat1) * Cos(lat2)
Dim c As Double = 2 * ATan2(Sqrt(a), Sqrt(1 - a))
Dim d As Double = R * c
Return d
End Sub