VB - Capturing Still Image from WebCam with Hi-Res without Preview

MaTa
2013-05-29
2013-05-29
  • MaTa

    MaTa - 2013-05-29

    I've searched internet for lots of webcam capture sample in vb.net
    I want to capture image from webcam, with hi-res (800x600) and I used the following codes.
    But the image capture, using "CopyFromScreen" and this cause problems for me.
    Is there any other solution to capture image (not from screen)?

    Private Sub CaptureVideo()
        Dim hr As Integer = 0
        Dim sourceFilter As IBaseFilter = Nothing
        Try
            GetInterfaces()
            hr = Me.CaptureGraphBuilder.SetFiltergraph(Me.GraphBuilder)
    
            sourceFilter = FindCaptureDevice()
            SetConfigParms(CaptureGraphBuilder, sourceFilter, 15, 800, 600)
    
            hr = Me.GraphBuilder.AddFilter(sourceFilter, "Video Capture")
            hr = Me.CaptureGraphBuilder.RenderStream(PinCategory.Capture, MediaType.Video, sourceFilter, Nothing, Nothing)
    
            Marshal.ReleaseComObject(sourceFilter)
    
            hr = VideoWindow.put_Owner(PictureBox1.Handle)
            hr = VideoWindow.put_WindowStyle(WindowStyle.Child Or WindowStyle.ClipChildren)
            If Not (VideoWindow Is Nothing) Then 'if the videopreview is not nothing
                VideoWindow.SetWindowPosition(0, 0, PictureBox1.Width, PictureBox1.Height)
            End If
            hr = VideoWindow.put_Visible(OABool.True)
    
            rot = New DsROTEntry(Me.GraphBuilder)
            hr = Me.MediaControl.Run()
    
            Me.CurrentState = PlayState.Running
        Catch
        End Try
    End Sub
    
    Private Sub Savebtn_Click(sender As System.Object, e As System.EventArgs) Handles Savebtn.Click
        Try
            Dim bmp As New Bitmap(PictureBox1.Width, PictureBox1.Height)
            Using g As Graphics = Graphics.FromImage(bmp)
                Dim pt As Point = PictureBox1.PointToScreen(New Point(0, 0))
                g.CopyFromScreen(pt.X, pt.Y, 0, 0, bmp.Size)
            End Using
            PictureBox2.Image = bmp
            PictureBox2.Image.Save("c:\DSHR.bmp")
        Catch
        End Try
    End Sub
    
     
  • Peter_B

    Peter_B - 2013-05-29

    If you use a SampleGrabber you can get the image from BufferCB.

    Here is another way:

      Dim hdc As IntPtr, hdcBmp As IntPtr, hBitmap As IntPtr
    
        hdc = GetDC(Me.Handle)
        hdcBmp = CType(CreateCompatibleDC(CInt(hdc)), IntPtr)
    
        ReleaseDC(Me.Handle, hdc)
    
        Dim hDCSource As IntPtr = GetDC(Me.Handle)
        Dim hDCDestination As IntPtr = CType(CreateCompatibleDC(CInt(hDCSource)), IntPtr)
        hBitmap = CType(CreateCompatibleBitmap(CInt(hDCSource), Me.Width - 8, Me.ClientRectangle.Height), IntPtr)
        Dim hPreviousBitmap As IntPtr = SelectObject(hDCDestination, hBitmap)
        BitBlt(hDCDestination, 0, 0, Width, Height, hDCSource, 0, 0, &HCC0020)
        Dim bitmap As Bitmap = bitmap.FromHbitmap(hBitmap)
    
        Dim path As String
        path = Environment.GetFolderPath(Environment.SpecialFolder.Desktop) + "\image.bmp"
        Try
            bitmap.Save(path)
            Sleep(300)
        Catch exception As Exception
            MessageBox.Show(exception.Message, [Text], MessageBoxButtons.OK, MessageBoxIcon.Error)
        Finally
            Bitmap.Dispose()
            MsgBox("Image saved: " + path)
        End Try
    
     
    Last edit: Peter_B 2013-05-29
  • MaTa

    MaTa - 2013-05-29

    Thanks for your reply
    Sorry, I'm not very good at these kind of coding.
    I try your solution and got some error.

    happen in this line :
    ReleaseDC(PictureBox1.Handle, hdc)

    ############################ Error Message

    PInvokeStackImbalance was detected
    Message: A call to PInvoke function 'DirectShow HiRes!WindowsApplication1.Form1::ReleaseDC' has unbalanced the stack. This is likely because the managed PInvoke signature does not match the unmanaged target signature. Check that the calling convention and parameters of the PInvoke signature match the target unmanaged signature.

    <DllImport("gdi32.dll")> _
    Private Shared Function CreateCompatibleBitmap(hdc As IntPtr, nWidth As Integer,           nHeight As Integer) As IntPtr
    End Function
    
    Private Declare Function GetDC Lib "user32.dll" Alias "GetDC" (ByVal hWnd As IntPtr) As IntPtr
    
    Private Declare Function CreateCompatibleDC Lib "gdi32.dll" (hdc As IntPtr) As IntPtr
    
    Public Declare Function ReleaseDC Lib "user32.dll" (ByVal hWnd As Long, ByVal prmlngHDc As Long) As Long
    
    Public Declare Function SelectObject Lib "gdi32.dll" (ByVal prmlngHDc As Long, ByVal hObject As Long) As Long
    
    Declare Auto Function BitBlt Lib "GDI32.DLL" (ByVal hdcDest As IntPtr, ByVal nXDest As Integer, _
     ByVal nYDest As Integer, ByVal nWidth As Integer, _
     ByVal nHeight As Integer, ByVal hdcSrc As IntPtr, _
     ByVal nXSrc As Integer, ByVal nYSrc As Integer, _
     ByVal dwRop As Int32) As Boolean
    
    Private Sub Savebtn_Click(sender As System.Object, e As System.EventArgs) Handles Savebtn.Click
    
        Dim hdc As IntPtr, hdcBmp As IntPtr, hBitmap As IntPtr
    
        hdc = GetDC(PictureBox1.Handle)
        hdcBmp = CType(CreateCompatibleDC(CInt(hdc)), IntPtr)
    
        ReleaseDC(PictureBox1.Handle, hdc)
    
        Dim hDCSource As IntPtr = GetDC(PictureBox1.Handle)
        Dim hDCDestination As IntPtr = CType(CreateCompatibleDC(CInt(hDCSource)), IntPtr)
        hBitmap = CType(CreateCompatibleBitmap(CInt(hDCSource), PictureBox1.Width - 8, PictureBox1.Height), IntPtr)
        Dim hPreviousBitmap As IntPtr = SelectObject(hDCDestination, hBitmap)
        BitBlt(hDCDestination, 0, 0, 800, 600, hDCSource, 0, 0, &HCC0020)
        Dim bitmap As Bitmap = bitmap.FromHbitmap(hBitmap)
    
        Dim path As String
        path = "d:\DSHR.bmp"
        Try
            bitmap.Save(path)
            Thread.Sleep(300)
        Catch exception As Exception
            MessageBox.Show(exception.Message, [Text], MessageBoxButtons.OK, MessageBoxIcon.Error)
        Finally
            bitmap.Dispose()
            MsgBox("Image saved: " + path)
        End Try
    End Sub
    
     
  • Peter_B

    Peter_B - 2013-05-29

    It might be because of this: ByVal hWnd As Long
    HWnd should be IntPtr, not Long

    Peter

     
  • MaTa

    MaTa - 2013-05-29

    Thanks a lot Peter
    it works.
    :)

     

Log in to post a comment.

Get latest updates about Open Source Projects, Conferences and News.

Sign up for the SourceForge newsletter:





No, thanks