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

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. $image\btncmd.gif$ Select the Command Button control; then add a control to your form. (Cancel the Command Button Wizard when it appears.) Put the control at the top of the form to keep it away from the image.

3. In the Properties box, change the Command Button control's Name property to SelectRectangle and change the Caption property to Select Rectangle.

4. $image\btncmd.gif$ Select the Command Button control; then add another control to your form. Put the control at the top of the form to keep it away from the image.

5. In the Properties box, change the Command Button control's Name property to TrimBitmap and change the Caption property to Trim Bitmap.

6. Click the Code Window icon on the toolbar.

$image\btncode.gif$ For Access 95.

$image\btncode2.gif$ For Access 97.

7. Select the Declarations module for the General object, and add the following code. In online help, you can select the block of code with the mouse, then press Ctrl-C to copy it.

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

8. Select the Click procedure for the SelectRectangle object, and add the following code. In online help, you can select the block of code with the mouse, then press Ctrl-C to copy it.

' Declare local variables
Dim DstLeft, DstTop, DstWidth, DstHeight

' Set the scale mode to twips
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.
  DstLeft = Lead1.DstLeft
  DstTop = Lead1.DstTop
  DstWidth = Lead1.DstWidth
  DstHeight = Lead1.DstHeight
  Lead1.SetDstClipRect DstLeft, DstTop, DstWidth, 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

9. Select the MouseDown procedure for the Lead1 object, and add the following code. In online help, you can select the block of code with the mouse, then press Ctrl-C to copy it.

'Save the starting position
StartX = X
StartY = Y

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

10. Select the MouseMove procedure for the Lead1 object, and add the following code. In online help, you can select the block of code with the mouse, then press Ctrl-C to copy it.

' Declare local variables
Dim rbX, RbY, rbHeight, rbWidth

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.
  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 visible.
Lead1.RubberBandVisible = True

End If

11. Select the MouseUp procedure for the Lead1 object, and add the following code. In online help, you can select the block of code with the mouse, then press Ctrl-C to copy it.

' Declare local variables
Dim CropLeft, CropTop, CropWidth, CropHeight

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
  Lead1.SetDstClipRect CropLeft, CropTop, CropWidth, CropHeight
  Lead1.ForceRepaint
  Lead1.RubberBandVisible = False
  Lead1.MousePointer = 0 'Default
End If

12. Select the Click procedure for the TrimBitmap object, and add the following code. In online help, you can select the block of code with the mouse, then press Ctrl-C to copy it.

' Declare local variables
Dim XFactor, YFactor, NewTop, NewLeft, NewWidth, NewHeight
Dim HeightFactor, WidthFactor, HeightAllowed, WidthAllowed

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 = 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 = 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.
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
DoCmd.Hourglass False

13. $image\btncmpl.gif$ Click the compile button on the toolbar; then close the code window.

14. Close the form designer, saving the changes.

15. With Form1 selected in the Database window, click the Open button to test the form. Notice that the text printed on the bitmap is scaled as part of the bitmap. If you zoom in, it becomes larger, and if you zoom out, it becomes smaller. The text printed on the control is the normal size for the system font and is not affected by zooming.