Home
Search
 
What's New
Index
Books
Links
Q & A
Newsletter
Banners
 
Feedback
Tip Jar
 
C# Helper...
 
XML RSS Feed
Follow VBHelper on Twitter
 
 
MSDN Visual Basic Community
 
 
 
 
 
 
TitleLet the user select, move, or resize an area using a Shape control
Keywordsrubberband, rectangle, user drawing, ellipse
CategoriesGraphics
 
Thanks to Chris Wagg.

Let the user click and drag to move or resize a Shape control. Combo1 is a control array of ComboBoxes controlling the Shape control's appearance.

 
Private Sub Combo1_Click(Index As Integer)
Dim ndex As Integer

    ndex = Combo1(Index).ListIndex
    If ndex < 0 Then Exit Sub

    Select Case Index
    Case 0 ' borderstyle
        Shape1(0).BorderStyle = ndex
    Case 1 ' borderwidth
        ndex = Val(Combo1(Index).Text)
        If ndex < 1 Then ndex = 1
        Shape1(0).BorderWidth = ndex
    Case 2 ' fillstyle
        Shape1(0).FillStyle = ndex
    Case 3 ' shape
        Shape1(0).Shape = ndex
    End Select
End Sub
 
The main selection code appears in the PictureBox's MouseDown and MouseMove event handlers.

As you'll see shortly, the PictureBox's mouse pointer is a crosshair when it is not over the currently selected area. If it is over the selected area, it shows a drag pointer (up-down, left-right, all, northwest-southeast, etc.) depending on where it is (middle, edge, or corner).

In the MouseDown event handler, the code examines the PictureBox's mouse pointer. If the pointer is vbSizeAll, then the cursor is over the center of the selected area. In that case, the code sets Moving to True to indicate that a move is starting. It saves the current position in AnchorX and AnchorY, and the Shape's current position in ShpL and ShpT.

If the mouse pointer is vbCrosshair, then the mouse is not over the Shape control. In that case, the user is starting a new selection from the current mouse position. The program moves the Shape control there and begins sizing it. The program sets Sizing to True to indicate that the user is about to start this sizing. It saves the current position in AnchorX and AnchorY, and moves the Shape to this position.

If the mouse pointer has some other shape, the mouse is over an edge or corner of the Shape control. In that case, the program sets Sizing to True to indicate that the user is resizing the area. It examines the mouse position and sets AnchorX and AnchorY to indicate the coordinates of the Shape that will not change as the mouse is moved.

 
Private Const GAP As Single = 20

' Start dragging, resizing, or selecting a new area.
Private Sub Picture1_MouseDown(Index As Integer, Button As _
    Integer, Shift As Integer, X As Single, Y As Single)
    Select Case Picture1(Index).MousePointer
        Case vbSizeAll
            ' The mouse is over the center of the Shape.
            ' Start a drag.
            Moving = True
            AnchorX = X
            AnchorY = Y
            ShpL = ShapeRect.Left
            ShpT = ShapeRect.Top
        Case vbCrosshair
            ' The mouse is over nothing.
            ' Start a new area selection.
            Sizing = True
            AnchorX = X
            AnchorY = Y
            staticX = False
            staticY = False
            Shape1(0).Move X, Y, 2 * Screen.TwipsPerPixelX, _
                2 * Screen.TwipsPerPixelY
        Case Else
            ' The mouse is over an edge of the Shape.
            ' Start a new area selection.
            Sizing = True
            If (Abs(X - ShapeRect.Left) < GAP) Then AnchorX _
                = ShapeRect.Right
            If (Abs(X - ShapeRect.Right) < GAP) Then _
                AnchorX = ShapeRect.Left
            If (Abs(Y - ShapeRect.Top) < GAP) Then AnchorY _
                = ShapeRect.Bottom
            If (Abs(Y - ShapeRect.Bottom) < GAP) Then _
                AnchorY = ShapeRect.Top
    End Select
End Sub
 
The MouseMove event handler has three tasks depending on whether the user is moving the Shape, resizing the Shape, or neither (moving the mouse with the button up).

If the user is moving the control, the code calculates the amount the mouse has moved since the MouseDown event and adds that to the Shape's original position.

