Point in a Polygon, This'll get your brain going !!

At the moment I have the code below to determine if the mouse pointer is within a certain rectangular region, I'm trying to come up with fast (it has to go in the mouse move event) boolean function to determine if a point lies within a polygon as defined by an arbitrary array of points, your imput would be very welcome

Code:

---


Public Type myRectangle
    TLX As Integer      'Top Left X
    TLY As Integer      'Top Left Y
    BRX As Integer      'Bottom Right X
    BRY As Integer      'Bottom Right Y
   
End Type

Public Function MouseInRect(MouseX As Integer, MouseY As Integer, Rect As myRectangle) As Boolean

    If MouseX >= Rect.TLX And MouseY >= Rect.TLY And MouseX <= Rect.BRX And MouseY <= Rect.BRY Then
        MouseInRect = True
    Else
        MouseInRect = False
    End If

End Function

---

hm, in normal case you only collide points with convex polygons, meaning of triangles. There is however a way to check any kind of polygon, or you can split it up. I dont have the function to check this in mind, prolly answer later again...

Paul,

Is this for your map designer thing? Because I struggled with the same problem when trying to highlight particular 'cells'.

There must by a way though, if your grid is drawn regularly. I attempted to locate the 'root' point in the grid and then redraw the polygon from there.

An alternative method would be to define a coordinate system in terms of polygons - i.e. x polygons along, by y polygons down gives polygon x. However, that still leaves the problem of determining which polygon you're in.

Do you have a grid of vertices? If so, can you write a function to located the nearest n vertices from the grid (n being defined by the polygon shape)? To check if its 'right' shouldn't x1,y1 be the same as xn, yn (i.e. you have a closed polygon).

There must also be a maths function that can plot n-side polygonal vertices from a fixed origin. But I couldn't work that out either.

There you go, no help whatsoever eh? ;)

There is a geometric algorithm out there that handles this issue, I have it but dont have my algorithms book with me.

I used it with a c++ project and it worked quite nicely.

If I remember right it figured it out by counting the times lines of the polygron were crossed, if it was an odd number then you know the point click is inside the polygon, even number, the click was outside the polygon.

Code:

---

_
/ \
|.|  So this would have one times of crossing the line
\_/

 _
/ \
| | .  This would have even.
\_/

---

I will try to remember to look it up at home.

Hi Dan!

Yeah, I'm still playing with that thing, I've got a lot of different ideas for using it for map editors, games etc (like an online game of 40K, if you know it).

Anyway, There is a generic unit object which has a bitmap icon and is blitted to the map, then moved by redrawing the map out of memory (which is nice and fast), re-writing the grid then placing the units in their new positions. but I want a mouse over for discriptions of units, they are rectangles which is fine, but I want mouse over terrain descriptions too which are not rectangular.

The other option is a quadtree algorithm (sort of like a MAX_PER_NODE spacial quadtrees)

I'm thinking of keeping a type array of object positions so I can do a quick search, and maybe quadtrees would be a good way of not having to check irrelevant object positons in relation to the mouse.

still, anyone have any code for point in a polygon, I suppose it would be just clever work on triangles

I saw your hex select code, I was wondering if you put that on mouse-over and wanted the hex to become "unhighlighted" after the mouse had moved on would you just remember the old hex then re-colour it grey (from black?)


[Edited by Paul282 on 07-17-2000 at 09:26 AM]

Bill,

Is that like a raster count? I can see how you counted it in you description but not programmatically, it sounds like you're checking a lot of points, is it fast enough for a mouse-over event with multiple polygons?

interesting idea though, I'll see if it's in my algorithm book

Paul

Quote:

---

Originally posted by billrogers
There is a geometric algorithm out there that handles this issue, I have it but dont have my algorithms book with me.

I used it with a c++ project and it worked quite nicely.

If I remember right it figured it out by counting the times lines of the polygron were crossed, if it was an odd number then you know the point click is inside the polygon, even number, the click was outside the polygon.

Code:

---

_
/ \
|.|  So this would have one times of crossing the line
\_/

 _
/ \
| | .  This would have even.
\_/

---

I will try to remember to look it up at home.

---

I get it Bill!!
check the x pos of the point for crosses then the Y, you'd need to know the the values of the polygon at a specific axis though, but that'd be faster than breaking up to trinagles... I'll see if I can come up with some code

As in Warhammer 40K? Yeah I know it.

With my hex select code, I just located the nearest 6 vertices in my grid store (checking every six, as my grid is made up of overlapping hexs - stores more points than necessary but makes that bit easier!). So I have the six vertices of the hex and could theoretically highlight and then 'unhighlight'. But you'd have to keep 'getting' the nearest six vertices and checking if they have changed.

