connecting lines to picture boxes at runtime

[steve_rm]

l have some picture boxes loaded on to a form at run-time. and l connect these picture boxes with lines at run-time. But the problem is l need a simple way to drag the picture boxes round the form, so all the lines stay attached to the picture boxes. picture boxes can have more then one line attached to it.

If you have time, can you answer me this question. if a user clicks on a picture box, how can l find out what line is connected to it.

Many thanks in advance

[beachbum]

Hi again Steve
I thought that i already answered something very similar to this before. http://www.vbforums.com/showthread.p...highlight=line ... what sort of problems have u got, changes to make etc? You say that a picture box can have multiple lines. I would suggest that you would need to make a Type variable that records the picture box number, the number of lines (u may have a fixed number), the connection position and the picture and connection position of the next picture.

Can u post a picture of the layout that you are looking for. Maybe throw it together in Paint or Excel or something
Regards
Stuart

[beachbum]

Hi again steve
In a one hour throw together I have made a competitor to Visio so this better be what u want !! All u need is a picture box on a form (picture1) a picture box inside picture 1 (picture2) with its index set to 0 and a line inside picture 1 (line1) with its index set to 0. Also, put on 2 command buttons (command1 and command2)
Regards
Stuart

PS Have included as frm file and shown code over two posts cos is too long for one.

Option Explicit
 
Private Type LineConnType
    StartPic As Integer
    EndPic As Integer
End Type
Dim LineConn() As LineConnType
Dim NextLoadLine As Integer
Dim SpareLine As Integer
 
Private Type PicOffsetType
    CurX As Single
    CurY As Single
End Type
Dim PicOffset As PicOffsetType
Dim PictureConn() As Integer
Dim NextLoadPicture As Integer
Dim SparePicture As Integer
 
Dim CurLine As Integer
Dim CurPicture As Integer
 
Dim ConnectStatus As Integer
Dim DragStatus As Integer
 
Dim lCounter As Integer
 
Private Sub Form_Load()
    'Set up main back picture
    With Picture1
        .Appearance = 0
        .BorderStyle = vbFixedSingle
        .BackColor = vbWhite
        .Move 500, 500, 5000, 5000
    End With
    
    'Set up first control array picture
    With Picture2(0)
        .Appearance = 0
        .BorderStyle = vbFixedSingle
        .BackColor = vbRed
        .Visible = False
        .Move 0, 0, 400, 400
    End With
    
    'Set up first control array line
    Line1(0).Visible = False
    
    'Set up command buttons
    With Command1
        .Caption = "Load New"
        .Move 500, 100, 1200, 300
    End With
    With Command2
        .Caption = "Delete"
        .Move 2000, 100, 1200, 300
    End With
    
    NextLoadLine = 1 'The index number of the next line to load
    SpareLine = 0 'How many lines are loaded but not visible
    NextLoadPicture = 1 'Index number of next picture to load
    SpareLine = 0 'Number of pictures loaded but not visible
    CurLine = 0 'Default to no current line
    CurPicture = 1 'Default to first picture being current
    
    LoadNewPic 'Load the first picture
End Sub
 
Private Sub Command1_Click()
    LoadNewPic 'Load new pictures
End Sub
 
Private Sub LoadNewPic()
    On Error Resume Next
    Picture2(CurPicture).BackColor = vbRed 'Set current picture to not current colour
    If SparePicture > 0 Then 'Have we got any spare picture boxes, loaded but not visible
        For lCounter = 1 To Picture2.UBound 'If so, lets loop thru and find one
            With Picture2(lCounter)
                If Not .Visible Then 'Find first non visible picture
                    .Move 0, 0 'Move it to top left
                    .Visible = True 'Show it
                    .ZOrder 'Bring it to front
                    .BackColor = vbGreen 'Set colour to current picture
                    PictureConn(lCounter) = 0 'Start with no line connections
                    SparePicture = SparePicture - 1 'Reduce number of spare pictures
                    CurPicture = lCounter 'Set this as the current picture
                    Exit For
                End If
            End With
        Next
    Else
        Load Picture2(NextLoadPicture) 'Load a new picture
        With Picture2(NextLoadPicture)
            .Move 0, 0 'Move to top left
            .Visible = True 'Set to visible
            .ZOrder 'Bring to front
            .BackColor = vbGreen 'Set colour to current picture
        End With
        CurPicture = NextLoadPicture 'Set this as the current picture
        ReDim Preserve PictureConn(1 To NextLoadPicture) 'Increase array for connections
        NextLoadPicture = NextLoadPicture + 1 'Number of next picture to load
    End If
