VB代码判断点在多边形内.docVIP

代码如下： Dim n As Long Dim x() As Double Dim y() As Double Dim px As Double Dim py As Double Private Sub Command1_Click() Command3.Enabled = False Call dzdbxn(n, x(), y(), px, py) End Sub 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 = 0 To n - 1 j = i + 1: If i = n - 1 Then j = 0 d1 = Abs(ptx(i) * pty(j) + ptx(j) * py + px * pty(i) - ptx(i) * py - ptx(j) * pty(i) - px * pty(j)) Command2 Command3 Command1 Command4 Picture1 Label6 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 Picture1.Print i= + Str(i) + j= + Str(j) + d1= + Str(d1) + d3= + Str(d3) 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 = 0 To n - 1 dx = Abs(ptx(i) - px): dy = Abs(pty(i) - py) If i = 0 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 = 0 To n - 1 j = i + 1: If i = n - 1 Then j = 0 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 Picture1.Print sum= + Str(sum) + px= + Str(px) + py= + Str(py) If sum 0 And sum 2 * Int(sum / 2) Then dzdbxn = True Label6.Caption = 点在多边形内 Else