Well, Other than a generic map editor I want to play 40k with some friends in Oz (which I haven't done in years) so most of it will be manual (like a real table-top game) and a unit will be dragable by mouse to the limit of it's movement value then droped and the board updated. Combat manual and dice rolls visible to players. The winsock stuff is not too hard but graphics is not really my field (yet)

I'm not that serious about the game part yet, I want the dynamics of the map working first then I'll decide which way I want to go.

The fellow with the excess bold is correct.

I once had to do this VERY THING for a Doom->Hexen conversion program I wrote in C once. To convert teleporters, I needed to find out which sector the teleporter device was in. The algorithm I used was one I learned while studying the topology of mazes:

If you have a very curvy and confusing surface and you wish to determine whether or not a point lies within that surface, you draw a line (not necessarily straight, but it makes things easier!) from that point to a point outside of the surface. If it crosses an even number of times, it's outside the surface. If it crosses an odd number of times, it's inside the surface. If you ever have trouble keeping this straight (even out/odd in), draw a circle and a draw a line from the center of the circle to somewhere outside of it. It crosses one line, one is odd, the center of the circle is inside the circle.

Anyway, so you have to determine a point that you KNOW is outside of the surface. The method I used was to find the bounding rectangle for the sector/surface/polygon (the smallest rectangle that fully encloses it), and to pick a point that I was certain to be outside of that rectangle. Then test every edge of the polygon to see if it intersects the line between your test point and the point outside the polygon. If an odd number of intersections occur, it's inside. Otherwise it's outside.

Yes I see what you're saying.

It really sounds like something that you impliment only if there is no other way around (like just using rectangles) or if critical for the functionality.

hmmm, I'll think about it some more.

Thanks for your input

Paul

Paul, hope i don't came too late for this, you could use some api, create a polygon Region and use ptinregion to chech if to point is in it ;)

I was wondering when you were going to show up!

problem is that these polygons are already on screen. They are just arbitrary areas that I have decided mean something. Because of this I can decide how to hold the points (an array or udt or object) but I haven't asked windows to created it.

So effectively on mouse move I want to check the coords of the mouse against the list of object co-ords to see if it's over one of them, I have it working with rectangles but before I go on I want a plan for how to check polygons. That way I'll know how to best store the object data to be checked.

I'm thinking or having a screen descriptor (UDT array) and have most functions call info to and from it...

hmmmmmm

I've been away for a while, yeah and i just got here today(my modem broke down)

Code:

---

Private Declare Function CreatePolygonRgn Lib "gdi32" (lpPoint As Long, ByVal nCount As Long, ByVal nPolyFillMode As Long) As Long
Declare Function PtInRegion Lib "gdi32" Alias "PtInRegion" (ByVal hRgn As Long, ByVal x As Long, ByVal y As Long) As Long

Dim Points() As POINTAPI

Dim YourRgn As Long

...

Redim Points(10)
points(0).x=4
points(0).y=5
...

YourRgn = CreatePolygonRgn(ByVal VarPtr(Points(0).x), (UBound(Points) + 1), 1)

If PtInRegion(YourRgn,x,y) then ...

---

HAven't tested anything but you get the idea right? You create a polygon region by an array of pointapi's

hi paul!

kedaman's method is ok, if you are not expecting more then
around 1000 polygon regions to be checked. if it is more you will run into some weird system limitations.

i once wrote a gis-like application, that used to draw (and hopefully still does) 12000 (partialy overlapping) polygons onto a map and ran into serious performance problems with HitTest functionality. i ended up in creating an array of every pixel of the display area and storing the IDs for all polygons for that pixel during my paint method.

best regards

Sascha

Here's something I've just been playing with.

it is VERY fast on the mousemove but uses a lot of memory!

it works ok for small form though!

basically the form is described as a 2 dimensional array of bytes. I did use boolean but booleans are 2 bytes each!

Code:

---

Option Explicit
Private Type myRectangle
    TLX As Integer      'Top Left X
    TLY As Integer      'Top Left Y
    BRX As Integer      'Bottom Right X
    BRY As Integer      'Bottom Right Y
End Type

'15480x11220
Dim myDisplay(4800, 3600) As Byte

Private Sub drawRect(rec As myRectangle)
Dim i As Long
Dim j As Long
Me.Line (rec.TLX, rec.TLY)-(rec.BRX, rec.BRY), , B


For i = rec.TLX To rec.BRX
  For j = rec.TLY To rec.BRY
    myDisplay(i, j) = True
  Next j
Next i
 
End Sub

Private Sub Form_Load()
Dim rec As myRectangle

Me.Width = UBound(myDisplay, 1)
Me.Height = UBound(myDisplay, 2)

rec.BRX = 500
rec.BRY = 500
rec.TLX = 100
rec.TLY = 100
drawRect rec

rec.BRX = 1000
rec.BRY = 900
rec.TLX = 400
rec.TLY = 400
drawRect rec
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)

If myDisplay(X, Y) Then MsgBox "Inside the shape"

End Sub

---

Looks interesting thanks guys!

Mark, I think yours would take up less memory if you worked in pixels, it looks like you're playing with twips which would leave a lot of unused array sections, I was thinking about an array of UDT, you could look up the x and y with a binary search algorithm and take almost no time to find what object you're in.

