Option Explicit
Private Type LineConnect
X As Single
Y As Single
End Type
Dim LineCon() As LineConnect 'keeps record of connection posns
Dim fsngDragOrigTop As Single 'drag original posns
Dim fsngDragOrigLeft As Single
Dim fsngDragOrigX As Single
Dim fsngDragOrigY As Single
Dim lConn(1) As Integer 'which pics are connected
Dim lConnPosn As Integer 'which new pic becomes connected
Private Sub Form_Load()
ReDim LineCon(1)
lConn(0) = 0 'default to pic(0)
lConn(1) = 1 'default to pic(1)
lConnPosn = 1 'next click will move right hand pic
Edges 'find edge posn
DrawLine 'draw line
End Sub
'CONNECTING LINE
'=========================================================
Private Sub Edges()
'Works out how to connect lines
'So eg pic on left and pic on right
'connection will be from middle right of left pic x = 1 y = 0.5
'to middle left of right pic x = 0: y = 0.5
With Picture2(lConn(0))
If .Left + .Width < Picture2(lConn(1)).Left - 400 Then
With LineCon(0): .X = 1: .Y = 0.5: End With
With LineCon(1): .X = 0: .Y = 0.5: End With
ElseIf .Left > Picture2(lConn(1)).Left + Picture2(lConn(1)).Width + 400 Then
With LineCon(0): .X = 0: .Y = 0.5: End With
With LineCon(1): .X = 1: .Y = 0.5: End With
ElseIf .Top + .Height < Picture2(lConn(1)).Top Then
With LineCon(0): .X = 0.5: .Y = 1: End With
With LineCon(1): .X = 0.5: .Y = 0: End With
Else
With LineCon(0): .X = 0.5: .Y = 0: End With
With LineCon(1): .X = 0.5: .Y = 1: End With
End If
End With
End Sub
Private Sub DrawLine()
'Draw the connecting line
With Line1
.X1 = Picture2(lConn(0)).Left + Picture2(lConn(0)).Width * LineCon(0).X
.Y1 = Picture2(lConn(0)).Top + Picture2(lConn(0)).Height * LineCon(0).Y
.X2 = Picture2(lConn(1)).Left + Picture2(lConn(1)).Width * LineCon(1).X
.Y2 = Picture2(lConn(1)).Top + Picture2(lConn(1)).Height * LineCon(1).Y
End With
End Sub
'MOVING PIC BOX
'=========================================================
Private Sub Picture2_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
'starting position for drag drop
With Picture2(Index)
fsngDragOrigTop = .Top
fsngDragOrigLeft = .Left
fsngDragOrigX = X
fsngDragOrigY = Y
.Drag vbBeginDrag
End With
End Sub
Private Sub Picture2_DragDrop(Index As Integer, Source As Control, X As Single, Y As Single)
'ending position if user drags only within source pic
On Error Resume Next
With Picture2(Index)
.Left = fsngDragOrigLeft + (X - fsngDragOrigX)
.Top = fsngDragOrigTop + (Y - fsngDragOrigY)
.Drag vbEndDrag
End With
Edges
DrawLine
End Sub
Private Sub Picture1_DragDrop(Source As Control, X As Single, Y As Single)
On Error Resume Next
With Source
.Left = (X - fsngDragOrigX)
.Top = (Y - fsngDragOrigY)
.Drag vbEndDrag
End With
Edges
DrawLine
End Sub
'=========================================================
'SELECTING NEW PIC BOX
'=========================================================
Private Sub Picture2_DblClick(Index As Integer)
'Move connection to another pic
lConn(lConnPosn) = Index
lConnPosn = 1 - lConnPosn
Edges
DrawLine
End Sub