I read this post in the morning and since then I was mentally stuck with it. The question was very simple and interesting, but solution was not as straight.
After doing a lot of geometrical manipulation, here is the solution. We have a function named [tt]Boundary[/tt]. Its signature is:
[tt]Private Function Boundary(Src() As POINT) As Long()[/tt]
It accepts an array of type [tt]POINT[/tt]. This UDT is used to specify the coordinates of set of points. This function returns an array of type [tt]Long[/tt]. This return array holds the indexes of those points which make up the bounding polygon. Plus the elements in this array are also in the right order, one after another corresponding to the vertices of the polygon.
All you have to do is create an array of type [tt]POINT[/tt], initialize its members and call the [tt]Boundary[/tt] function passing this array as argument. The function will return an array identifying those points which make up the bounding polygon. Here is the code.
[tt]
Option Explicit
Private Type POINT
X As Long
Y As Long
End Type
Const PI = 3.1415927
Private Function Angle(p0 As POINT, p1 As POINT, p2 As POINT) As Single
Dim a As Single, b As Single, c As Single, cosine
a = Distance(p0, p1)
b = Distance(p1, p2)
c = Distance(p0, p2)
cosine = (a * a + b * b - c * c) / (2 * a * b)
If cosine < 0 Then
Angle = Atn(Sqr(1 - cosine * cosine) / cosine)
ElseIf cosine > 0 Then
Angle = PI + PI - Atn(Sqr(1 - cosine * cosine) / cosine)
Else
Angle = PI / 2
End If
If Angle < 0 Then Angle = PI - Angle
End Function
Private Function Distance(p0 As POINT, p1 As POINT) As Single
Dim dP As POINT
dP.X = p1.X - p0.X
dP.Y = p1.Y - p0.Y
Distance = Sqr(dP.X * dP.X + dP.Y * dP.Y)
End Function
Private Function Boundary(Src() As POINT) As Long()
Dim N As Long, X As Long, P As POINT, Count As Long
Dim SmallAngle As Single, ThisAngle As Single, I() As Long
'There must be atleast 3 points in
'the collection to make a polygon.
If UBound(Src) < 2 Then Exit Function
'Set the dimension of the return array
'equal to the size of the source array.
'Internal array for temporary storage.
ReDim I(UBound(Src))
'Get the right most point in the source
'array and store its index in the first
'element of the return array.
I(0) = 0
X = Src(0).X
For N = 0 To UBound(Src)
If X < Src(N).X Then
X = Src(N).X
I(0) = N
End If
Next
Count = 1
'Get an arbitary point P below the
'right most point in the src array.
P.X = X
P.Y = Src(I(0)).Y + 1000
'Now find the next point which makes
'smallest angle with P, first point
'and with itself.
SmallAngle = PI + PI 'Initialize this value
'Try for each point in the source array.
For N = 0 To UBound(Src)
If I(0) <> N Then 'If it is not the first one...
'Calculate its angle.
ThisAngle = Angle(P, Src(I(0)), Src(N))
'If it makes a smaller angle then we need it.
If SmallAngle > ThisAngle Then
SmallAngle = ThisAngle
I(1) = N 'Make it second point in collection.
End If
End If
Next
Count = 2
'Now we have found two points for the return array.
'The rest of the points can be calculated with the
'following loop.
Do
'Initialize the Smallest angle to a large value.
SmallAngle = PI + PI
'Try for each point in the source array.
For N = 0 To UBound(Src)
'Make sure point is not already used.
For X = 0 To Count - 1
If I(X) = N Then GoTo TryNextOne
Next
'Calculate its angle with the previous
'two points in the collection.
ThisAngle = Angle(Src(I(Count - 2)), Src(I(Count - 1)), Src(N))
'If it makes a smaller angle then we need it.
If SmallAngle > ThisAngle Then
SmallAngle = ThisAngle
I(Count) = N 'Add this point to the collection.
End If
TryNextOne: 'Point is already used, try next one.
Next
Count = Count + 1
Loop Until UBound(I) = Count - 1
'Remove extra points from the collection.
For N = 2 To Count - 1
If Angle(Src(I(N - 2)), Src(I(N - 1)), Src(I(N))) > Angle(Src(I(N - 2)), Src(I(N - 1)), Src(I(0))) Then Exit For
Next
ReDim Preserve I(N - 1)
Boundary = I 'Return the result array.
End Function
[/tt]
To test this code, paste all the above code in a form.
Also add the following procedure to the form.
[tt]
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Static PointCount As Long, P() As POINT
If Button = 1 Then
If PointCount = 0 Then Cls: AutoRedraw = True
ReDim Preserve P(PointCount)
P(PointCount).X = X
P(PointCount).Y = Y
ForeColor = vbBlack
DrawWidth = 2
PSet (X, Y)
Print PointCount
PointCount = PointCount + 1
Else
If UBound(P) < 2 Then Exit Sub
ForeColor = vbRed
DrawWidth = 1
Dim I() As Long
I = Boundary(P)
PSet (P(I(0)).X, P(I(0)).Y)
Dim N As Integer
For N = 0 To UBound(I)
Line -(P(I(N)).X, P(I(N)).Y)
Next
Line -(P(I(0)).X, P(I(0)).Y)
PointCount = 0
End If
End Sub
[/tt]
Run the program and randomly click on the form's client area. Numbered points will apprear on the form. After clicking several times, right click on the form once. A polygon will be drawn bounding all the points. The coordinates of this polygon are calculated with this [tt]Boundary[/tt] function. Try again by left clicking on the form repeatedly and then right clicking once.
I think it is exactly what you wanted.
One thing to note. At the moment, this function does not accept "duplicate" points and generates an error. So when passing the [tt]POINT[/tt] array to the function, make sure that there are no duplicate elements.
Please do tell me if it works.
![[fish]](/data/assets/smilies/fish.gif "[fish] [fish]")
