1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:
188:
189:
190:
191:
192:
193:
194:
195:
196:
197:
198:
199:
200:
201:
202:
203:
204:
205:
206:
207:
208:
209:
210:
211:
212:
213:
214:
215:
216:
217:
218:
219:
220:
221:
222:
223:
224:
225:
226:
227:
228:
229:
230:
231:
232:
233:
234:
235:
236:
237:
238:
239:
240:
241:
242:
243:
244:
245:
246:
247:
248:
249:
250:
251:
252:
253:
254:
255:
256:
257:
258:
259:
260:
261:
262:
263:
264:
265:
266:
267:
268:
269:
270:
271:
272:
273:
274:
275:
276:
277:
278:
279:
280:
281:
282:
283:
284:
285:
286:
287:
288:
289:
290:
|
Public Class Form1
Private Polygons As New List(Of List(Of Point))
Private KSpoints As List(Of Point) = Nothing
Private Sub PictureBox1_MouseUp(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles PictureBox1.MouseUp
If IsNothing(KSpoints) Then
KSpoints = New List(Of Point)
Polygons.Add(KSpoints)
End If
KSpoints.Add(e.Location)
If KSpoints.Count = 4 Then
Dim ptE, ptF As Point
Dim Simple As Boolean = True
If Geometry.SegmentIntersect(KSpoints(0), KSpoints(3), KSpoints(1), KSpoints(2), ptE, ptF) = Geometry.SegmentIntersection.Point Then
' check for intersection between lines formed by 0 to 3 and 1 to 2.
For Each pt As Point In KSpoints
If Not pt.Equals(ptE) Then
Simple = False
Exit For
End If
Next
If Not Simple Then
' swap the last two points
Dim pt As Point = KSpoints(3)
KSpoints.RemoveAt(3)
KSpoints.Insert(2, pt)
End If
KSpoints = Nothing
PictureBox1.Refresh()
Exit Sub
End If
If Geometry.SegmentIntersect(KSpoints(0), KSpoints(1), KSpoints(2), KSpoints(3), ptE, ptF) = Geometry.SegmentIntersection.Point Then
' check for intersection between lines formed by 0 to 1 and 2 to 3.
For Each pt As Point In KSpoints
If Not pt.Equals(ptE) Then
Simple = False
Exit For
End If
Next
If Not Simple Then
' swap the two middle points
Dim pt As Point = KSpoints(2)
KSpoints.RemoveAt(2)
KSpoints.Insert(1, pt)
KSpoints = Nothing
PictureBox1.Refresh()
Exit Sub
End If
End If
KSpoints = Nothing
PictureBox1.Refresh()
Else
PictureBox1.Refresh()
End If
End Sub
Private Sub PictureBox1_Paint(ByVal sender As Object, ByVal e As System.Windows.Forms.PaintEventArgs) Handles PictureBox1.Paint
Static colors() As Color = {Color.Red, Color.Green, Color.Blue, Color.Purple}
For Each polygon As List(Of Point) In Polygons
If polygon.Count > 1 Then
For i As Integer = 0 To polygon.Count - 2
Using P As New Pen(colors(i))
e.Graphics.DrawLine(P, polygon(i), polygon(i + 1))
End Using
Next
If polygon.Count > 2 Then
Using P As New Pen(colors(polygon.Count - 1))
e.Graphics.DrawLine(P, polygon(polygon.Count - 1), polygon(0))
End Using
End If
End If
For Each pt As Point In polygon
Dim rc As New Rectangle(pt, New Size(1, 1))
rc.Inflate(3, 3)
e.Graphics.FillRectangle(Brushes.Black, rc)
Next
Next
End Sub
End Class
Public Class Geometry
Public Enum SegmentIntersection
None = 0 ' The segments are parallel and will never intersect
Point = 1 ' The segments physically intersect in one point
ExtrapolatedPoint = 2 ' The segments would physically intersect in one point if one or both segments were extended
Overlapping = 3 ' The segments are parallel and overlap in a point or segment
End Enum
Public Shared Function SegmentIntersect( _
ByVal A As Point, ByVal B As Point, _
ByVal C As Point, ByVal D As Point, _
ByRef E As Point, ByRef F As Point) As SegmentIntersection
' If one or both of the segments passed in is actually a point then just do a PointToSegmentDistance() calculation:
If A.Equals(B) OrElse C.Equals(D) Then
If A.Equals(B) AndAlso C.Equals(D) Then
If A.Equals(C) Then
E = A
F = A
Return Geometry.SegmentIntersection.Point
Else
Return Geometry.SegmentIntersection.None
End If
ElseIf A.Equals(B) Then
If Geometry.PointToSegmentDistance(A.X, A.Y, C.X, C.Y, D.X, D.Y) = 0 Then
E = A
F = A
Return Geometry.SegmentIntersection.Point
End If
ElseIf C.Equals(D) Then
If Geometry.PointToSegmentDistance(C.X, C.Y, A.X, A.Y, B.X, B.Y) = 0 Then
E = C
F = C
Return Geometry.SegmentIntersection.Point
End If
End If
Return Geometry.SegmentIntersection.None
End If
' We have two actual segments...let's do the calculations for Det1 and Det2:
Dim Det1 As Double = (A.Y - C.Y) * (D.X - C.X) - (A.X - C.X) * (D.Y - C.Y)
Dim Det2 As Double = (B.X - A.X) * (D.Y - C.Y) - (B.Y - A.Y) * (D.X - C.X)
If Det2 <> 0 Then ' Non-Parallel Segments (they intersect or would intersect if extended)
Dim Det3 As Double = (A.Y - C.Y) * (B.X - A.X) - (A.X - C.X) * (B.Y - A.Y)
Dim Det4 As Double = (B.X - A.X) * (D.Y - C.Y) - (B.Y - A.Y) * (D.X - C.X)
Dim r As Double = Det1 / Det2
Dim s As Double = Det3 / Det4
' Compute the intersection point:
E.X = A.X + r * (B.X - A.X)
E.Y = A.Y + r * (B.Y - A.Y)
F = E
If (r >= 0 AndAlso r <= 1) AndAlso (s >= 0 AndAlso s <= 1) Then
' They physically intersect
Return Geometry.SegmentIntersection.Point
Else
' They would physically intersect if one or both segments were extended
Return Geometry.SegmentIntersection.ExtrapolatedPoint
End If
Else ' Parallel Segments
If Det1 <> 0 Then ' Non-Overlapping
Return Geometry.SegmentIntersection.None
Else ' Overlapping (one point or a segment)
' The parallel segments are the same
If (A.Equals(C) AndAlso B.Equals(D)) OrElse (A.Equals(D) AndAlso B.Equals(C)) Then
E = A
F = B
Return Geometry.SegmentIntersection.Overlapping
End If
' The parallel segments overlap in exactly one point
If B.Equals(C) OrElse B.Equals(D) Then
E = B
F = B
Return Geometry.SegmentIntersection.Overlapping
End If
If A.Equals(C) OrElse A.Equals(D) Then
E = A
F = A
Return Geometry.SegmentIntersection.Overlapping
End If
' The parallel segments are overlapping in a segment
If Geometry.SegmentContainsPoint(A, B, C) AndAlso Geometry.SegmentContainsPoint(C, D, B) Then
E = C
F = B
Return Geometry.SegmentIntersection.Overlapping
ElseIf Geometry.SegmentContainsPoint(A, B, D) AndAlso Geometry.SegmentContainsPoint(D, C, B) Then
E = D
F = B
Return Geometry.SegmentIntersection.Overlapping
ElseIf Geometry.SegmentContainsPoint(B, A, C) AndAlso Geometry.SegmentContainsPoint(C, D, A) Then
E = C
F = A
Return Geometry.SegmentIntersection.Overlapping
ElseIf Geometry.SegmentContainsPoint(B, A, D) AndAlso Geometry.SegmentContainsPoint(D, C, A) Then
E = D
F = A
Return Geometry.SegmentIntersection.Overlapping
ElseIf Geometry.SegmentContainsPoint(C, D, A) AndAlso Geometry.SegmentContainsPoint(A, B, D) Then
E = A
F = D
Return Geometry.SegmentIntersection.Overlapping
ElseIf Geometry.SegmentContainsPoint(C, D, B) AndAlso Geometry.SegmentContainsPoint(B, A, D) Then
E = B
F = D
Return Geometry.SegmentIntersection.Overlapping
ElseIf Geometry.SegmentContainsPoint(D, C, A) AndAlso Geometry.SegmentContainsPoint(A, B, C) Then
E = A
F = C
Return Geometry.SegmentIntersection.Overlapping
ElseIf Geometry.SegmentContainsPoint(D, C, B) AndAlso Geometry.SegmentContainsPoint(B, A, C) Then
E = B
F = C
Return Geometry.SegmentIntersection.Overlapping
End If
' One segment completely contains the other
If Geometry.SegmentContainsPoint(A, B, C) AndAlso Geometry.SegmentContainsPoint(A, B, D) Then
E = C
F = D
Return Geometry.SegmentIntersection.Overlapping
End If
If Geometry.SegmentContainsPoint(C, D, A) AndAlso Geometry.SegmentContainsPoint(C, D, B) Then
E = A
F = B
Return Geometry.SegmentIntersection.Overlapping
End If
' Segments are parallel but not touching
Return Geometry.SegmentIntersection.None
End If
End If
End Function
Public Shared Function PointToPointDistance(ByVal Ax As Single, _
ByVal Ay As Single, ByVal Bx As Single, ByVal By As Single) _
As Single
' PointToPointDist = SquareRoot((Bx - Ax)^2 + (By - Ay)^2)
Return Math.Sqrt((Bx - Ax) * (Bx - Ax) + (By - Ay) * (By - Ay))
End Function
Public Shared Function PointToSegmentDistance( _
ByVal Px As Single, ByVal Py As Single, _
ByVal Ax As Single, ByVal Ay As Single, _
ByVal Bx As Single, ByVal By As Single) As Single
Dim q As Single
If (Ax = Bx) And (Ay = By) Then
' A and B passed in define a point, not a line.
' Point to Point Distance
Return PointToPointDistance(Px, Py, Ax, Ay)
Else
' Distance is the length of the line needed to connect the point to
' the(segment)such that the two lines would be perpendicular.
' q is the parameterized value needed to get to the intersection
q = ((Px - Ax) * (Bx - Ax) + (Py - Ay) * (By - Ay)) / _
((Bx - Ax) * (Bx - Ax) + (By - Ay) * (By - Ay))
' Limit q to 0 <= q <= 1
' If q is outside this range then the Point is somewhere past the
' endpoints of our segment. By setting q = 0 or q = 1 we are
' measuring the actual distacne from the point to one of the
' endpoints(instead)
If q < 0 Then q = 0
If q > 1 Then q = 1
' Distance
Return PointToPointDistance( _
Px, Py, (1 - q) * Ax + q * Bx, (1 - q) * Ay + q * By)
End If
End Function
Public Shared Function SegmentContainsPoint( _
ByVal A As Point, ByVal B As Point, ByVal C As Point) As Boolean
' Two Segments AB and CD have already been determined to have the
' same slope and that they overlap.
' AB is the segment, and C is the point in question.
' If AB contains C then return true, otherwise return false
If C.Equals(A) Or C.Equals(B) Then
Return True
ElseIf A.X = B.X Then ' Project to the Y-Axis for vertical lines
Dim minY As Integer = Math.Min(A.Y, B.Y)
Dim maxY As Integer = Math.Max(A.Y, B.Y)
If minY <= C.Y AndAlso C.Y <= maxY Then
Return True
Else
Return False
End If
Else ' Project to the X-Axis for anything else
Dim minX As Integer = Math.Min(A.X, B.X)
Dim maxX As Integer = Math.Max(A.X, B.X)
If minX <= C.X AndAlso C.X <= maxX Then
Return True
Else
Return False
End If
End If
End Function
End Class
|
