Cropping a Displayed Image and Copying It to a Bitmap (Access 2.0)

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 crop the bitmap to match the selected area.

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. $image\btncmd.gif$ 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.

Sub Button4_Click()

'Set the scale mode to twips
Me![LEAD1].Object.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.
    DstLeft = Me![LEAD1].Object.DstLeft
    DstTop = Me![LEAD1].Object.DstTop
    DstWidth = Me![LEAD1].Object.DstWidth
    DstHeight = Me![LEAD1].Object.DstHeight
    Me![LEAD1].Object.SetDstClipRect DstLeft, DstTop, DstWidth, DstHeight

    'Display the image
    Me![LEAD1].Object.ForceRepaint
  End If

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

'Set the pointer to a crosshair
Me![LEAD1].Object.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.

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
Me![LEAD1].Object.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.

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

If Cropping = True And Button = 1 Then

  'Translate 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.
Me![LEAD1].Object.SetRubberBandRect rbX, rbY, rbWidth, rbHeight

    'Alternatively, you could use the following properties to set the
    'rubberband rectangle.
    ' Me![LEAD1].Object.RubberBandHeight = rbHeight
    ' Me![LEAD1].Object.RubberBandLeft = rbX
    ' Me![LEAD1].Object.RubberBandTop = rbY
    ' Me![LEAD1].Object.RubberBandWidth = rbWidth

'Make the rubberband visible.
Me![LEAD1].Object.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.

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

If Cropping = True Then

  'Translate 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
  Me![LEAD1].Object.SetDstClipRect CropLeft, CropTop, CropWidth, CropHeight
  Me![LEAD1].Object.ForceRepaint
  Me![LEAD1].Object.RubberBandVisible = False
  Me![LEAD1].Object.MousePointer = 0 'Default
End If

End Sub

9. $image\btncmd.gif$ Select the Command Button 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.

Sub Command5_Click()

DoCmd Hourglass True

  '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 = Me![LEAD1].Object.BitmapWidth / Me![LEAD1].Object.DstWidth
  YFactor = Me![LEAD1].Object.BitmapHeight / Me![LEAD1].Object.DstHeight
  NewTop = (Me![LEAD1].Object.DstClipTop - Me![LEAD1].Object.DstTop) * YFactor
  NewLeft = (Me![LEAD1].Object.DstClipLeft - Me![LEAD1].Object.DstLeft) * XFactor
  NewWidth = Me![LEAD1].Object.DstClipWidth * XFactor
  NewHeight = Me![LEAD1].Object.DstClipHeight * YFactor

'Make sure display rectangles are automatically adjusted.
Me![LEAD1].Object.AutoSetRects = True

'Trim the bitmap.
Me![LEAD1].Object.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 = Me![LEAD1].Object.BitmapHeight
  WidthFactor = Me![LEAD1].Object.BitmapWidth
  HeightAllowed = Me.WindowHeight - (Me.WindowHeight / 4)
  WidthAllowed = Me.WindowWidth - (Me.WindowWidth / 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
    Me![LEAD1].Left = Me.WindowWidth / 8
    Me![LEAD1].Width = WidthAllowed
    Me![LEAD1].Height = (Me![LEAD1].Width * HeightFactor) / WidthFactor
    Me![LEAD1].TOP = (Me.WindowHeight - Me![LEAD1].Height) / 2
  Else
    Me![LEAD1].TOP = Me.WindowHeight / 8
    Me![LEAD1].Height = HeightAllowed
    Me![LEAD1].Width = (Me![LEAD1].Height * WidthFactor) / HeightFactor
    Me![LEAD1].Left = (Me.WindowWidth - Me![LEAD1].Width) / 2
  End If

'Turn off scroll bars to make sure we use the full client area.
Me![LEAD1].Object.AutoScroll = False

  'Set the image display size to match the LEAD control
  Me![LEAD1].Object.SetDstRect 0, 0, Me![LEAD1].Object.ScaleWidth, Me![LEAD1].Object.ScaleHeight
  Me![LEAD1].Object.SetDstClipRect 0, 0, Me![LEAD1].Object.ScaleWidth, Me![LEAD1].Object.ScaleHeight

  'Display the image
  Me![LEAD1].Object.ForceRepaint
  DoCmd Hourglass False

End Sub

12. Run your program to test it.