I'll need to do a bit more study on Kedaman's idea though, looks good but I've never used that sort of code before.

still, I'm not planning on working with anything animated so I should be ok.

Paul

Paul, it's probably faster to use my idea because it uses the APi regions which is as everyone who have played around with regions, knows. But it's also memory and resouce consuming. Unless youre having a large amount of regions you could use it. The pointapi is the UDT you're talking about.

Paul282,

I was intrigued by the discussion and with a couple of hours to kill I decided to put my mind to the task. Well, a day later (ummm did I mention I forgot most of my trig), I have a solution which seems fast to me. It is totally VB with no API and it is fast enough to catch me moving into the polygon and out again as long as the shape is at least 20 pixels wide or so. If it is smaller, then I have to move the mouse slightly slower, otherwise I can moe as fast as I like.

The test bed I wrote is not fantastic, but if you are looking for ideas, you are welcome to it. I think it is too much to post here though (25k in text format).

I have no algorithims book that has been referred to however I imagine that the solution I implement is covered in such a book and no doubt done much better than I did it. It amounts to an offshoot of the previously discussed idea of tracing a line through the shape only it's optimised for polygons (straight sides).

Also, I do not know how reliable it is for a polygon that intersects with itself (sounds painful) but I don't think you were trying to do that anyhow.

Let me know if you're interested.

Cheers
Paul Lewis

Paul,

I would like very much to look at it. I'm currently using objects of 32x32 pixels so I shouldn't have any problems, anything you can post for everyone to see?

Paul

But it's bigger than what I think would normally be appropriate to post.

Here goes. Bear in mind this is one long listing of the form, module and two user classes. YOu will have to cut it and save it as the appropriate names. They are: Form1, Module1, pclPolygon and pclPoint.

No apologies for lazy naming :) Also ther eis some redundant code in there that was part of the learning experience of the module. It was a good project to get the brain going that's for sure :)

Cheers
Paul Lewis

Code:

---

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "pclPolygon"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"
Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
Option Explicit
Public Enum pclPolyState
  PolygonStarted = 1
  PolygonComplete = 2
End Enum
Public Enum pclPointPosition
  InsidePolygon = 1
  OutsidePolygon = 0
  OnEdge = 2
End Enum
Private mvarPoints() As pclPoint
Private mvarMaxPointCount As Integer
Private mvarPointCount As Integer
Private mvarState As pclPolyState
Private mvarPictureBox As PictureBox
Private mvarMostLeft As pclPoint
Private mvarMostTop As pclPoint
Private mvarMostBottom As pclPoint
Private mvarMostRight As pclPoint
'local variable(s) to hold property value(s)
Private mvarDrawDebugLines As Boolean 'local copy
'local variable(s) to hold property value(s)
Private mvarDebugMode As Boolean 'local copy
Public Property Let DebugMode(ByVal vData As Boolean)
'used when assigning a value to the property, on the left side of an assignment.
'Syntax: X.DebugMode = 5
    mvarDebugMode = vData
End Property


Public Property Get DebugMode() As Boolean
'used when retrieving value of a property, on the right side of an assignment.
'Syntax: Debug.Print X.DebugMode
    DebugMode = mvarDebugMode
End Property



Public Property Let DrawDebugLines(ByVal vData As Boolean)
'used when assigning a value to the property, on the left side of an assignment.
'Syntax: X.DrawDebugLines = 5
    mvarDrawDebugLines = vData
End Property


Public Property Get DrawDebugLines() As Boolean
'used when retrieving value of a property, on the right side of an assignment.
'Syntax: Debug.Print X.DrawDebugLines
    DrawDebugLines = mvarDrawDebugLines
End Property




Public Property Set PictureBox(ByVal vData As PictureBox)
    Set mvarPictureBox = vData
End Property
Public Property Get PictureBox() As PictureBox
    Set PictureBox = mvarPictureBox
End Property
Public Property Get State() As pclPolyState
    Set State = mvarState
End Property
Public Property Get PointCount() As Integer
    PointCount = mvarPointCount
End Property

Public Function AddPoint(ByVal point As pclPoint) As Boolean
  ' adds a point to the polygon and draws a line from the previous point
  ' if a picturebox has been specified
  If mvarState <> PolygonStarted Then
    Err.Raise 1, "pclPolygon.Complete", "Cannot add a point to a polygon that hasn't been started"
    Exit Function
  End If
 
  mvarPointCount = mvarPointCount + 1
  If mvarPointCount > mvarMaxPointCount Then SetMaxPointCount (mvarMaxPointCount + 5)
  Set mvarPoints(mvarPointCount) = point
  If mvarPointCount = 1 Then
    Set mvarMostLeft = point
    Set mvarMostTop = point
    Set mvarMostBottom = point
    Set mvarMostRight = point
  Else
    If point.X < mvarMostLeft.X Then Set mvarMostLeft = point
    If point.X > mvarMostRight.X Then Set mvarMostRight = point
    If point.Y < mvarMostTop.Y Then Set mvarMostTop = point
    If point.Y > mvarMostBottom.Y Then Set mvarMostBottom = point
  End If
  DrawToPreviousPoint