End Sub
 
Private Sub Command2_Click()
    DeletePicture CurPicture 'Delete green or current picture
    CurPicture = 0 'Set to no current picture
End Sub
 
Private Sub DeletePicture(ByVal PicToDelete As Integer)
    If PicToDelete > 0 Then 'Check valid picture
        Picture2(PicToDelete).Visible = False 'Hide it
        SparePicture = SparePicture + 1 'Add to count of spare pictures ie hidden but still loaded
        If PictureConn(PicToDelete) > 0 Then 'Did that picture have any connecting lines?
            RemoveLinesFromDelPic PicToDelete 'Remove all lines connected to this picture
            PictureConn(PicToDelete) = 0 'Set to having no connecting lines
        End If
    End If
End Sub
 
Private Sub RemoveLinesFromDelPic(ByVal PicToDelete As Integer)
    For lCounter = 1 To UBound(LineConn) 'Loop through all lines
        With LineConn(lCounter)
            If .StartPic = PicToDelete Then 'Is this line connected to deleted picture?
                Line1(lCounter).Visible = False 'Hide it
                PictureConn(.EndPic) = PictureConn(.EndPic) - 1 'Reduce the count of connections for the other picture
                .StartPic = 0: .EndPic = 0 'Set to no connect
            ElseIf .EndPic = PicToDelete Then 'Same again but with opposite end of line
                Line1(lCounter).Visible = False
                PictureConn(.StartPic) = PictureConn(.StartPic) - 1
                .StartPic = 0: .EndPic = 0
            End If
        End With
    Next
End Sub

[beachbum]

'This routine determines if picture is being dragged or having connecting lines drawn or hidden
Private Sub Picture2_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    If CurPicture > 0 Then Picture2(CurPicture).BackColor = vbRed 'Make old current pic red
    CurPicture = Index 'Make this picture the current pic
    Picture2(CurPicture).BackColor = vbGreen 'and colour it green
    If Button = vbLeftButton Then 'User is pressing left mouse button?
        'Check for holding shift key down. This indicates that user wants to connect
        'boxes. But also check that there is a box to connect to
        If (Shift And vbShiftMask) = vbShiftMask And NextLoadPicture - SparePicture > 1 Then
            If ConnectStatus = 0 Or ConnectStatus = Index Then 'No connection so far
                ConnectStatus = Index 'Record the first picture box number for the connection
            Else
                'The first box has been set above and so this must be the second box
                ConnectPictures ConnectStatus, Index 'Connect both boxes
                ConnectStatus = Index 'Set second box as next connection so that user
                'can click on other boxes and keep connecting lines
            End If
        Else
            ConnectStatus = Index 'Reset connections
            DragStatus = Index 'Record the picture box that is being dragged
            PicOffset.CurX = X 'Remember the mouse location within the box
            PicOffset.CurY = Y
            
            For lCounter = 1 To Picture2.UBound 'Disable all boxes to allow smooth dragging
                Picture2(lCounter).Enabled = False
            Next
        End If
    End If
End Sub
 
Private Sub ConnectPictures(ByVal Pic1 As Integer, ByVal Pic2 As Integer)
    Dim lFound As Boolean 'Flag to see if these boxes already connected
    If CurLine > 0 Then
        For lCounter = 1 To UBound(LineConn) 'Loop thru lines
            With LineConn(lCounter)
                If (.StartPic = Pic1 And .EndPic = Pic2) Or (.StartPic = Pic2 And .EndPic = Pic1) Then
                    'Already connected so remove connection
                    PictureConn(.StartPic) = PictureConn(.StartPic) - 1 'Reduce connection count
                    PictureConn(.EndPic) = PictureConn(.EndPic) - 1 'Reduce connection count
                    .StartPic = 0: .EndPic = 0 'Reset connection values
                    SpareLine = SpareLine + 1 'Add to count of lines hidden but loaded
                    Line1(lCounter).Visible = False 'Hide the line
                    lFound = True 'Record as being already connected so dont do again
                    Exit For
                End If
            End With
        Next
    End If
            
    If Not lFound Then 'Not found so connect
        LoadNewLine 'Load a line
        With LineConn(CurLine)
            .StartPic = Pic1 'Record the pictures that this line connects
            .EndPic = Pic2
            PictureConn(.StartPic) = PictureConn(.StartPic) + 1 'Add to the number of connections
            PictureConn(.EndPic) = PictureConn(.EndPic) + 1 'that each picture has
        End With
        DrawLine CurLine, Pic1, Pic2 'Draw the line
        Line1(CurLine).Visible = True 'Make it visible
    End If
