|
|
|
| Title | Let the user move a polygon's points with grab handles, snapping the points to a visible grid |
|---|
| Description | This example shows how to let the user move a polygon's points with grab handles, snapping the points to a visible grid in Visual Basic 6. |
|---|
| Keywords | polygon, snap to, grid, draw, drag, snapto |
|---|
| Categories | Graphics |
|---|
|
|
|
The program stores the polygon's points in the m_Points array. When you press the mouse down, the MouseDown event handler looks through the points to see if you have clicked one. If so, it stores the index of the point in variable m_DraggingHandle.
|
|
' The grab handle we are dragging. This is
' -1 when we are not dragging any handle.
Private m_DraggingHandle As Integer
' The data points.
Private m_Points() As POINTAPI
Private Const HANDLE_WIDTH As Integer = 6
Private Const HANDLE_HALF_WIDTH As Integer = HANDLE_WIDTH \ _
2
Private Const GRID_WID As Integer = 10
' Grab a handle.
Private Sub picCanvas_MouseDown(Button As Integer, Shift As _
Integer, X As Single, Y As Single)
Dim dx As Single
Dim dy As Single
Dim i As Integer
For i = LBound(m_Points) To UBound(m_Points)
If Abs(m_Points(i).X - X) < HANDLE_HALF_WIDTH And _
Abs(m_Points(i).Y - Y) < HANDLE_HALF_WIDTH _
Then
' We are over this grab handle.
' Start dragging.
m_DraggingHandle = i
picCanvas.MousePointer = vbCrosshair
Exit For
End If
Next i
End Sub
|
|
|
When you move the mouse, the MouseMove event handler checks the chkSnapToGrid check box to see if it should snap the X and Y coordinates to the grid. If the point has not moved, the routine exits to reduce flicker. Otherwise it moves the point and refreshes the picCanvas PictureBox to raise its Paint event.
|
|
' Move the drag handle.
Private Sub picCanvas_MouseMove(Button As Integer, Shift As _
Integer, X As Single, Y As Single)
' Do nothing if we are not dragging.
If m_DraggingHandle = -1 Then Exit Sub
' Snap to grid.
If chkSnapToGrid.Value = vbChecked Then
X = GRID_WID * CInt(X / GRID_WID)
Y = GRID_WID * CInt(Y / GRID_WID)
' Don't redraw if the point hasn't moved.
If (m_Points(m_DraggingHandle).X = X) And _
(m_Points(m_DraggingHandle).Y = Y) Then Exit Sub
End If
' Move the handle.
m_Points(m_DraggingHandle).X = X
m_Points(m_DraggingHandle).Y = Y
' Redraw.
picCanvas.Cls
picCanvas.Refresh
End Sub
|
|
|
When you release the mouse button, the MouseUp event handler sets m_DraggingHandle = -1 to stop dragging.
|
|
' Stop dragging.
Private Sub picCanvas_MouseUp(Button As Integer, Shift As _
Integer, X As Single, Y As Single)
picCanvas.MousePointer = vbDefault
m_DraggingHandle = -1
End Sub
|
|
|
Subroutine DrawPolygon draws the polygon. If the check box is checked, it draws a positioning grid. It then calls the Polygon API function to draw the polygon.
|
|
' Draw the polygon.
Private Sub DrawPolygon(ByVal pic As PictureBox)
Dim X As Integer
Dim Y As Integer
Dim i As Integer
' Draw the grid if necessary.
If chkSnapToGrid.Value = vbChecked Then
For X = 0 To picCanvas.ScaleWidth Step GRID_WID
For Y = 0 To picCanvas.ScaleHeight Step GRID_WID
picCanvas.PSet (X, Y), vbBlack
Next Y
Next X
End If
' Draw the polygon.
pic.FillStyle = vbFSSolid
pic.FillColor = RGB(&H70, &HFF, &H80)
pic.ForeColor = RGB(0, 0, 256)
Polygon pic.hdc, m_Points(1), UBound(m_Points) - _
LBound(m_Points) + 1
' Draw grab handles as white squares with black edges.
For i = LBound(m_Points) To UBound(m_Points)
pic.FillStyle = vbFSSolid
pic.FillColor = vbWhite
pic.ForeColor = vbBlack
pic.Line (m_Points(i).X - HANDLE_HALF_WIDTH, _
m_Points(i).Y - _
HANDLE_HALF_WIDTH)-Step(HANDLE_WIDTH, _
HANDLE_WIDTH), , B
Next i
End Sub
|
|
|
See also:
For more information on graphics programming in Visual Basic, see my book Visual Basic Graphics Programming.
|
| |
|
| |
|
|