End Function
Public Sub DrawToPreviousPoint()
  If Not mvarPictureBox Is Nothing Then
    If mvarPointCount > 1 Then
      mvarPoints(mvarPointCount).DrawTo mvarPoints(mvarPointCount - 1), mvarPictureBox
    End If
  End If
End Sub
Public Sub DrawFromToPoint(ByVal fromPoint As pclPoint, ByVal toPoint As pclPoint, color As Long)
  If Not mvarPictureBox Is Nothing Then
    fromPoint.DrawTo toPoint, mvarPictureBox, color
  End If
End Sub
Public Sub DrawToFirstPoint()
  If Not mvarPictureBox Is Nothing Then
    If mvarPointCount > 1 Then
      mvarPoints(mvarPointCount).DrawTo mvarPoints(1), mvarPictureBox
    End If
  End If
End Sub
Public Sub Start(Optional numPoints As Integer)
  If numPoints > 0 Then
    If numPoints > mvarMaxPointCount Then SetMaxPointCount (numPoints)
  End If
  mvarState = pclPolyState.PolygonStarted
End Sub
Public Sub Complete()
  If mvarState <> pclPolyState.PolygonStarted Then
    Err.Raise 1, "pclPolygon.Complete", "Cannot complete a polygon that hasn't started"
    Exit Sub
  End If
 
  mvarState = pclPolyState.PolygonComplete
  DrawToFirstPoint
End Sub

Private Sub SetMaxPointCount(numPoints As Integer)
  mvarMaxPointCount = numPoints
  ReDim Preserve mvarPoints(1 To mvarMaxPointCount)
 
End Sub

Public Function FindFarthestPoint(toPoint As pclPoint) As pclPoint
  ' finds and returns the farthest point to the given point
  Dim c As Integer
  Dim myPoint As pclPoint
 
  Dim myLen, maxLen As Single
  maxLen = mvarPoints(1).DistanceTo(toPoint)
  Set myPoint = mvarPoints(1)
  For c = 2 To mvarPointCount
    myLen = mvarPoints(c).DistanceTo(toPoint)
    If myLen > maxLen Then
      maxLen = myLen
      Set myPoint = mvarPoints(c)
    End If
  Next
  Set FindFarthestPoint = myPoint
End Function
Public Function FindNearestPoint(toPoint As pclPoint) As pclPoint
  Set FindNearestPoint = mvarPoints(FindNearestPointId(toPoint))

End Function

Private Function FindNearestPointId(toPoint As pclPoint) As Integer
  ' finds and returns the nearest point to the given point
  Dim c, id As Integer
  Dim myPoint As pclPoint
 
  Dim myLen, maxLen As Single
  id = 1
  maxLen = mvarPoints(id).DistanceTo(toPoint)
  For c = 2 To mvarPointCount
    myLen = mvarPoints(c).DistanceTo(toPoint)
    If myLen < maxLen Then
      maxLen = myLen
      id = c
    End If
  Next
  FindNearestPointId = id
End Function
Private Function GetState() As String
  Select Case mvarState
  Case Is = pclPolyState.PolygonComplete
    GetState = "Complete"
  Case Is = pclPolyState.PolygonStarted
    GetState = "Started"
  Case Else
    GetState = "Unknown"
  End Select
End Function
Public Sub PrintPoints()
  Dim c As Integer
  Debug.Print mvarPointCount & " points: " & GetState()
  For c = 1 To mvarPointCount
    Debug.Print "(" & mvarPoints(c).X & ", " & mvarPoints(c).Y & ")"
  Next c
  Debug.Print mvarPointCount & ", ";
  For c = 1 To mvarPointCount
    Debug.Print mvarPoints(c).X & ", " & mvarPoints(c).Y;
    If c < mvarPointCount Then Debug.Print ", ";
  Next c
 
End Sub
Public Sub LoadFromDisk(fileName As String)
  Dim f, c As Integer
  f = FreeFile
  Open fileName For Input As f
  Dim myPoint As pclPoint
  Dim X, Y As Long
 
  Input #f, mvarMaxPointCount
  Init (mvarMaxPointCount)
  Start
  For c = 1 To mvarMaxPointCount
    Set myPoint = New pclPoint
    Input #f, X, Y
    myPoint.X = X
    myPoint.Y = Y
    AddPoint myPoint
  Next c
  Close #f
  Complete
End Sub
Private Sub Init(numPoints As Integer)
  mvarMaxPointCount = numPoints
  ReDim mvarPoints(1 To mvarMaxPointCount)
  mvarPointCount = 0
