Buffer Property

Imports Leadtools
Imports Leadtools.Multimedia
Imports LeadtoolsMultimediaExamples.Fixtures

Public _result As Boolean = False
Public _form As CaptureCtrlForm = New CaptureCtrlForm()
Public Sub CaptureFrameExample()
   ' reference the capture control
   Dim capturectrl As CaptureCtrl = _form.CaptureCtrl

   ' output file
   Dim outFile As String = Path.Combine(LEAD_VARS.MediaDir, "CaptureCtrl_CaptureFrameExample.bmp")

   Try
      ' set the video capture device, use your capture device name here
      If capturectrl.VideoDevices("Logitech") Is Nothing Then
         Throw New Exception("No Logitech video device available")
      End If

      capturectrl.VideoDevices("Logitech").Selected = True

      ' create a new sample target
      Dim st As SampleTarget = New SampleTarget()

      ' set the target media type for the video stream
      Dim amt As MediaType = New MediaType()
      amt.Type = Leadtools.Multimedia.Constants.MEDIATYPE_Video
      amt.SubType = Leadtools.Multimedia.Constants.MEDIASUBTYPE_RGB24
      st.SetAcceptedMediaType(amt)

      ' assign the sample target to the capture control
      capturectrl.TargetObject = st
      capturectrl.TargetFormat = TargetFormatType.AVI

      ' prepare the manual frames capture
      capturectrl.ReadyCapture(CaptureMode.ManualFrames)

      ' do something before the capture starts
      If capturectrl.IsModeAvailable(CaptureMode.ManualFrames) Then
      End If

      ' set the capture mode to manual frames
      capturectrl.StartCapture(CaptureMode.ManualFrames)

      ' capture a frame
      capturectrl.CaptureFrame()

      ' create a media sample using the captured sample from above 
      Dim ms As MediaSample = st.GetSample(-1)

      ' get the sample target's connected media type
      Dim mt As MediaType = st.GetConnectedMediaType()

      Dim bmp As Bitmap = WriteSampleBitmap(outFile, ms, mt)

      ' stop the capture
      capturectrl.StopCapture()

      ' check for the capture file and set the result
      If File.Exists(outFile) Then
         Dim test As Image = Bitmap.FromFile(outFile)
         _result = (test.Width = bmp.Width AndAlso test.Height = bmp.Height AndAlso test.PixelFormat = bmp.PixelFormat)
      End If
   Catch e1 As COMException
      _result = False
   Catch e2 As Exception
      _result = False
   End Try

   ' we'll loop on the state and pump messages for this example.
   ' but you should not need to if running from a Windows Forms application.
   Do While capturectrl.State = CaptureState.Running
      Application.DoEvents()
   Loop
End Sub

Private Function WriteSampleBitmap(ByVal outFile As String, ByVal ms As MediaSample, ByVal mt As MediaType) As Bitmap
   ' get the video information 
   Dim vih As VideoInfoHeader = mt.GetVideoFormatData()

   ' create a bitmap to hold the sample and copy it
   Dim bmp As Bitmap = New Bitmap(vih.bmiHeader.biWidth, vih.bmiHeader.biHeight, FormatFromBitCount(vih.bmiHeader.biBitCount))
   Dim bmpData As BitmapData = bmp.LockBits(New Rectangle(0, 0, bmp.Width, bmp.Height), ImageLockMode.ReadWrite, bmp.PixelFormat)
   Marshal.Copy(ms.Buffer, 0, bmpData.Scan0, GetBitmapSize(bmp, vih.bmiHeader.biBitCount))
   bmp.UnlockBits(bmpData)

   ' flip the upside down buffer
   bmp.RotateFlip(RotateFlipType.Rotate180FlipX)

   ' save the image
   bmp.Save(outFile, ImageFormat.Bmp)
   Return bmp
End Function

Private Function FormatFromBitCount(ByVal bitCount As Integer) As PixelFormat
   Select Case bitCount
      Case 8
         Return PixelFormat.Format8bppIndexed
      Case 16
         Return PixelFormat.Format16bppRgb555
      Case 32
         Return PixelFormat.Format32bppRgb
      Case 48
         Return PixelFormat.Format48bppRgb
      Case 24
         Return PixelFormat.Format24bppRgb
   End Select
   Throw New Exception("Unrecognized bit count")
End Function

Private Function GetBitmapSize(ByVal bmp As Bitmap, ByVal bitCount As Integer) As Integer
   Dim pixelSize As Integer = CInt(Math.Log(CDbl(bitCount)))
   Return (bmp.Width * pixelSize + pixelSize And (Not 3)) * bmp.Height
End Function

Private Function GetBitmapScanRowSize(ByVal bmpSize As Integer, ByVal stride As Integer, ByVal width As Integer) As Integer
   Return CInt(bmpSize / (stride / width))
End Function

Public Sub CaptureFrame_Helper(ByVal sender As Object, ByVal e As EventArgs)
   ' set result
   _result = True
End Sub

Public NotInheritable Class LEAD_VARS
Public Const MediaDir As String = "C:\Program Files (x86)\LEAD Technologies\LEADTOOLS 18\Media"
End Class