VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   5988
   ClientLeft      =   48
   ClientTop       =   276
   ClientWidth     =   7740
   LinkTopic       =   "Form1"
   ScaleHeight     =   5988
   ScaleWidth      =   7740
   StartUpPosition =   3  'Windows Default
   Begin VB.CommandButton Command2 
      Caption         =   "Command2"
      Height          =   852
      Left            =   7140
      TabIndex        =   3
      Top             =   1320
      Width           =   552
   End
   Begin VB.CommandButton Command1 
      Caption         =   "Command1"
      Height          =   612
      Left            =   7140
      TabIndex        =   2
      Top             =   360
      Width           =   492
   End
   Begin VB.PictureBox Picture1 
      Height          =   5292
      Left            =   180
      ScaleHeight     =   5244
      ScaleWidth      =   6744
      TabIndex        =   0
      Top             =   180
      Width           =   6792
      Begin VB.PictureBox Picture2 
         Height          =   432
         Index           =   0
         Left            =   180
         ScaleHeight     =   384
         ScaleWidth      =   744
         TabIndex        =   1
         Top             =   240
         Width           =   792
      End
      Begin VB.Line Line1 
         Index           =   0
         X1              =   300
         X2              =   300
         Y1              =   840
         Y2              =   1680
      End
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
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


'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