End Sub
Public Sub SaveToDisk(fileName As String)
  Dim f As Integer
  f = FreeFile
  Open fileName For Output As f
  Dim c As Integer
  Print #f, mvarPointCount
  For c = 1 To mvarPointCount
    Print #f, mvarPoints(c).X & ", " & mvarPoints(c).Y
  Next c
  Close #f
End Sub

Public Function Traverse(fromPoint As pclPoint) As Integer
  ' first find out where the closest point is
  Dim nearestId, c, id, res As Integer
  nearestId = FindNearestPointId(fromPoint)
  Dim thisPoint, lastPoint As pclPoint
  Dim dist As Single
  Dim grad As Variant
  Dim gradTo, gradFrom As Single
  Dim pLeft, pRight, pAbove, pBelow As Integer
  Dim direction, myDirection, vDirection, hDirection, cut As Integer
  Dim total As Integer
  c = 0
  id = nearestId
  Set thisPoint = mvarPoints(id)
  If mvarDebugMode Then Debug.Print "cut", "direction", "pLeft", "pRight", "pAbove", "pBelow"
 
  While c < mvarPointCount
    ' start moving around the shape
    id = id + 1
    If id > mvarPointCount Then id = 1
    Set lastPoint = thisPoint
    Set thisPoint = mvarPoints(id)
    dist = lastPoint.DistanceTo(thisPoint)
    cut = fromPoint.CutBy(lastPoint, thisPoint)
    On Error Resume Next
      grad = lastPoint.GradientTo(thisPoint)
      'gradTo = lastPoint.GradientTo(fromPoint)
      'gradFrom = fromPoint.GradientTo(thisPoint)
      If Err <> 0 Then
        'gradiant is undefined
        grad = "undefined"
     
      End If
    On Error GoTo 0
   
    If mvarDrawDebugLines Then DrawFromToPoint lastPoint, thisPoint, vbRed
    'If mvarDrawDebugLines Then DrawFromToPoint fromPoint, thisPoint
    myDirection = lastPoint.DirectionTo(thisPoint)

    If cut And (pclPointCutAxis.cutX0 Or pclPointCutAxis.cutY0) Then
      'on the line
      Traverse = pclPointPosition.OnEdge
      Exit Function
    End If
   
    If (myDirection And pclPointDirection.isBelow) > 0 Then
      vDirection = -1
    Else
      vDirection = 1
    End If
   
    If (myDirection And pclPointDirection.isToLeft) > 0 Then
      hDirection = -1
    Else
      hDirection = 1
    End If
   
 
    If cut And pclPointCutAxis.cutXpos Then pLeft = pLeft + vDirection
    If cut And pclPointCutAxis.cutXneg Then pRight = pRight + vDirection
    If cut And pclPointCutAxis.cutYneg Then pBelow = pBelow + hDirection
    If cut And pclPointCutAxis.cutYpos Then pAbove = pAbove + hDirection
   
   
    If mvarDebugMode Then Debug.Print cut, myDirection; " "; vDirection; " "; hDirection, pLeft, pRight, pAbove, pBelow
    If mvarDebugMode And mvarDrawDebugLines Then MsgBox "waiting"
    c = c + 1
  Wend
 
  If pLeft <> 0 And pBelow <> 0 And Abs(pLeft) = Abs(pRight) And Abs(pBelow) = Abs(pAbove) Then
'  If Abs(pLeft) = 1 And Abs(pRight) = 1 And Abs(pBelow) = 1 And Abs(pAbove) = 1 Then
    Traverse = pclPointPosition.InsidePolygon
  Else
    Traverse = pclPointPosition.OutsidePolygon
  End If
End Function

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "pclPoint"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"
Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
Option Explicit
Public Enum pclPointDirection
  isAbove = 1
  isToLeft = 2
  isToRight = 4
  isBelow = 8
  isAt = 0
End Enum
Public Enum pclPointCutAxis
  cutXpos = 1
  cutYpos = 2
  cutXneg = 4
  cutYneg = 8
  cutX0 = 16
  cutY0 = 32
  notCut = 0
End Enum

'local variable(s) to hold property value(s)
Private mvarX As Long 'local copy
Private mvarY As Long 'local copy
Public Sub DrawTo(point As pclPoint, vObject As PictureBox, Optional color As Long = 0)
  vObject.Line (mvarX, mvarY)-(point.X, point.Y), color
  'Debug.Print "drawn (" & mvarX & ", " & mvarY & ")-(" & point.X & ", " & point.Y & ")"
End Sub
Public Function IsBetweenX(ByVal fromPoint As pclPoint, ByVal toPoint As pclPoint) As Boolean
  If ((fromPoint.X <= mvarX) And (mvarX < toPoint.X)) _
    Or ((fromPoint.X > mvarX) And (mvarX >= toPoint.X)) Then
      IsBetweenX = True
  End If
End Function
Public Function IsBetweenY(ByVal fromPoint As pclPoint, ByVal toPoint As pclPoint) As Boolean
  If ((fromPoint.Y <= mvarY) And (mvarY < toPoint.Y)) _
    Or ((fromPoint.Y > mvarY) And (mvarY >= toPoint.Y)) Then
      IsBetweenY = True
  End If
