'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