This all goes in the modMisc module:
put these at the top:
Public Type COORD
x As Double
y As Double
End Type
Public Type typeAreas
Name As String
VectorString As String
End Type
Public Areas() As typeAreas
-----------------------------------
these functions belong in modMisc:
Public Function GetArea(fX, fY) As String
Dim iI As Integer, myPointArray() As COORD
For iI = LBound(Areas) To UBound(Areas)
MakePointArray Areas(iI).VectorString, myPointArray
If PointInConvexPolygon(fX, fY, myPointArray) = True Then
GetArea = Areas(iI).Name
Exit Function
End If
Next iI
GetArea = "Unknown"
End Function
Public Function MakePointArray(sPoints As String, ByRef pPointArray() As COORD) As Boolean
Dim pArray() As String, j As Integer, iInt As Integer, iTotalPoints As Integer
iInt = 0
Debug.Print "Orignal Points: " & sPoints
pArray = Split(sPoints, ",")
If ((UBound(pArray) + 1) Mod 2) = 0 Then 'even number
iTotalPoints = (UBound(pArray) + 1) / 2
ReDim pPointArray(iTotalPoints - 1)
For j = 0 To iTotalPoints - 1
pPointArray(j).x = pArray(iInt)
pPointArray(j).y = pArray(iInt + 1)
iInt = iInt + 2
Debug.Print "Pair " & j + 1 & "/" & iTotalPoints & ": <" & pPointArray(j).x & ", " & pPointArray(j).y & ">"
Next j
MakePointArray = True
Else
MakePointArray = False
End If
End Function
Function PointInConvexPolygon(x, y, pp() As COORD) As Boolean
Dim test As Boolean, resultpositive As Boolean, i As Integer, res As Double
For i = 0 To UBound(pp) - 1
res = (pp(i + 1).x * y) - (pp(i + 1).y * x) - (pp(i).x * y) + (pp(i).y * x) _
+ (pp(i).x * pp(i + 1).y) - (pp(i).y * pp(i + 1).x)
If i = 0 Then
If res > 0 Then resultpositive = True
Else
If res > 0 Then test = True Else test = False
If test <> resultpositive Then Exit Function
End If
Next
PointInConvexPolygon = True
End Function
------------------------------------------
At the moment I just have a button that loads the areas in from a text file when clicked, but you could easily make this a command or make it do it in Form_Load:
Private Sub cmdLoadAreas_Click()
ReDim Areas(0)
Dim tmpInt As Integer: tmpInt = 0
Dim tmpString() As String
MyFile = App.Path & "/areas.txt"
Open MyFile For Input As #1
Do Until EOF(1)
ReDim Preserve Areas(tmpInt)
Line Input #1, one$ ', two$
tmpString = Split(one$, "=")
Areas(tmpInt).VectorString = tmpString(0)
Areas(tmpInt).Name = tmpString(1)
tmpInt = tmpInt + 1
Loop
Close #1
End Sub
here is my area command code so you can see how it's used:
Case "area"
SendChat players(tmpID).Name & "'s location: " & GetArea(players(tmpID).xCoords, players(tmpID).yCoords)