End Function
Public Function CutBy(ByVal fromPoint As pclPoint, ByVal toPoint As pclPoint) As Integer
  ' tests if a line cuts the x or y axes of a given point
  Dim grad As Variant
  Dim res As Integer
  On Error Resume Next
    grad = fromPoint.GradientTo(toPoint)
    If Err <> 0 Then
      'gradiant is undefined
      grad = "undefined"
    End If
  On Error GoTo 0
  res = 0
 
  Select Case grad
  Case Is = "undefined"
    If IsBetweenY(fromPoint, toPoint) Then
      ' definitely cut somewhere
      Select Case fromPoint.X - mvarX
        Case Is < 0
          res = res Or pclPointCutAxis.cutXneg
        Case Is > 0
          res = res Or pclPointCutAxis.cutXpos
        Case Is = 0
          res = res Or pclPointCutAxis.cutX0
      End Select
    End If

  Case Is = 0
    If IsBetweenX(fromPoint, toPoint) Then
      ' definitely cut somewhere
      Select Case fromPoint.Y - mvarY
        Case Is < 0
          res = res Or pclPointCutAxis.cutYneg
        Case Is > 0
          res = res Or pclPointCutAxis.cutYpos
        Case Is = 0
          res = res Or pclPointCutAxis.cutY0
      End Select
    End If
 
  Case Else
    ' line is not vertical or horizontal
    Dim c, myX, myY As Single
    c = fromPoint.Y - grad * fromPoint.X
   
    ' crosses x? so y=mvarY
    myX = (mvarY - c) / grad
   
    ' crosses y? so x=mvarX
    myY = grad * mvarX + c
   
    If IsBetweenY(fromPoint, toPoint) Then
      ' definitely cut X somewhere
      Select Case myX - mvarX
        Case Is < 0
          res = res Or pclPointCutAxis.cutXneg
        Case Is > 0
          res = res Or pclPointCutAxis.cutXpos
        Case Is = 0
          res = res Or pclPointCutAxis.cutX0
      End Select
    End If
   
    If IsBetweenX(fromPoint, toPoint) Then
      ' definitely cut Y somewhere
      Select Case myY - mvarY
        Case Is < 0
          res = res Or pclPointCutAxis.cutYneg
        Case Is > 0
          res = res Or pclPointCutAxis.cutYpos
        Case Is = 0
          res = res Or pclPointCutAxis.cutY0
      End Select
    End If
   
   
 
  End Select
 
  CutBy = res
 
End Function


Public Function DistanceTo(ByVal point As pclPoint) As Single
  Dim xDist, yDist As Long
  Dim dist As Single
 
  xDist = mvarX - point.X
  yDist = mvarY - point.Y
 
  dist = Sqr(xDist * xDist + yDist * yDist)
  DistanceTo = CSng(dist)
End Function
Public Function DirectionTo(ByVal point As pclPoint) As Integer
  Dim xDist, yDist As Long
  Dim res As Integer
 
  xDist = point.X - mvarX
  yDist = point.Y - mvarY
 
  If xDist > 0 Then
    res = res Or pclPointDirection.isToRight
  ElseIf xDist < 0 Then
    res = res Or pclPointDirection.isToLeft
  End If
 
  If yDist > 0 Then
    res = res Or pclPointDirection.isBelow
  ElseIf yDist < 0 Then
    res = res Or pclPointDirection.isAbove
  End If
 
  DirectionTo = res
End Function

Public Function GradientTo(ByVal point As pclPoint) As Single
  Dim xDiff, yDiff As Long
  Dim grad As Single
 
  xDiff = point.X - mvarX
  yDiff = point.Y - mvarY
 
  On Error Resume Next
'  If xDiff <> 0 Then
    grad = yDiff / xDiff
  If Err <> 0 Then Err.Raise Err.Number, Err.Source, Err.Description, Err.HelpFile, Err.HelpContext
'  Else
'    grad = 0
'  End If
  GradientTo = CSng(grad)
End Function

Public Property Let Y(ByVal vData As Long)
'used when assigning a value to the property, on the left side of an assignment.
'Syntax: X.Y = 5
    mvarY = vData
End Property


Public Property Get Y() As Long
'used when retrieving value of a property, on the right side of an assignment.
'Syntax: Debug.Print X.Y
    Y = mvarY
End Property



Public Property Let X(ByVal vData As Long)
'used when assigning a value to the property, on the left side of an assignment.
'Syntax: X.X = 5
    mvarX = vData
End Property


Public Property Get X() As Long
'used when retrieving value of a property, on the right side of an assignment.
'Syntax: Debug.Print X.X
    X = mvarX
End Property



Attribute VB_Name = "Module1"
Option Explicit

Public Type RECT
        Left As Long
        Top As Long
        Right As Long
        Bottom As Long
End Type

Public myPolygon As New pclPolygon


