I am trying to implement this Gift Wrapping Algorithm (yoshihitoyagi!) done in java, in VB6. I'm pretty sure I have done this properly, but for some reason, it will not work. The returned arrays only have 1 element. I was hoping somebody could take a look (a new set of eyes) and let me know if I am blatently missing something.
Here is my code:
Function small(ByVal Current As Integer, ByVal smallest As Integer, ByVal i As Integer) As Boolean
Dim xa, ya, xb, yb, val As Integer
xa = xPoints(smallest) - xPoints(Current)
xb = xPoints(i) - xPoints(Current)
ya = yPoints(smallest) - yPoints(Current)
yb = yPoints(i) - yPoints(Current)
val = xa * yb - xb * ya
If val > 0 Then
small = True
ElseIf val < 0 Then
small = False
Else
If (xa * xb + ya * yb) < 0 Then
small = False
Else
If (xa * xa + ya * ya) > (xb * xb + yb * yb) Then
small = True
Else
small = False
End If
End If
End If
End Function
Sub CreateContours1()
Dim Min, i, num, smallest, Current, contourcount2 As Integer
Dim xPoints2(), yPoints2() As Long
'Find leftmost lowest point
Min = 1
For i = 1 To contourCount
If yPoints(i) = yPoints(Min) Then
If xPoints(i) < xPoints(Min) Then
Min = i
End If
ElseIf yPoints(i) < yPoints(Min) Then
Min = i
End If
Next
Debug.Print "Min: " & Min
Current = Min
num = 1
Do
contourcount2 = contourcount2 + 1
ReDim Preserve xPoints2(contourcount2)
ReDim Preserve yPoints2(contourcount2)
xPoints2(num) = xPoints(Current)
yPoints2(num) = yPoints(Current)
Debug.Print "num: " & num & ", current: " & Current & "(" & xPoints(Current) & ", " & yPoints(Current) & ")"
num = num + 1
smallest = 1
If smallest = Current Then
smallest = 1
End If
For i = 1 To contourCount
If (Current = i) Or (smallest = i) Then
GoTo continue_loop
End If
If small(Current, smallest, i) Then
smallest = i
End If
Next
Current = smallest
continue_loop:
Loop While Current <> Min
End Sub
All my arrays are starting at 1. So if you see any differences between 1's and 0's that is why.
I understand this is a lot, but any help would be so appreciated.
THANKS!!!!
It's hard to say because I don't know if there are other variables that might be at class/module scope that are not shown, but you may have some undeclared variables in use.
Use Option Explicit and see if any compile errors show up. In particular contourCount
doesn't seem to be declared.
You need to declare each variables type explictly.
This:
Dim Min, i, num, smallest, Current, contourcount2 As Integer
Dim xPoints2(), yPoints2() As Long
Is really this:
Dim Min As Variant, i As Variant, num As Variant, smallest As Variant, Current As Variant, contourcount2 As Integer
Dim xPoints2() As Variant, yPoints2() As Long
So you should change to this:
Dim Min As Long, i As Long, num As Long, smallest As Long, Current As Long, contourcount2 As Long
Dim xPoints2() As Long, yPoints2() As Long
Also note that I changed them all to Long. There is almost no reason to use the Integer (2-byte) data type anymore in VB6.
EDIT1:
All my arrays are starting at 1. So if you see any differences between 1's and 0's that is why.
Are you aware that your redim preserves do not preserve your low bounds of 1 unless you explicitly state it? So `ReDim Preserve xPoints2(contourcount2)' allocates a "zeroeth" slot. You can use 'ReDim Preserve xPoints2(1 to contourcount2)' if you want to start that array at 1.
EDIT2:
Outside your Do loop you have Current = Min
Next inside your Do Loop you have
smallest = 1
If smallest = Current Then
smallest = 1
End If
This means on every iteration smallest is 1.
Next you have For loop that always starts at 1:
For i = 1 To contourCount
If (Current = i) Or (smallest = i) Then
GoTo continue_loop
End If
'the rest ommited because you never get here
Next
Note that small is always 1 so you always branch.
And finally you branch is this:
continue_loop:
Loop While Current <> Min
Current is still 1 and as long as your points are such that when Min was calculated it was not at pos 1 then you will immediately satisfy the Loop condition and exit.