Cropping 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.)

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

Private Sub Command4_Click()
    'Set the scale mode to twips so that we do not have to
    'translate mouse coordinates
    LEADRasterView1.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.
        LEADRasterView1.SetDstClipRect LEADRasterView1.DstLeft, _
                                       LEADRasterView1.DstTop, _
                                       LEADRasterView1.DstWidth, _
                                       LEADRasterView1.DstHeight
        'Display the image
        LEADRasterView1.ForceRepaint
    End If
    'Set a global variable to let other events know that you are cropping
    Cropping = True
    'Set the pointer to a crosshair
    LEADRasterView1.MousePointer = 2
End Sub

Private Sub LEADRasterView1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
    'Save the starting position
    StartX = x
    StartY = y
    'Make the rubberband invisible until the mouse moves
    LEADRasterView1.RubberBandVisible = False
End Sub

Private Sub LEADRasterView1_MouseMove (ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
    Dim rbX, rbY, rbWidth, rbHeight
    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
        LEADRasterView1.SetRubberBandRect rbX, rbY, rbWidth, rbHeight
            'Alternatively, you could use the following properties to set the
            'rubberband rectangle.
            LEADRasterView1.RubberBandHeight = rbHeight
            LEADRasterView1.RubberBandLeft = rbX
            LEADRasterView1.RubberBandTop = rbY
            LEADRasterView1.RubberBandWidth = rbWidth
        'Make the rubberband rectangle visible
        LEADRasterView1.RubberBandVisible = True
    End If
End Sub

Private Sub LEADRasterView1_MouseUp (ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
    Dim CropLeft, CropTop, CropWidth, CropHeight
    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
        LEADRasterView1.SetDstClipRect CropLeft, CropTop, CropWidth, CropHeight
        LEADRasterView1.ForceRepaint
        LEADRasterView1.RubberBandVisible = False
        LEADRasterView1.MousePointer = 0 'Default
    End If
End Sub

Private Sub Command5_Click()
    Dim XFactor, YFactor
    Dim NewLeft, NewTop, NewWidth, NewHeight
    Dim HeightFactor, WidthFactor
    Dim HeightAllowed, WidthAllowed
    Dim RasterProc As New LEADRasterProcess
    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 = LEADRasterView1.Raster.BitmapWidth / LEADRasterView1.DstWidth
    YFactor = LEADRasterView1.Raster.BitmapHeight / LEADRasterView1.DstHeight
    NewTop = (LEADRasterView1.DstClipTop - LEADRasterView1.DstTop) * YFactor
    NewLeft = (LEADRasterView1.DstClipLeft - LEADRasterView1.DstLeft) * XFactor
    NewWidth = LEADRasterView1.DstClipWidth * XFactor
    NewHeight = LEADRasterView1.DstClipHeight * YFactor
    'Make sure display rectangles are automatically adjusted.
    LEADRasterView1.AutoSetRects = True
    'Trim the bitmap.
    RasterProc.Trim LEADRasterView1.Raster, 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 = LEADRasterView1.Raster.BitmapHeight
    WidthFactor = LEADRasterView1.Raster.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
      LEADRasterView1.Left = ScaleWidth / 8
      LEADRasterView1.Width = WidthAllowed
      LEADRasterView1.Height = (LEADRasterView1.Width * HeightFactor) / WidthFactor
      LEADRasterView1.Top = (ScaleHeight - LEADRasterView1.Height) / 2
    Else
      LEADRasterView1.Top = ScaleHeight / 8
      LEADRasterView1.Height= HeightAllowed
      LEADRasterView1.Width = (LEADRasterView1.Height * WidthFactor) / HeightFactor
      LEADRasterView1.Left = (ScaleWidth - LEADRasterView1.Width) / 2
    End If
    'Turn off scroll bars to make sure we use the full client area.
    LEADRasterView1.AutoScroll = False
    'Set the image display size to match the LEAD control
    LEADRasterView1.SetDstRect 0, 0, LEADRasterView1.ScaleWidth, LEADRasterView1.ScaleHeight
    LEADRasterView1.SetDstClipRect 0, 0, LEADRasterView1.ScaleWidth, LEADRasterView1.ScaleHeight
    'Display the image
    LEADRasterView1.ForceRepaint
    Screen.MousePointer = 0 'Default
End Sub