Public Function CreatePolygon(sides As Integer, minLen As Single, approx As Integer, bounds As PictureBox) As pclPolygon
  ' creates a pseudo random polygon of sides
  If sides < 3 Then Exit Function
 
  Const pi = 3.14159265358979
 
  Dim myBounds As RECT
  myBounds.Left = 0
  myBounds.Right = bounds.Width
  myBounds.Top = 0
  myBounds.Bottom = bounds.Height
  If myBounds.Right - myBounds.Left < minLen Then Exit Function
  If myBounds.Bottom - myBounds.Top < minLen Then Exit Function
   
  Dim maxLen As Single
  If bounds.Width < bounds.Height Then
    maxLen = bounds.Width / 2
  Else
    maxLen = bounds.Height / 2
  End If
  Dim xStart, yStart As Long
  xStart = bounds.Width / 2
  yStart = bounds.Height / 2
 
  Dim d, c As Long
 
  Dim myPoints() As New pclPoint
  ReDim myPoints(1 To sides) As New pclPoint
 
  Dim angle, myLen, myangle As Double
 
  Dim myPoint, lastPoint  As pclPoint
  Dim myPolygon As New pclPolygon
 
  c = 1
  angle = (2 / sides) * pi
  Set myPolygon.PictureBox = bounds
  myPolygon.Start
 
  For c = 1 To sides
    If approx <> 0 Then
      myangle = Rnd() * angle + (c - 1) * angle
      myLen = Rnd() * (maxLen - minLen) + minLen
    Else
      myangle = 0.5 * angle + (c - 1) * angle
      myLen = minLen
    End If
    myPoints(c).X = CLng(myLen * Sin(myangle)) + xStart
    myPoints(c).Y = CLng(myLen * Cos(myangle)) + yStart
    myPolygon.AddPoint myPoints(c)
  Next c
  myPolygon.Complete
  Set CreatePolygon = myPolygon
End Function

VERSION 5.00
Begin VB.Form Form1
  Caption        =  "Form1"
  ClientHeight    =  5955
  ClientLeft      =  60
  ClientTop      =  345
  ClientWidth    =  9375
  LinkTopic      =  "Form1"
  ScaleHeight    =  397
  ScaleMode      =  3  'Pixel
  ScaleWidth      =  625
  StartUpPosition =  3  'Windows Default
  Begin VB.CheckBox chkCross
      Caption        =  "Cross Hair"
      Height          =  255
      Left            =  6720
      TabIndex        =  16
      Top            =  5400
      Width          =  1095
  End
  Begin VB.CheckBox chkOnMove
      Caption        =  "&On Move"
      Height          =  255
      Left            =  5280
      TabIndex        =  14
      Top            =  5400
      Width          =  1215
  End
  Begin VB.CheckBox Check3
      Caption        =  "Draw Debug Lines"
      Height          =  255
      Left            =  3360
      TabIndex        =  13
      Top            =  5400
      Width          =  1695
  End
  Begin VB.CheckBox Check2
      Caption        =  "Debug Mode"
      Height          =  255
      Left            =  1680
      TabIndex        =  12
      Top            =  5400
      Width          =  1455
  End
  Begin VB.CommandButton Command5
      Caption        =  "Traverse"
      Height          =  375
      Left            =  6480
      TabIndex        =  11
      Top            =  4680
      Width          =  1335
  End
  Begin VB.TextBox Text2
      Height          =  285
      Left            =  600
      TabIndex        =  9
      Text            =  "80"
      Top            =  5040
      Width          =  735
  End
  Begin VB.CheckBox Check1
      Caption        =  "Approximate "
      Height          =  255
      Left            =  120
      TabIndex        =  8
      Top            =  5400
      Value          =  1  'Checked
      Width          =  1215
  End
  Begin VB.CommandButton Command4
      Caption        =  "Save"
      Height          =  375
      Left            =  7920
      TabIndex        =  6
      Top            =  4680
      Width          =  1335
  End
  Begin VB.CommandButton Command3
      Caption        =  "Load"
      Height          =  375
      Left            =  7920
      TabIndex        =  5
      Top            =  5160
      Width          =  1335
  End
  Begin VB.CommandButton Command2
      Caption        =  "Print Shape"
      Height          =  375
      Left            =  3960
      TabIndex        =  4
      Top            =  4680
      Width          =  1335
  End
  Begin VB.CheckBox chkPlotting
      Caption        =  "Plot a Shape"
      Height          =  375
      Left            =  2640
      Style          =  1  'Graphical
      TabIndex        =  3
      Top            =  4680
      Width          =  1215
  End
  Begin VB.TextBox Text1
      Height          =  285
      Left            =  600
      TabIndex        =  2
      Text            =  "3"
      Top            =  4680
      Width          =  735
  End
  Begin VB.CommandButton Command1
      Caption        =  "Generate"
      Height          =  375
      Left            =  1440
      TabIndex        =  1
      Top            =  4680
      Width          =  1095
  End
  Begin VB.PictureBox Picture1
      AutoRedraw      =  -1  'True
      FillColor      =  &H000000FF&
      Height          =  4575
      Left            =  0
      ScaleHeight    =  301
      ScaleMode      =  3  'Pixel
      ScaleWidth      =  621
      TabIndex        =  0
      Top            =  0
      Width          =  9375
  End
  Begin VB.Label lblResult
      Alignment      =  2  'Center
      BackColor      =  &H0000FFFF&
      Caption        =  "Label3"
      Height          =  255
      Left            =  5400
      TabIndex        =  15
      Top            =  4680
      Visible        =  0  'False
      Width          =  855
  End
  Begin VB.Label Label2
      Caption        =  "Length"
      Height          =  255
      Left            =  0
      TabIndex        =  10
      Top            =  5040
      Width          =  735
  End
  Begin VB.Label Label1
      Caption        =  "Sides"
      Height          =  255
      Left            =  0
      TabIndex        =  7
      Top            =  4680
      Width          =  495
  End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim myPolygon As pclPolygon
