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.php?s=&threadid=125918&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 !! :p 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 :D ... 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