Arrows pointing to all the wrong places & Unloading Line control

[Tontow]

The purpose of this program is to display a graphic tech tree.

The problem is that I can’t seem to get the arrows to point to the right spot.
Would someone Please take a look to see what I'm doing wrong?

PS: the 2 required bmp zips total about 4.9 MB and can be downloaded at: www.geocities.com/tontow_merlin/


Everything having to do with loading and placing controls is in drawingclass.bas . If you hit run program and then go under options and check "Add Name To ToolTips" and "Add Name To Labels" it will provide some addition information for debugging.


Public Sub LoadData(Index As Integer) - Loads and places all the picture boxes.

Public Sub DrawArrows() - determines where to draw the lines and arrows
-- Public Function GetReq(ByVal ObjID As String) As String() - returns an array containing the Picturebox index of all the required objects that must be researched in order to enable the current object. (I know that this function is working correctly because of the Debug output shown in labels and tool tips providing the options mentioned above are enabled)



Also I get an error on the following code (line controls):

For I = Form1.Lin1().UBound To 1 Step -1
    Unload Form1.Lin1(Index)
    Unload Form1.Lin1a(Index)
    Unload Form1.Lin1b(Index)
Next I

[Tontow]

Anyone? I don't know how to fix this; I'm at my wits end.

ScaleMode is set to 3-Pixle.

I pass the .left as x and .top as y. Yet .top and .left seem to be giveing the wrong value.

Public Sub DrawArrows()
'Start drawing arrows
Dim ArrowXY() As String
For I = LBound(DisplayTree()) To UBound(DisplayTree())
    If DisplayTree(I).Pre <> "" Then
        ReDim ArrowXY(UBound(GetReq(I))) As String
        ArrowXY() = GetReq(I)
        For II = LBound(ArrowXY()) To UBound(ArrowXY())
            If ArrowXY(II) <> "" Then
                Debug.Print "Element: " & DisplayTree(I).nName & " " & I & " To Element: " & DisplayTree(ArrowXY(II)).nName & " ; " & Form1.Img1(I).Left & "," & Form1.Img1(I).Height & " :: " & Form1.Img1(ArrowXY(II)).Left & "," & Form1.Img1(ArrowXY(II)).Top
                Debug.Print Join(ArrowXY(), " :; ")
                'MsgBox ("asdf")
                Call ArrowTip(Form1.Img1(I).Left, Form1.Img1(I).Height, Form1.Img1(ArrowXY(II)).Left, Form1.Img1(ArrowXY(II)).Top, Form1.Lin1().UBound)
            End If
        Next II
    End If
Next I
End Sub