End Sub
 
Private Sub LoadNewLine()
'This sub is practically the same as the LoadNewPic sub
    On Error Resume Next
    If SpareLine > 0 Then 'If there is already a line then use it
        For lCounter = 1 To Line1.UBound 'Loop thru lines
            With Line1(lCounter)
                If Not .Visible Then 'Found one that is loaded but not visible
                    .Visible = True 'Make it visible
                    .ZOrder 1 'All lines to back
                    LineConn(lCounter).StartPic = 0 'Default to no connections
                    LineConn(lCounter).EndPic = 0
                    CurLine = lCounter 'Set as current line
                    SpareLine = SpareLine - 1 'Remove one from stack of loaded hidden lines
                    Exit For
                End If
            End With
        Next
    Else
        Load Line1(NextLoadLine) 'Load a new line
        With Line1(NextLoadLine)
            .Visible = True 'Make visible
            .ZOrder 1 'Put to back
        End With
        ReDim Preserve LineConn(1 To NextLoadLine) 'Resize array recording connections
        LineConn(NextLoadLine).StartPic = 0 'Default to no connections
        LineConn(NextLoadLine).EndPic = 0
        CurLine = NextLoadLine 'Set as current line
        NextLoadLine = NextLoadLine + 1 'update number of next line to be loaded
    End If
End Sub
 
Private Sub DrawLine(ByVal LineNum As Integer, ByVal Pic1 As Integer, ByVal Pic2 As Integer)
    'This subroutine actually draws the lines from the centre of the first pic
    'to the centre of the second pic. The use of width / height etc allows the
    'addition of code to resize picture boxes without modifying this sub
    On Error Resume Next
    With Picture2(Pic1)
        Line1(LineNum).X1 = .Left + .Width \ 2
        Line1(LineNum).Y1 = .Top + .Height \ 2
    End With
    
    With Picture2(Pic2)
        Line1(LineNum).X2 = .Left + .Width \ 2
        Line1(LineNum).Y2 = .Top + .Height \ 2
    End With
End Sub
 
Private Sub ReDrawConnections(ByVal PicThatMoved As Integer)
    'Redraw the lines if a picture box moves
    On Error Resume Next
    For lCounter = 1 To UBound(LineConn)
        With LineConn(lCounter)
            'Find all lines that are connected to this picture box
            If .StartPic = PicThatMoved Or .EndPic = PicThatMoved Then
                DrawLine lCounter, .StartPic, .EndPic 'Redraw them
            End If
        End With
    Next
End Sub
 
Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
'User is moving / dragging a picture box
    Dim LeftPosn As Single 'Where to redraw the picture box
    Dim TopPosn As Single
    Dim HitAnEdge As Boolean 'User has dragged too far.. this can prob be handled better
    If Button = vbLeftButton And DragStatus > 0 Then 'Leftbutton down and dragging
        With PicOffset
            LeftPosn = X - .CurX 'Get left position and then check for boundaries
            If LeftPosn < -40 Then LeftPosn = 0: HitAnEdge = True
            If LeftPosn + Picture2(DragStatus).Width > Picture1.Width + 40 Then LeftPosn = Picture1.Width - Picture2(DragStatus).Width: HitAnEdge = True
            TopPosn = Y - .CurY 'Get top position and then check for boundaries
            If TopPosn < -40 Then TopPosn = 0: HitAnEdge = True
            If TopPosn + Picture2(DragStatus).Height > Picture1.Height + 40 Then TopPosn = Picture1.Height - Picture2(DragStatus).Height: HitAnEdge = True
            Picture2(DragStatus).Move LeftPosn, TopPosn
        End With
        If PictureConn(DragStatus) > 0 Then ReDrawConnections DragStatus 'Redraw lines
        If HitAnEdge Then DragStatus = 0 'Reset to no dragging if hit an edge
    End If
End Sub
 
Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    On Error Resume Next
    DragStatus = 0
    For lCounter = 1 To Picture2.UBound
        Picture2(lCounter).Enabled = True 'Reenable all pics when dragging finished
    Next
End Sub

[beachbum]

This is one dang funky program ... load a few picture boxes (using the command button) and then move them around the big picture box. Connect each picture box to every other picture box and then start dragging them around for some cool elastic effects