[RESOLVED] Rubber band logic

[krtxmrtz]

In a picturebox I have this rectangular shape control that can be resized when dragging on its sides. The basic core of the code I'm using is,

Dim DraggingFlag As Boolean
Dim X0 As Single, Y0 As Single

Private Sub Form_Load()
   DraggingFlag = False
End Sub

Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
   X0 = X
   Y0 = Y
   DraggingFlag = True
End Sub

Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
   Dim dx As Single, dy As Single

   'This is the case for dragging on the right side
   'The rest are similar and I don't transbribe them
   If DraggingFlag Then
      dx = X - X0
      With Shape1
         .Move .Left, .Top, .Width + dx
      End With
   End If
End Sub

Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
   DraggingFlag = False
End Sub

The problem is, I'm getting somewhat confused about how I should handle the case when you make the size ever smaller and reach 0 so that you must stretch in the opposite direction. I suppose I'll come out with some working code if I rack my brain a little longer but I'd appreciate it if someone had some handy template.

[TBeck]

do you mean some thing like this:

create a new form with a shape named shape1

Dim DraggingFlag As Boolean
Dim prevX As Single, prevY As Single
Dim drawingRight As Boolean, drawingDown As Boolean
 
Private Sub Form_Load()
   DraggingFlag = False
   drawingRight = True
   drawingDown = True
End Sub
 
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
   prevX = X
   prevY = Y
   DraggingFlag = True
End Sub
 
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim dx As Single, dy As Single
dx = X - prevX
dy = Y - prevY
 
prevX = X
prevY = Y
 
  
   If DraggingFlag Then
      With Shape1
      'determine which way we are drawing
      If ((drawingRight) And (.Width + dx < 0)) Or ((Not drawingRight) And (.Width - dx < 0)) Then
        drawingRight = Not drawingRight
      End If
      If ((drawingDown) And (.Height + dy < 0)) Or ((Not drawingDown) And (.Height - dy < 0)) Then
        drawingDown = Not drawingDown
      End If
      
       'This is the case for dragging on the bottom right side
        If (drawingRight) And (drawingDown) Then
            .Move .Left, .Top, .Width + dx, .Height + dy
       'This is the case for dragging on the bottom left side
        ElseIf (Not drawingRight) And (drawingDown) Then
            .Left = .Left + dx
            .Width = .Width - dx
            .Height = .Height + dy
       'This is the case for dragging on the top right side
        ElseIf (drawingRight) And (Not drawingDown) Then
            .Width = .Width + dx
            .Top = .Top + dy
            .Height = .Height - dy
       'This is the case for dragging on the top left side
        ElseIf (Not drawingRight) And (Not drawingDown) Then
            .Left = .Left + dx
            .Width = .Width - dx
            .Top = .Top + dy
            .Height = .Height - dy
        End If
      End With
   End If
End Sub
 
Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
   DraggingFlag = False
End Sub

[opus]

The code posted by TBeck is working for me, however if you want to restart the procedure completely after releasing the mousebutton, you have to set DrawingRigth and DrawingDown to True in the _MouseUp Eventroutine.
Presently the shape will remain the left or rigth border and the top or bottom border on the position of the left and top border of the starting shape.

[krtxmrtz]

do you mean some thing like this:
...

Yes it's working for me too, all I have to do now is add some cases for when you start pulling from the top or the left side. Thanks!

[krtxmrtz]

Yes it's working for me too, all I have to do now is add some cases for when you start pulling from the top or the left side. Thanks!

I've added some goodies like dragging on each of the 4 sides, appropriate mousepointers and a moving feature so here's the final code:

Option Explicit
Dim DraggingFlag As Boolean
Dim prevX As Single, prevY As Single
Dim flgRight As Boolean, flgDown As Boolean
Dim flgLeft As Boolean, flgUp As Boolean
Dim flgMove As Boolean
Dim Delta As Single
 
Private Sub Form_Load()
    DraggingFlag = False
    flgRight = False
    flgDown = False
    flgLeft = False
    flgUp = False
    flgMove = False
    'Optional (if scale is set differently then
    'change the value of Delta accordingly)
    ScaleMode = vbPixels
    '5 pixel area around the shape borders
    'where dragging becomes active
    Delta = 5