Public Sub ArrowTip(x1, y1, x2, y2, Index)
If (x1 <> x2) Or (y1 <> y2) Then 'cleared for 0 lenth string
 
        Load Form1.Lin1(Index + 1)
        Form1.Lin1(Index + 1).Visible = True
        Load Form1.Lin1a(Index + 1)
        Form1.Lin1a(Index + 1).Visible = True
        Load Form1.Lin1b(Index + 1)
        Form1.Lin1b(Index + 1).Visible = True
    
    Debug.Print "ArrowTip: " & x1 & "," & y1 & " :: " & x2 & "," & y2 & " index " & Index
    
    p1 = 0: q2 = 1: p2 = Form1.Width: q1 = Form1.Height
    arrow_length = 10   '0.01 * 1 * Form1.Width
    beta = 30 * PI / 180
    
    Form1.Lin1(Index).x1 = x1
    Form1.Lin1(Index).y1 = y1
    Form1.Lin1(Index).x2 = x2
    Form1.Lin1(Index).y2 = y2
    Dim salfa As Single, calfa As Single, vector As Single
    Dim cth1 As Single, sth1 As Single
    Dim cth2 As Single, sth2 As Single
    Dim v1 As Single, w1 As Single, v2 As Single, w2 As Single
    Dim xab1 As Single, yab1 As Single, xab2 As Single, yab2 As Single
    Dim vab1 As Single, wab1 As Single, vab2 As Single, wab2 As Single
    'Arrow's main line in "absolute" coordinates
    xab1 = Form1.Width * (x1 - p1) / (p2 - p1)
    yab1 = Form1.Height * (y1 - q1) / (q2 - q1)
    xab2 = Form1.Width * (x2 - p1) / (p2 - p1)
    yab2 = Form1.Height * (y2 - q1) / (q2 - q1)
    'Length of the arrow's main body
    vector = Sqr((xab2 - xab1) * (xab2 - xab1) + (yab2 - yab1) * (yab2 - yab1))
    'Cos(alpha) and Sin(alpha):
    calfa = (xab2 - xab1) / vector
    salfa = (yab2 - yab1) / vector
    'Sin & Cos of the angles between the 2 arrow tips and the x axis
    'th1 = alpha - beta
    'th2 = alpha + beta
    cth1 = calfa * Cos(beta) + salfa * Sin(beta)
    sth1 = salfa * Cos(beta) - calfa * Sin(beta)
    cth2 = calfa * Cos(beta) - salfa * Sin(beta)
    sth2 = salfa * Cos(beta) + calfa * Sin(beta)
    'Arrow tips positions in "absolute" coordinates
    vab1 = xab2 - arrow_length * cth1
    wab1 = yab2 - arrow_length * sth1
    vab2 = xab2 - arrow_length * cth2
    wab2 = yab2 - arrow_length * sth2
    'Back to user coordinates
    v1 = p1 + vab1 * (p2 - p1) / Form1.Width
    w1 = q1 + wab1 * (q2 - q1) / Form1.Height
    v2 = p1 + vab2 * (p2 - p1) / Form1.Width
    w2 = q1 + wab2 * (q2 - q1) / Form1.Height
    Form1.Lin1a(Index).x1 = x2
    Form1.Lin1a(Index).y1 = y2
    Form1.Lin1a(Index).x2 = v1
    Form1.Lin1a(Index).y2 = w1
    
    Form1.Lin1b(Index).x1 = x2
    Form1.Lin1b(Index).y1 = y2
    Form1.Lin1b(Index).x2 = v2
    Form1.Lin1b(Index).y2 = w2
End If
End Sub

[brucevde]

If you hit run program

What program? The zip files you posted only contain bitmaps.

Also I get an error on the following code (line controls):

A runtime error or compile error. The For Loop uses a variable named I but the array elements are referenced using a variable named Index, probably should be I.

Anyone? I don't know how to fix this; I'm at my wits end.

Without posting a working sample program, I doubt if anyone would be able to help.

[Tontow]

?? I thought I uploaded it. Anyway, here it is, thanks.

[Tontow]

BTW, If anyone decides to get the bmp zips thay go in a folder call "bmps".
Also, here is the program with the unload problem fixed.

[Tontow]

Dose anyone have any ideas on how to fix it? if you put a break in the module drawingclass - Public Sub DrawArrows() and open the immediate window (ctrl-g),

Public Sub DrawArrows()
'Start drawing arrows
Dim ArrowXY() As String
For I = LBound(DisplayTree()) To UBound(DisplayTree())
    If DisplayTree(I).Pre <> "" Then
        ReDim ArrowXY(UBound(GetReq(I))) As String
        ArrowXY() = GetReq(I)
        For II = LBound(ArrowXY()) To UBound(ArrowXY())
            If ArrowXY(II) <> "" Then
                Debug.Print "Element: " & DisplayTree(I).nName & " " & I & " To Element: " & DisplayTree(ArrowXY(II)).nName & " ; " & Form1.Img1(I).Left & "," & Form1.Img1(I).Height & " :: " & Form1.Img1(ArrowXY(II)).Left & "," & Form1.Img1(ArrowXY(II)).Top
                Debug.Print Join(ArrowXY(), " :; ")
                'MsgBox ("asdf")
                Call ArrowTip(Form1.Img1(I).Left, Form1.Img1(I).Height, Form1.Img1(ArrowXY(II)).Left, Form1.Img1(ArrowXY(II)).Top, Form1.Lin1().UBound)
            End If
        Next II [B]'Put debugging break here[/B]
    End If
Next I [B]'Put debugging break here[/B]
End Sub

run the program,
and then go under options and check "Add Name To ToolTips" and "Add Name To Labels" it will provide some addition information for debugging in the picturebox tooltips and labels
then click anything under the menu "Load Faction Base_tech".

You will notice that .top and .left properties are not reporting the correct coronets of the pictureboxes if you compare the debug output of the immediate window. - This is the problem that I am having.

As far as I can tell, it should work correctly, but its not ......