Cropping a Displayed Image and Copying It to a Bitmap (Visual Basic)

Take the following steps to add code that lets you select an area with a mouse, crop the display to show only that area, and trim the bitmap to match the selected area. (This example uses both cropping and trimming, so that you can see the difference.)

1. Start with the project that you created in Loading and Displaying an Image.

2. Add the following form-level variables to the declarations procedure of the general object in your main form:

Dim Cropping 'The state when the mouse is used for cropping
Dim StartX As Integer 'Starting X position in screen pixels
Dim StartY As Integer 'Starting Y position in screen pixels
Dim EndX As Integer 'Ending X position in screen pixels
Dim EndY As Integer 'Ending Y position in screen pixels

3.  Select the CommandButton control; then add the control to your main form. Put the control at the top of the form to keep it away from the image.

4. In the Properties box, change the CommandButton control's Caption property to Select Rectangle.

5. Add the following code to the CommandButton control's Click procedure. In online help, you can use the Edit pull-down menu to copy the block of code.

Private Sub Command4_Click()

    'Set the scale mode to twips so that we do not have to
    'translate mouse coordinates
    Lead1.ScaleMode = 1

    'Initialize cropping so that you can do it more than once
    If Cropping = True Then
        'Set the clipping area to match the image.
        Lead1.SetDstClipRect Lead1.DstLeft, Lead1.DstTop, Lead1.DstWidth, Lead1.DstHeight

        'Display the image
        Lead1.ForceRepaint
    End If

    'Set a global variable to let other events know that you are cropping
    Cropping = True

    'Set the pointer to a crosshair
    Lead1.MousePointer = 2

End Sub

6. In the LEAD1 control's MouseDown procedure, add the following code. In online help, you can use the Edit pull-down menu to copy the block of code.

Private Sub Lead1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)

    'Save the starting position 
    StartX = X 
    StartY = Y

    'Make the rubberband invisible until the mouse moves
    Lead1.RubberBandVisible = False

End Sub

7. In the LEAD1 control's MouseMove procedure, add the following code. In online help, you can use the Edit pull-down menu to copy the block of code.

Private Sub Lead1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)

If Cropping = True And Button = 1 Then

    'Get the current mouse position
    EndX = X 
    EndY = Y

    'Determine the origin of the rubberband rectangle, regardless of which way the mouse moves.
    If EndX > StartX Then
        rbX = StartX
    Else
        rbX = EndX
    End If
    If EndY > StartY Then
        rbY = StartY
    Else
        rbY = EndY
    End If

    'Determine the height and width of the rubberband rectangle
    rbHeight = Abs(StartY - EndY)
    rbWidth = Abs(StartX - EndX)

    'Set the rubberband rectangle 
    Lead1.SetRubberBandRect rbX, rbY, rbWidth, rbHeight

        'Alternatively, you could use the following properties to set the
        'rubberband rectangle.
        'Lead1.RubberBandHeight = rbHeight
        'Lead1.RubberBandLeft = rbX
        'Lead1.RubberBandTop = rbY
        'Lead1.RubberBandWidth = rbWidth

    'Make the rubberband rectangle visible
    Lead1.RubberBandVisible = True
End If

End Sub

8. In the LEAD1 control's MouseUp procedure, add the following code. In online help, you can use the Edit pull-down menu to copy the block of code.

Private Sub Lead1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)

If Cropping = True Then

    'Get the current mouse position
    EndX = X 
    EndY = Y

    'Get the origin of the clipping rectangle.
    'Allow for different mouse drag directions
    If StartX < EndX Then
        CropLeft = StartX
    Else
       CropLeft = EndX
    End If
    If StartY < EndY Then
        CropTop = StartY
    Else
       CropTop = EndY
    End If

    'Get the height and width of the cropped area
    CropWidth = Abs(EndX - StartX)
    CropHeight = Abs(EndY - StartY)

    'Crop and repaint the image
    Lead1.SetDstClipRect CropLeft, CropTop, CropWidth, CropHeight
    Lead1.ForceRepaint
    Lead1.RubberBandVisible = False
    Lead1.MousePointer = 0 'Default
End If

End Sub

9.  Select the CommandButton control; then add another control to your main form. Put the control at the top of the form to keep it away from the image.

10. In the Properties box, change the CommandButton control's Caption property to Trim. This command button will be used to trim the bitmap in memory and redisplay the bitmap.

11. Add the following code to the CommandButton control's Click procedure. In online help, you can use the Edit pull-down menu to copy the block of code.

Private Sub Command5_Click()

    Screen.MousePointer = 11 'hourglass

    'Use the clipping rectangle's percentage offsets in the image rectangle
    'to determine the trimmed rectangle in the bitmap.
    'Using percentages allows for the possibility that the image is zoomed.
    XFactor = Lead1.BitmapWidth / Lead1.DstWidth
    YFactor = Lead1.BitmapHeight / Lead1.DstHeight
    NewTop = (Lead1.DstClipTop - Lead1.DstTop) * YFactor
    NewLeft = (Lead1.DstClipLeft - Lead1.DstLeft) * XFactor
    NewWidth = Lead1.DstClipWidth * XFactor
    NewHeight = Lead1.DstClipHeight * YFactor

    'Make sure display rectangles are automatically adjusted.
    Lead1.AutoSetRects = True

    'Trim the bitmap.
    Lead1.Trim NewLeft, NewTop, NewWidth, NewHeight

    'Size and redisplay the control, using the new bitmap size.
    'Set the variables used for preserving the aspect ratio.
    'Allow for a border of 1/8 of the form size.
    'The units of measure do not matter, since we are calculating proportions.
    HeightFactor = Lead1.BitmapHeight
    WidthFactor = Lead1.BitmapWidth
    HeightAllowed = ScaleHeight - (ScaleHeight / 4)
    WidthAllowed = ScaleWidth - (ScaleWidth / 4)

    'Center the LEAD control on the form, preserving the aspect ratio.
    'Check to see if using the maximum width will make the image too tall.
    'Set the dimensions based on the result.
    If ((WidthAllowed * HeightFactor) / WidthFactor) < HeightAllowed Then
      Lead1.Left = ScaleWidth / 8
      Lead1.Width = WidthAllowed
      Lead1.Height = (Lead1.Width * HeightFactor) / WidthFactor
      Lead1.TOP = (ScaleHeight - Lead1.Height) / 2
    Else
      Lead1.TOP = ScaleHeight / 8
      Lead1.Height = HeightAllowed
      Lead1.Width = (Lead1.Height * WidthFactor) / HeightFactor
      Lead1.Left = (ScaleWidth - Lead1.Width) / 2
    End If

    'Turn off scroll bars to make sure we use the full client area.
    Lead1.AutoScroll = False

    'Set the image display size to match the LEAD control
    Lead1.SetDstRect 0, 0, Lead1.ScaleWidth, Lead1.ScaleHeight
    Lead1.SetDstClipRect 0, 0, Lead1.ScaleWidth, Lead1.ScaleHeight

    'Display the image
    Lead1.ForceRepaint
    Screen.MousePointer = 0 'Default

End Sub

12. Run your program to test it.