End Sub
 
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim shpRight As Single, shpBottom As Single
    
    prevX = X
    prevY = Y
    
    'Determine which border is going to be dragged on
    With Shape1
        shpRight = .Left + .Width
        shpBottom = .Top + .Height
        If X < .Left + Delta And X > .Left - Delta Then
            'Left border
            If Y > .Top - Delta And Y < .Top + Delta Then
                'Upper left corner
                flgUp = True
                flgLeft = True
            ElseIf Y > shpBottom - Delta And Y < shpBottom + Delta Then
                'Lower left corner
                flgDown = True
                flgLeft = True
            ElseIf Y > .Top + Delta And Y < shpBottom - Delta Then
                'Rest of the left border
                flgLeft = True
            End If
        ElseIf X > shpRight - Delta And X < shpRight + Delta Then
            'Right boder
            If Y > .Top - Delta And Y < .Top + Delta Then
                'Upper right corner
                flgUp = True
                flgRight = True
            ElseIf Y > shpBottom - Delta And Y < shpBottom + Delta Then
                'Lower right corner
                flgDown = True
                flgRight = True
            ElseIf Y > .Top + Delta And Y < shpBottom - Delta Then
                'Rest of the right border
                flgRight = True
            End If
        ElseIf X > .Left + Delta And X < shpRight - Delta Then
            'Central part of either the upper or the lower border
            If Y > .Top - Delta And Y < .Top + Delta Then
                'Upper border
                flgUp = True
            ElseIf Y > shpBottom - Delta And Y < shpBottom + Delta Then
                'Lower border
                flgDown = True
            Else
                'Center of the shape: shape will be moved
                flgMove = True
            End If
        End If
    End With
    
    DraggingFlag = True
    
End Sub
 
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim dx As Single, dy As Single
 
    dx = X - prevX
    dy = Y - prevY
    
    prevX = X
    prevY = Y
 
    'Select the appropriate mousepointer
    SetPointer X, Y, Shape1
    
    If DraggingFlag Then
        With Shape1
            'Determine which way we are drawing
            If (flgRight And (.Width + dx < 0)) Then
                flgRight = False
                flgLeft = True
                dx = dx + .Width
            End If
            If (flgLeft And (.Width - dx < 0)) Then
                flgRight = True
                flgLeft = False
                dx = dx - .Width
            End If
            If (flgDown And (.Height + dy < 0)) Then
              flgDown = False
              flgUp = True
              dy = dy + .Height
            End If
            If (flgUp And (.Height - dy < 0)) Then
              flgDown = True
              flgUp = False
              dy = dy - .Height
            End If
            
            If flgMove Then
                .Move .Left + dx, .Top + dy
            ElseIf flgRight Then
                If flgUp Then
                    .Move .Left, .Top + dy, .Width + dx, .Height - dy
                ElseIf flgDown Then
                    .Move .Left, .Top, .Width + dx, .Height + dy
                Else
                    .Move .Left, .Top, .Width + dx
                End If
            ElseIf flgLeft Then
                If flgUp Then
                    .Move .Left + dx, .Top + dy, .Width - dx, .Height - dy
                ElseIf flgDown Then
                    .Move .Left + dx, .Top, .Width - dx, .Height + dy
                Else
                    .Move .Left + dx, .Top, .Width - dx
                End If
            Else
                If flgUp Then
                    .Move .Left, .Top + dy, .Width, .Height - dy
                ElseIf flgDown Then
                    .Move .Left, .Top, .Width, .Height + dy
                End If
            End If
 
        End With
    End If
End Sub
Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    DraggingFlag = False
    flgRight = False
    flgDown = False
    flgLeft = False
    flgUp = False
    flgMove = False
    MousePointer = vbDefault
End Sub
Private Sub SetPointer(X As Single, Y As Single, sh As Shape)
    Dim shpRight As Single, shpBottom As Single
    
    With sh
        shpRight = .Left + .Width
        shpBottom = .Top + .Height
        If X < .Left + Delta And X > .Left - Delta Then
            'Left border
            If Y > .Top - Delta And Y < .Top + Delta Then
                'Upper left corner
                MousePointer = vbSizeNWSE
            ElseIf Y > shpBottom - Delta And Y < shpBottom + Delta Then
                'Lower left corner
                MousePointer = vbSizeNESW
            ElseIf Y > .Top + Delta And Y < shpBottom - Delta Then
                'Rest of the left border
                MousePointer = vbSizeWE
            End If
        ElseIf X > shpRight - Delta And X < shpRight + Delta Then
            'Right boder
            If Y > .Top - Delta And Y < .Top + Delta Then
                'Upper right corner
                MousePointer = vbSizeNESW
            ElseIf Y > shpBottom - Delta And Y < shpBottom + Delta Then
                'Lower right corner
                MousePointer = vbSizeNWSE
            ElseIf Y > .Top + Delta And Y < shpBottom - Delta Then
                'Rest of the right border
                MousePointer = vbSizeWE
            End If
        ElseIf X > .Left + Delta And X < shpRight - Delta Then
            'Central part of either the upper or the lower border
            If Y > .Top - Delta And Y < .Top + Delta Then
                'Upper border
                MousePointer = vbSizeNS
            ElseIf Y > shpBottom - Delta And Y < shpBottom + Delta Then
                'Lower border
                MousePointer = vbSizeNS
            ElseIf Y > .Top + Delta And Y < shpBottom - Delta Then
                'Center of the shape: shape will be moved
                MousePointer = vbSizePointer
            Else
                'Center of the shape but well outside
                MousePointer = vbDefault
            End If
        Else
            'All other areas
            MousePointer = vbDefault
        End If
    End With
End Sub