|
|
Title | Let the user select, move, or resize an area using a Shape control |
Keywords | rubberband, rectangle, user drawing, ellipse |
Categories | Graphics |
|
|
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
|
|
|
|
|
|