Improve company productivity with a Business Account.Sign Up

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 857
  • Last Modified:

Programmatically resizing a shape in VB.NET

I'm struggling with a control that I'm tring to build.
I want to be able to resize a simple rectangle by dragging out either the right or the left edge, or if I click on the middle drag the whole rectangle left and right.

Below is my code which works quite well if I move the mouse very slowly.  Unfortunately, if you move the mouse too quick it jumps off the rectangle and stops the resizing.  As drgmode is left active I have to find a way to jump my mouse back onto the rectangle and click to get drgmode back to null.

Is there a way of ensuring the mouse does not slip off the rectangle?  Or has anyone got any code that is tried and tested on this?

Thanks


Sample Code:

    Private Sub rsMarker_MouseDown(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles rsMarker.MouseDown
        drgStart = Cursor.Position.X
        rsMarker.BorderColor = Color.White
        Select Case e.X
            Case Is <= CInt(rsMarker.Width / 10)
                Cursor.Current = Cursors.SizeWE
                drgMode = "Back"
            Case Is > CInt(rsMarker.Width - (rsMarker.Width / 10))
                Cursor.Current = Cursors.SizeWE
                drgMode = "Forward"
            Case Else
                Cursor.Current = Cursors.SizeAll
                drgMode = "Move"
        End Select
    End Sub

    Private Sub rsMarker_MouseMove(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles rsMarker.MouseMove
        Select Case drgMode
            Case Is = "Back"
                rsMarker.Width -= Cursor.Position.X - drgStart
                rsMarker.Left += Cursor.Position.X - drgStart
            Case Is = "Forward"
                rsMarker.Width += Cursor.Position.X - drgStart
            Case Is = "Move"
                rsMarker.Left += Cursor.Position.X - drgStart
            Case Else
                Select Case e.X
                    Case Is <= CInt(rsMarker.Width / 5)
                        Cursor.Current = Cursors.SizeWE
                    Case Is > CInt(rsMarker.Width - (rsMarker.Width / 5))
                        Cursor.Current = Cursors.SizeWE
                    Case Else
                        Cursor.Current = Cursors.SizeAll
                End Select
        End Select
        drgStart = Cursor.Position.X
    End Sub

    Private Sub rsMarker_MouseUp(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles rsMarker.MouseUp
        rsMarker.BorderColor = Color.Black
        drgMode = ""
    End Sub

Open in new window

0
MikeDFarrant
Asked:
MikeDFarrant
  • 3
  • 2
1 Solution
 
Mike TomlinsonMiddle School Assistant TeacherCommented:
"Is there a way of ensuring the mouse does not slip off the rectangle?"

Yes.  Only attempt to move or resize your control when the mouse button is actually DOWN.  When the mouse is dragged with the button down, it will still fire the MouseMove() event when the cursor is outside the bounds of the control.

Still use your "drgMode" to track what kind of resize is occurring, but you'd need to integrate it with this kind of structure:
Private Sub rsMarker_MouseDown(ByVal sender As System.Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles rsMarker.MouseDown
        If e.Button = Windows.Forms.MouseButtons.Left Then

        ElseIf e.Button = Windows.Forms.MouseButtons.None Then

        End If
    End Sub

    Private Sub rsMarker_MouseMove(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles rsMarker.MouseMove
        If e.Button = Windows.Forms.MouseButtons.Left Then
         
            ' ... this will fire OUTSIDE the control as long as the mouse is held down ...

        ElseIf e.Button = Windows.Forms.MouseButtons.None Then

        End If
    End Sub

Open in new window

0
 
MikeDFarrantAuthor Commented:
Thanks Idle_Mind.  

This did get around one problem.  Now it will only move if my mouse is down - which is great.

Unfortunately the mouse still can jump out of the rectangle and then it does stop resizing/moving.

0
 
Mike TomlinsonMiddle School Assistant TeacherCommented:
If the mouse is down you'll still get MouseMove() events even when it leaves the bounds of the control.

Show me your current MouseDown() and MouseMove() events.

Just to show what I mean, watch how the box moves even when my cursor is BELOW and OUTSIDE the bounds of the control:
Public Class Form1

    Private drgStart As Integer

    Private Sub rsMarker_MouseDown(ByVal sender As System.Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles rsMarker.MouseDown
        If e.Button = Windows.Forms.MouseButtons.Left Then
            drgStart = Cursor.Position.X
        End If
    End Sub

    Private Sub rsMarker_MouseMove(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles rsMarker.MouseMove
        If e.Button = Windows.Forms.MouseButtons.Left Then
            rsMarker.Left += Cursor.Position.X - drgStart
            drgStart = Cursor.Position.X
        End If
    End Sub

End Class

Open in new window


Idle-Mind-434476.flv
0
What Kind of Coding Program is Right for You?

There are many ways to learn to code these days. From coding bootcamps like Flatiron School to online courses to totally free beginner resources. The best way to learn to code depends on many factors, but the most important one is you. See what course is best for you.

 
MikeDFarrantAuthor Commented:
I totally agree that it should work the way you describe (and demonstrate) I was really surprised when I saw what was happening with mine.

Anyway, I've played around and still my mouse seemed to 'drop' the object as it exited its confines.  I'm wondering if it is something to do with the shape being inside a custom control.
My solution in the end was to clip the cursor to the rectangle whilst the mouse is down.  This works really well (Code attached).  I hate admitting defeat but I really had to move on.

Thanks anyway... if anyone else is able to reproduce my problem and finds a proper solution please post it here.

Thanks,

Mike
Private Sub rsMarker_MouseDown(ByVal sender As Object, _
                ByVal e As System.Windows.Forms.MouseEventArgs) Handles rsMarker.MouseDown
        If e.Button = Windows.Forms.MouseButtons.Left Then
            Cursor.Clip = rsMarker.RectangleToScreen(rsMarker.ClientRectangle) '<< Clip Cursor
            drgStart = Cursor.Position.X
            rsMarker.BorderColor = Color.White
            Select Case e.X
                Case Is <= CInt(rsMarker.Width / 5)
                    Cursor.Current = Cursors.SizeWE
                    drgMode = "Back"
                Case Is > CInt(rsMarker.Width - (rsMarker.Width / 5))
                    Cursor.Current = Cursors.SizeWE
                    drgMode = "Forward"
                Case Else
                    Cursor.Current = Cursors.SizeAll
                    drgMode = "Move"
            End Select
        End If

    End Sub

    Private Sub rsMarker_MouseMove(ByVal sender As Object, _
                ByVal e As System.Windows.Forms.MouseEventArgs) Handles rsMarker.MouseMove
        If e.Button = Windows.Forms.MouseButtons.Left Then
            Select Case drgMode
                Case Is = "Back"
                    rsMarker.Width -= Cursor.Position.X - drgStart
                    rsMarker.Left += Cursor.Position.X - drgStart
                    moving = True
                Case Is = "Forward"
                    rsMarker.Width += Cursor.Position.X - drgStart
                    moving = True
                Case Is = "Move"
                    rsMarker.Left += Cursor.Position.X - drgStart
                    moving = True
                Case Else
            End Select
            drgStart = Cursor.Position.X
            Cursor.Clip = rsMarker.RectangleToScreen(rsMarker.ClientRectangle) ' <<< clip cursor
        Else
            Select Case e.X
                Case Is <= CInt(rsMarker.Width / 5)
                    Cursor.Current = Cursors.SizeWE
                Case Is > CInt(rsMarker.Width - (rsMarker.Width / 5))
                    Cursor.Current = Cursors.SizeWE
                Case Else
                    Cursor.Current = Cursors.SizeAll
            End Select
        End If
    End Sub

    Private Sub rsMarker_MouseUp(ByVal sender As Object, _ 
                ByVal e As System.Windows.Forms.MouseEventArgs) Handles rsMarker.MouseUp
        rsMarker.BorderColor = Color.Black
        drgMode = ""
        Cursor.Clip = Rectangle.Empty ' << remove clip restriction
    End Sub

Open in new window

0
 
Mike TomlinsonMiddle School Assistant TeacherCommented:
Yeah...I think we'd have to play with your actual custom controls to figure out.  Sorry we couldn't solve it for ya...  =\

Glad you got something working though.
0
 
DhaestCommented:
This question has been classified as abandoned and is closed as part of the Cleanup Program. See the recommendation for more details.
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

Free Tool: ZipGrep

ZipGrep is a utility that can list and search zip (.war, .ear, .jar, etc) archives for text patterns, without the need to extract the archive's contents.

One of a set of tools we're offering as a way to say thank you for being a part of the community.

  • 3
  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now