Public Sub DrawArrows()
'Start drawing arrows
Dim ArrowXY(0) As String
For I = LBound(DisplayTree()) To UBound(DisplayTree())
If DisplayTree(I).Pre <> "" Then
ReDim Preserve ArrowXY(ubound(GetReq(I))) As String 'Right here is where I get the error
ArrowXY() = GetReq(I)
For II = LBound(ArrowXY()) To UBound(ArrowXY())
Call ArrowTip(Form1.Img1(ArrowXY(II)).Left, Form1.Img1(ArrowXY(II)).Height, Form1.Img1(I).Left, Form1.Img1(I).Height)
Next II
End If
Next I
End Sub
Public Function GetReq(ObjID As String) As String()
'returns all of an objects requirments
Dim DisDef() As String
Dim DisPre() As String
Dim MyReturn(0) As String
DisPre() = Split(DisplayTree(ObjID).Pre, " ")
For I = LBound(DisplayTree()) To UBound(DisplayTree())
ReDim DisDef(Split(DisplayTree(ObjID).Def, " ")) As String
DisDef() = Split(DisplayTree(ObjID).Def, " ")
For II = LBound(DisDef()) To UBound(DisDef())
For III = LBound(DisPre()) To UBound(DisPre())
If DisDef(II) = DisPre(III) Then 'found match, return index
MyReturn(UBound(MyReturn())) = I
ReDim Preserve MyReturn(UBound(MyReturn()) + 1) As String
Exit For
End If
Next III
Next II
Next I
ReDim Preserve MyReturn(UBound(MyReturn()) - 1) As String
MsgBox (Join(MyReturn(), " "))
'ReDim Preserve GetReq(UBound(MyReturn())) As String
GetReq() = MyReturn()
End Function
Public Sub ArrowTip(x1, y1, x2, y2, Index)
If Index <> 0 Then
Load Form1.Lin1(Index)
Load Form1.Lin1a(Index)
Load Form1.Lin1b(Index)
End If
p1 = 0: q2 = 1: p2 = Form1.Width: q1 = Form1.Height
arrow_length = 30 '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 Sub
