Cropping a Bitmap 2 (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. |
Add the LEAD RasterProcess Object Library to your project. |
|
On the Project pull-down menu, use the References option, and select the LEAD RasterProcess Object Library (14.5). |
5. |
In the Properties box, change the CommandButton control's Caption property to Select Rectangle. |
6. |
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()
LEADRasterView1.EnableFireMouse2Event = True
'Set the scale mode to twips so that we do not have to
'translate mouse coordinates
LEADRasterView1.ScaleMode = 3
'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
7. |
In the LEADRasterView1 control's MouseDown2 procedure, add the following code. In online help, you can use the Edit pull-down menu to copy the block of code. |
Private Sub LEADRasterView1_MouseDown2(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Long, ByVal y As Long)
'Save the starting position
StartX = x
StartY = y
'Make the rubberband invisible until the mouse moves
LEADRasterView1.RubberBandVisible = False
End Sub
8. |
In the LEADRasterView1 control's MouseMove2 procedure, add the following code. In online help, you can use the Edit pull-down menu to copy the block of code. |
Private Sub LEADRasterView1_MouseMove2(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Long, ByVal y As Long)
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
9. |
In the LEADRasterView1 control's MouseUp2 procedure, add the following code. In online help, you can use the Edit pull-down menu to copy the block of code. |
Private Sub LEADRasterView1_MouseUp2(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Long, ByVal y As Long)
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
10. |
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. |
11. |
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. |
12. |
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()
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
13. |
Run your program to test it. |