If the user is resizing the control, then the code changes the Shape's width or height using the mouse's X or Y coordinate. If staticX is True, then the program is not allowed to change the Shape's width (the user is dragging the top or bottom edge) so the code saves the Shape's current Left coordinate and Width. If staticX is False, then the code sets the control's new Left coordinate and width. Note that the Width must be positive so the code sets the control's Left coordinate to either its current value or the mouse's X coordinate, whichever is necessary to give a positive Width. The code updates the control's height similarly. After it has calculated the control's new position and dimensions, it moves the control to its new position.

Finally, if the user is neither moving or resizing the control, the mouse is moving over the PictureBox with the button released. The code needs to set the appropriate mouse pointer. If the InShape function indicates that the mouse is not over the Shape, then the code sets the cursor to a crosshair.

If the mouse is over the Shape control, the code determines which edges are near the mouse and sets the mouse pointer accordingly.

 
' Size or move the Shape, or set the appropriate
' mouse pointer.
Private Sub Picture1_MouseMove(Index As Integer, Button As _
    Integer, Shift As Integer, X As Single, Y As Single)
Dim l As Single
Dim t As Single
Dim w As Single
Dim h As Single
Dim new_mouse_pointer As Integer
Dim near_left As Boolean
Dim near_right As Boolean
Dim near_top As Boolean
Dim near_bottom As Boolean

    If Moving Then
        ' Moving.
        l = ShpL + (X - AnchorX)
        t = ShpT + (Y - AnchorY)
        Shape1(0).Move l, t
    ElseIf Sizing Then
        ' Sizing.
        If staticX Then
            ' The X coordinate is static.
            l = Shape1(0).Left
            w = Shape1(0).Width
        Else
            ' The X coordinate can move.
            If X > AnchorX Then
                l = Shape1(0).Left
                w = X - AnchorX
            Else
                l = X
                w = AnchorX - X
            End If
        End If
        If staticY Then
            ' The Y coordinate is static.
            t = Shape1(0).Top
            h = Shape1(0).Height
        Else
            ' The Y coordinate can move.
            If Y > AnchorY Then
                t = Shape1(0).Top
                h = Y - AnchorY
            Else
                t = Y
                h = AnchorY - Y
            End If
        End If

        ' Position the Shape.
        Shape1(0).Move l, t, w, h
    Else
        ' Not moving or sizing.
        If Not InShape(X, Y) Then
            ' The mouse is not over the shape.
            new_mouse_pointer = vbCrosshair
        Else
            ' The mouse is over the Shape.
            ' Assume we can resize either X or Y.
            staticY = False
            staticX = False

            ' See which edges we're near.
            near_left = (Abs(X - ShapeRect.Left) < GAP)
            near_right = (Abs(X - ShapeRect.Right) < GAP)
            near_top = (Abs(Y - ShapeRect.Top) < GAP)
            near_bottom = (Abs(Y - ShapeRect.Bottom) < GAP)
            If (near_left And near_top) Or (near_right And _
                near_bottom) Then
                ' Upper left or lower right corner.
                new_mouse_pointer = vbSizeNWSE
            ElseIf (near_left And near_bottom) Or _
                (near_right And near_top) Then
                ' Upper right or lower left corner.
                new_mouse_pointer = vbSizeNESW
            ElseIf (near_left Or near_right) Then
                ' Left or right edge.
                new_mouse_pointer = vbSizeWE
                staticY = True
            ElseIf (near_top Or near_bottom) Then
                ' Top or bottom edge.
                new_mouse_pointer = vbSizeNS
                staticX = True
            Else
                ' Somewhere in the middle.
                new_mouse_pointer = vbSizeAll
            End If
        End If

        ' Don't change mouse if not necessary.
        If Picture1(Index).MousePointer <> _
            new_mouse_pointer Then
            Picture1(Index).MousePointer = new_mouse_pointer
        End If
    End If
End Sub

' Return True if the mouse is over the Shape.
Private Function InShape(ByVal X As Single, ByVal Y As _
    Single) As Boolean
    InShape = _
        (X >= ShapeRect.Left) And _
        (X <= ShapeRect.Right) And _
        (Y >= ShapeRect.Top) And _
        (Y <= ShapeRect.Bottom)
End Function
 
Finally, the MouseUp event handler ends any current move or resize.
 
' Finish moving or sizing.
Private Sub Picture1_MouseUp(Index As Integer, Button As _
    Integer, Shift As Integer, X As Single, Y As Single)
    Sizing = False
    Moving = False
    GetShapeRect Shape1(0)
End Sub
 
 
Copyright © 1997-2010 Rocky Mountain Computer Consulting, Inc.   All rights reserved.
  Updated