|
|
|
| Title | Let the user select an area using a rubberband box and place a new control there |
|---|
| Keywords | rubber band, rubberband, rectangle, user drawing |
|---|
| Categories | Graphics |
|---|
|
|
|
Draw with DrawMode = vbInvert to allow lines to be erased. Subroutine DrawBox draws a box in Invert mode. Notice how it saves the original drawing mode and restores it when it is finished. Also note that this routine could draw any shape (ellipse, pentagon, smiley face) instead of a rectangle and the program would work without any other changes.
|
|
' Are we dragging?
Dim dragging As Boolean
' Drag coordinates.
Dim StartX As Single
Dim StartY As Single
Dim CurX As Single
Dim CurY As Single
' Draw the currently selected box.
Private Sub DrawBox()
Dim old_mode As Integer
old_mode = DrawMode
DrawMode = vbInvert
Line (StartX, StartY)-(CurX, CurY), , B
DrawMode = old_mode
End Sub
|
|
|
In the MouseDown event handler, check the button pressed. If the user is pressing the right button, cancel any current drawing. Otherwise start drawing a new box. The ability to cancel is a nice feature left off of many drawing programs.
In the MouseMove event handler, redraw the previous rectangle to remove it and then draw the new rectangle.
In MouseUp, erase the final box and call subroutine CreateControl to make a Label control at the selected position.
|
|
' Start or cancel dragging.
Private Sub Form_MouseDown(Button As Integer, Shift As _
Integer, X As Single, Y As Single)
' Cancel drag if right button.
If Button = vbRightButton Then
If dragging Then
dragging = False
DrawBox ' Erase the old box.
End If
End If
dragging = True
StartX = X
StartY = Y
CurX = X
CurY = Y
DrawBox ' Draw the first box.
End Sub
' Continue dragging.
Private Sub Form_MouseMove(Button As Integer, Shift As _
Integer, X As Single, Y As Single)
' Do nothing if not dragging.
If Not dragging Then Exit Sub
DrawBox ' Erase the old box.
CurX = X
CurY = Y
DrawBox ' Draw the new box.
End Sub
' Finish dragging.
Private Sub Form_MouseUp(Button As Integer, Shift As _
Integer, X As Single, Y As Single)
' Do nothing if not dragging.
If Not dragging Then Exit Sub
dragging = False
DrawBox ' Erase the old box.
CurX = X
CurY = Y
' Take whatever action is necessary here.
CreateControl
End Sub
' Create a new control with corners
' (StartX, StartY) and (CurX, CurY).
Private Sub CreateControl()
Static max_index As Integer
Dim X As Single
Dim Y As Single
Dim wid As Single
Dim hgt As Single
wid = Abs(StartX - CurX)
hgt = Abs(StartY - CurY)
' Don't create really tiny controls.
If wid < 120 Or hgt < 120 Then Exit Sub
If StartX < CurX Then
X = StartX
Else
X = CurX
End If
If StartY < CurY Then
Y = StartY
Else
Y = CurY
End If
' Load the new control
max_index = max_index + 1
Load Label1(max_index)
Label1(max_index).ZOrder
' Position and show the control.
Label1(max_index).Move X, Y, wid, hgt
Label1(max_index).Visible = True
End Sub
|
| |
|
| |
|
|
