View Full Version : crop live video

February 28, 2003, 15:49:55
I need to overlay an image like in your example graphgic overlay a rectangle and be able to move this recangle with a mouse and cut the area in the recangle only from the entire image.

Stefan Geissler
March 3, 2003, 11:45:52

At first, you need some special types and declare them in your form:

Private Type RECT
Left As Long
Top As Long
Right As Long
bottom As Long
End Type

Private Type POINT
Left As Long
Right As Long
End Type

' The cropping rectangle. (ROI = Region Of Interest)
Private UserROI As RECT

' Mouse position is needed for easy UserROI movement on the live video
' image.
Private MousePos As POINT

Now, you need to setup ICImagingControl in you application as follows. This
sub should be called, after you have setup your video capture device:

Private Sub MakeDeviceSettings()
ICImagingControl1.MemoryCurrentGrabberColorformat = ICRGB32
ICImagingControl1.ImageRingBufferSize = 5
ICImagingControl1.LiveCaptureContinuous = True
ICImagingControl1.LiveCaptureLastImage = False
ICImagingControl1.LiveDisplay = False
ICImagingControl1.Width = ICImagingControl1.ImageWidth
ICImagingControl1.Height = ICImagingControl1.ImageHeight
ICImagingControl1.OverlayBitmap.Enable = True

UserROI.Top = 0
UserROI.Left = 0
UserROI.bottom = ICImagingControl1.ImageHeight
UserROI.Right = ICImagingControl1.ImageWidth
End Sub

Then, you need a small helper sub, that is responsible to normalize
the UserROI rectangle:

' NormalizeRect
' Returns a normalized rectangle based on Val.
' Normalized means: (left <= right, top <= bottom, right < MaxX, bottom < MaxY)
Private Function NormalizeRect(ByRef Val As RECT) As RECT
Dim Tmp As Long
Dim r As RECT
r = Val
If r.Top > r.bottom Then
Tmp = r.Top
r.Top = r.bottom
r.bottom = Tmp
End If
If r.Left > r.Right Then
Tmp = r.Left
r.Left = r.Right
r.Right = Tmp
End If
If r.Top < 0 Then
r.Top = 0
End If
If r.Left < 0 Then
r.Left = 0
End If
If r.bottom >= ICImagingControl1.ImageHeight Then
r.bottom = ICImagingControl1.ImageHeight - 1
End If
If r.Right >= ICImagingControl1.ImageWidth Then
r.Right = ICImagingControl1.ImageWidth - 1
End If
NormalizeRect = r
End Function

Then, you need a sub, that deletes and redraws the rectangle:

' DrawRectangle
' Draw the rectangle on the live video. The position of the rectangle
' is specified by the UserROI. The paramter Colored is used to determine,
' whether the rectangle is deleted from the overlay or to be drawn. To
' delete the rectangle from the overlay, it is redrawn with the current
' dropout color.
Private Sub DrawRectangle(Colored As Boolean)
Dim Col As Long

With ICImagingControl1.OverlayBitmap
If Colored Then
Col = RGB(255, 0, 0) ' red
Col = .DropOutColor
End If

.DrawLine Col, UserROI.Left, UserROI.Top, UserROI.Right, UserROI.Top
.DrawLine Col, UserROI.Right, UserROI.Top, UserROI.Right, UserROI.bottom
.DrawLine Col, UserROI.Right, UserROI.bottom, UserROI.Left, UserROI.bottom
.DrawLine Col, UserROI.Left, UserROI.bottom, UserROI.Left, UserROI.Top
End With
End Sub

At least, you need the sub, that crops the wanted region from the live video
into a Visual Basic PictureBox control:

' CropImage
' Render the picture in IC Imaging Control's to the CropPicture's picture by
' using the rect in UserROI as parameters. This sub is called from the
' ICImagingControl1_ImageAvailable event sub.
Private Sub CropImage(ByVal BufferIndex As Long)
Dim ib As ImageBuffer

If UserROI.Right - UserROI.Left > 2 And UserROI.bottom - UserROI.Top > 2 Then
Set ib = ICImagingControl1.ImageBuffers.Item(BufferIndex)
CropPicture.PaintPicture ib.Picture, 0, 0, CropPicture.Width, CropPicture.Height, _
UserROI.Left + 1, UserROI.Top + 1, _
UserROI.Right - UserROI.Left - 1, _
UserROI.bottom - UserROI.Top - 1
End If
End Sub

This is all for the preparations. Now, you have to implement the mouse event
handler subs of IC Imaging Control:

' ICImagingControl1_MouseDown
' MouseDown event. Resets the UserROI, if the left mouse button is pressed.
Private Sub ICImagingControl1_MouseDown(ByVal Button As Long, ByVal Shift As Long, ByVal XPos As Integer, ByVal YPos As Integer)

If (Button And vbLeftButton) Then
DrawRectangle False

UserROI.Left = XPos
UserROI.Top = YPos
UserROI.Right = XPos
UserROI.bottom = YPos
End If
MousePos.Left = -1
End Sub

' ICImagingControl1_MouseMove
' The mouse move is used to resize the UserROI if the left mouse button
' is pressed. The UserROI will be move over the live video image, if the
' right mouse button is pressed.
Private Sub ICImagingControl1_MouseMove(ByVal Button As Long, ByVal Shift As Long, ByVal XPos As Integer, ByVal YPos As Integer)
Dim X, Y As Long
If ICImagingControl1.LiveVideoRunning Then
If Button And vbLeftButton Then
DrawRectangle False
UserROI.Right = XPos
UserROI.bottom = YPos
UserROI = NormalizeRect(UserROI)
DrawRectangle True
End If

If Button And vbRightButton Then
If MousePos.Left <> -1 Then
DrawRectangle False
X = MousePos.Left - XPos
Y = MousePos.Right - YPos
UserROI.Left = UserROI.Left - X
UserROI.Right = UserROI.Right - X
UserROI.Top = UserROI.Top - Y

UserROI.bottom = UserROI.bottom - Y

UserROI = NormalizeRect(UserROI)
DrawRectangle True
End If
MousePos.Left = XPos
MousePos.Right = YPos
End If
End If
End Sub

The ImageAvailable event sub is used to display the live video and to
call the CropImage sub.

' ICImagingControl1_ImageAvailable
' Display the live video and call the CropImage sub. In the CropImage sub
' the image, that is limited by the UserROI is copied to and displayed in
' the CopPicture PictureBox control.
Private Sub ICImagingControl1_ImageAvailable(ByVal BufferIndex As Long)
CropImage BufferIndex
End Sub