Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
End Sub
'四邊形點撞擊判斷 切忌只適用在北半球，東半部
Public Function RectangleCollision(ByVal P1 As LongitudeLatitudeType, ByVal P2 As LongitudeLatitudeType, ByVal P3 As LongitudeLatitudeType, ByVal P4 As LongitudeLatitudeType, ByVal Point As LongitudeLatitudeType) As Boolean
Dim LT, LB, RT, RB As New LongitudeLatitudeType 'L:Left, R:Right, T:Top, B:Bottom
Dim temp(3), swap As LongitudeLatitudeType
Dim i, j As Short
Dim m, result As Double '求斜率及點帶入的結果
temp(0) = P1
temp(1) = P2
temp(2) = P3
temp(3) = P4
'先用泡沫排序法，將緯度由高到低排序
For i = 0 To 3
For j = i + 1 To 3
If CDbl(temp(i).Latitude) < CDbl(temp(j).Latitude) Then
swap = temp(i)
temp(i) = temp(j)
temp(j) = swap
End If
Next
Next
'比對最上面的經度
If CDbl(temp(0).Longitude) < CDbl(temp(1).Longitude) Then
LT = temp(0)
RT = temp(1)
Else
LT = temp(1)
RT = temp(0)
End If
'比對最下面的經度
If CDbl(temp(2).Longitude) < CDbl(temp(3).Longitude) Then
LB = temp(2)
RB = temp(3)
Else
LB = temp(3)
RB = temp(2)
End If
'比對象限
'求是否在LT→RT的下方
LineFunction(CDbl(LT.Longitude), CDbl(LT.Latitude), CDbl(RT.Longitude), CDbl(RT.Latitude), CDbl(Point.Longitude), CDbl(Point.Latitude), m, result)
If result < 0 Then
Return False
End If
'求是否在LB→RB的上方
LineFunction(CDbl(LB.Longitude), CDbl(LB.Latitude), CDbl(RB.Longitude), CDbl(RB.Latitude), CDbl(Point.Longitude), CDbl(Point.Latitude), m, result)
If result > 0 Then
Return False
End If
'求是否在RT→RB的左方
If (RT.Longitude = RB.Longitude And Point.Longitude > RT.Longitude) Then '判斷當直線時，判斷左右邊
Return False
End If
LineFunction(CDbl(RT.Longitude), CDbl(RT.Latitude), CDbl(RB.Longitude), CDbl(RB.Latitude), CDbl(Point.Longitude), CDbl(Point.Latitude), m, result)
If (result * m) > 0 Then
Return False
End If
'求是否在LT→LB的右方
If (LT.Longitude = LB.Longitude And Point.Longitude < LT.Longitude) Then '判斷當直線時，判斷左右邊
Return False
End If
LineFunction(CDbl(LT.Longitude), CDbl(LT.Latitude), CDbl(LB.Longitude), CDbl(LB.Latitude), CDbl(Point.Longitude), CDbl(Point.Latitude), m, result)
If (result * m) < 0 Then
Return False
End If
Return True
End Function
Public Sub LineFunction(ByVal x1 As Double, ByVal y1 As Double, ByVal x2 As Double, ByVal y2 As Double, ByVal Point_X As Double, ByVal Point_Y As Double, ByRef Slope As Double, ByRef Result As Double)
Slope = (y1 - y2) / (x1 - x2) '斜率
Result = (Slope * Point_X) - (Slope * x1) + y1 - Point_Y '直線方程式，將點帶入
'若Result < 0 則表示點在直線上方，Slope > 0 在左邊，Slope < 0 在右邊
'若Result > 0 則表示點在直線下方，Slope > 0 在右邊，Slope < 0 在左邊
'切忌，點至點的方向會影響左右邊判斷
End Sub
'用於測試是否撞擊
Private Sub Button3_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button3.Click
Dim p1, p2, p3, p4, pd As New LongitudeLatitudeType
p1.Latitude = "6011.520"
p1.N_S_Indicator = "N"
p1.Longitude = "13958.080"
p1.E_W_Indicator = "E"
p2.Latitude = "5954.240"
p2.N_S_Indicator = "N"
p2.Longitude = "13001.920"
p2.E_W_Indicator = "E"
p3.Latitude = "4958.080"
p3.N_S_Indicator = "N"
p3.Longitude = "13958.080"
p3.E_W_Indicator = "E"
p4.Latitude = "4949.440"
p4.N_S_Indicator = "N"
p4.Longitude = "13001.920"
p4.E_W_Indicator = "E"
'在區域內的點
'pd.Latitude = "5517.760"
'pd.N_S_Indicator = "N"
'pd.Longitude = "13521.600"
'pd.E_W_Indicator = "E"
'不在區域內的點
pd.Latitude = "5945.600"
pd.N_S_Indicator = "N"
pd.Longitude = "12232.640"
pd.E_W_Indicator = "E"
If RectangleCollision(p1, p2, p3, p4, pd) Then '用於判斷是否撞擊
'只有當isReceive = false纔會進入傳送動作，該區域的動作只會執行一次
MsgBox("已經撞擊")
Else
MsgBox("未撞擊")
End If
End Sub
End Class