判断点px是否在多边形内的VB源代码

'判断点px是否在多边形内;
'即可适用于凹多边形的判断，也适用于凸多边形的判断
'所选射线px(x0 y0)--pxy(x0+2*max|x0-xi| y0+min|y0-yi|) [i=1,2 3,.......,n]不与多边形任何一点相交
'入口参数多边形：(n, ptx(), pty(), px , py)
'返回值False (在多边形外)、True(在多边形上及在多边形内)
Public Function dzdbxn(n As Long, ptx() As Double, pty() As Double, px As Double, py As Double) As Boolean
Dim j As Long
Dim d1 As Double
Dim d2 As Double
Dim d3 As Double

dzdbxn = False

For i = 1 To n
j = i + 1: If i = n Then j = 1
d1 = Abs(ptx(i) * pty(j) + ptx(j) * py + px * pty(i) - ptx(i) * py - ptx(j) * pty(i) - px * pty(j))
d2 = Pold(ptx(i), pty(i), ptx(j), pty(j))
d3 = Abs(d2 - Pold(ptx(i), pty(i), px, py) - Pold(ptx(j), pty(j), px, py))
d1 = d1 / d2
Print "i=" + Str(i) + " j=" + Str(j) + " d1=" + Str(d1) + " d3=" + Str(d3)
'注意：d1 d3判断值1前的0个数=多边形区域坐标值中小数位数-1
If d1 < 0.0001 And d3 < 0.0001 Then dzdbxn = True: Exit Function
Next i

If dzdbxn = False Then
Dim dx As Double
Dim xmax As Double
Dim dy As Double
Dim ymin As Double

For i = 1 To n
dx = Abs(ptx(i) - px): dy = Abs(pty(i) - py)
If i = 1 Then
xmax = dx: ymin = dy
Else
If dx > xmax Then xmax = dx
If dy < ymin Then ymin = dy
End If
Next i

Dim sum As Long

sum = 0: xmax = 2# * xmax
For i = 1 To n
j = i + 1: If i = n Then j = 1
d1 = ymin * (ptx(j) - ptx(i)) - xmax * (pty(j) - pty(i))
d2 = xmax * (pty(i) - py) - ymin * (ptx(i) - px)
d3 = (ptx(j) - ptx(i)) * (pty(i) - py) - (pty(j) - pty(i)) * (ptx(i) - px)
If (d2 * (d1 - d2)) >= 0# And d3 * d1 >= 0# Then sum = sum + 1
Next i
Print "sum=" + Str(sum) + " px=" + Str(px) + " py=" + Str(py)
If sum > 0 And sum <> 2 * Int(sum / 2) Then
dzdbxn = True
Else
dzdbxn = False
End If
End If
End Function
Function Pold(x1 As Double, y1 As Double, x2 As Double, y2 As Double) As Double
'两点间距离计算
Pold = Sqr((x2 - x1) * (x2 - x1) + (y2 - y1) * (y2 - y1))
End Function