Dim nearestPoint As pclPoint
Dim fromPoint As pclPoint

Private Sub Check2_Click()
  myPolygon.DebugMode = Not myPolygon.DebugMode
End Sub

Private Sub Check3_Click()
  myPolygon.DrawDebugLines = Not myPolygon.DrawDebugLines
End Sub

Private Sub chkPlotting_Click()
  If chkPlotting.Value = 0 Then
    myPolygon.Complete
  Else
    Picture1.AutoRedraw = True
    Picture1.Cls
    lblResult.Visible = False
    Set nearestPoint = New pclPoint
    Set myPolygon = New pclPolygon
    Set myPolygon.PictureBox = Picture1
    myPolygon.Start
  End If

End Sub

Private Sub Command1_Click()
  GeneratePolygon
End Sub
Private Sub GeneratePolygon()
  chkPlotting.Value = 0
  Picture1.AutoRedraw = True

  Picture1.Cls
  lblResult.Visible = False
  Dim aPolygon As pclPolygon
  Set nearestPoint = New pclPoint
  Set aPolygon = CreatePolygon(Text1.Text, Text2.Text, Check1.Value, Picture1)
  Debug.Print "points:"
  Picture1.Refresh
  Set myPolygon = aPolygon
End Sub

Private Sub Command2_Click()
  myPolygon.PrintPoints
End Sub

Private Sub Command3_Click()
  Picture1.AutoRedraw = True
  Picture1.Cls
  lblResult.Visible = False
  Set nearestPoint = New pclPoint
  Set myPolygon = New pclPolygon
  Set myPolygon.PictureBox = Picture1
  myPolygon.LoadFromDisk "C:\polygon.txt"
  Picture1.Refresh
End Sub


Private Sub Command4_Click()
  myPolygon.SaveToDisk ("c:\polygon.txt")
End Sub

Private Sub Command5_Click()
  If fromPoint Is Nothing Then Exit Sub
  TestPoint
End Sub
Public Sub TestPoint()
  Dim res As Integer
  Picture1.AutoRedraw = False
  Picture1.Refresh
  Set nearestPoint = myPolygon.FindNearestPoint(fromPoint)
 
  If chkCross <> 0 Then
    Picture1.Circle (nearestPoint.X, nearestPoint.Y), 5, vbRed
    Picture1.Circle (fromPoint.X, fromPoint.Y), 3, vbBlue

    Picture1.Line (fromPoint.X, 0)-(fromPoint.X, Picture1.Height)
    Picture1.Line (0, fromPoint.Y)-(Picture1.Width, fromPoint.Y)
  End If
 
  res = myPolygon.Traverse(fromPoint)
  If res = pclPointPosition.InsidePolygon Then
    'Debug.Print "Inside"
    lblResult.Caption = "Inside"
    lblResult.BackColor = &HFF00&
  ElseIf res = pclPointPosition.OutsidePolygon Then
    'Debug.Print "Outside"
    lblResult.Caption = "Outside"
    lblResult.BackColor = &HFF&
  ElseIf res = pclPointPosition.OnEdge Then
    'Debug.Print "On the Edge"
    lblResult.Caption = "Edge"
    lblResult.BackColor = &HFFFF&
  End If
  lblResult.Visible = True
End Sub
Private Sub Form_Load()
  GeneratePolygon
End Sub




Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  If chkOnMove.Value = 0 Then Exit Sub
  Set fromPoint = New pclPoint
  fromPoint.X = CLng(X)
  fromPoint.Y = CLng(Y)
  If chkPlotting.Value = 0 Then
    TestPoint
  End If

End Sub

Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
  Set fromPoint = New pclPoint
  fromPoint.X = CLng(X)
  fromPoint.Y = CLng(Y)
  If chkPlotting.Value = 0 Then
    TestPoint
  Else
    myPolygon.AddPoint fromPoint
  End If
End Sub

---