VB.NET :: Menampilkan Web Camera dengan VB.NET (Pemrograman Visual Basic .NET)

Pertama buka Visual Studio 2008, kemudian Create VB.NET Project. Pada Form1 Tambahkan ListBox1 dan PictureBox1 sehingga tampak sebagai berikut :

Buka Source Code, tambahkan deklarasi berikut : (Untuk memanggil fungsi-fungsi Windows API yang dibutuhkan)

Imports System.Runtime.InteropServices


Public Class Form1


    Const WM_CAP_START = &H400S
    Const WS_CHILD = &H40000000
    Const WS_VISIBLE = &H10000000


    Const WM_CAP_DRIVER_CONNECT = WM_CAP_START + 10
    Const WM_CAP_DRIVER_DISCONNECT = WM_CAP_START + 11
    Const WM_CAP_EDIT_COPY = WM_CAP_START + 30
    Const WM_CAP_SEQUENCE = WM_CAP_START + 62
    Const WM_CAP_FILE_SAVEAS = WM_CAP_START + 23


    Const WM_CAP_SET_SCALE = WM_CAP_START + 53
    Const WM_CAP_SET_PREVIEWRATE = WM_CAP_START + 52
    Const WM_CAP_SET_PREVIEW = WM_CAP_START + 50


    Const SWP_NOMOVE = &H2S
    Const SWP_NOSIZE = 1
    Const SWP_NOZORDER = &H4S
    Const HWND_BOTTOM = 1


    Declare Function capGetDriverDescriptionA Lib "avicap32.dll" _
       (ByVal wDriverIndex As Short, _
        ByVal lpszName As String, ByVal cbName As Integer, ByVal lpszVer As String, _
        ByVal cbVer As Integer) As Boolean


    Declare Function capCreateCaptureWindowA Lib "avicap32.dll" _
       (ByVal lpszWindowName As String, ByVal dwStyle As Integer, _
        ByVal x As Integer, ByVal y As Integer, ByVal nWidth As Integer, _
        ByVal nHeight As Short, ByVal hWnd As Integer, _
        ByVal nID As Integer) As Integer


    Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
       (ByVal hwnd As Integer, ByVal Msg As Integer, ByVal wParam As Integer, _
       <MarshalAs(UnmanagedType.AsAny)> ByVal lParam As Object) As Integer


    Declare Function SetWindowPos Lib "user32" Alias "SetWindowPos" _
       (ByVal hwnd As Integer, _
        ByVal hWndInsertAfter As Integer, ByVal x As Integer, ByVal y As Integer, _
        ByVal cx As Integer, ByVal cy As Integer, ByVal wFlags As Integer) As Integer


    Declare Function DestroyWindow Lib "user32" (ByVal hndw As Integer) As Boolean


    Dim VideoSource As Integer
    Dim hWnd As Integer

Kemudian klik dua kali pada Form tambahkan kode program berikut ini (untuk menampilkan daftar webcam yang tersedia sehingga bisa dipilih) :

Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        Dim DriverName As String = Space(80)
        Dim DriverVersion As String = Space(80)
        For i As Integer = 0 To 9
            If capGetDriverDescriptionA(i, DriverName, 80, DriverVersion, 80) Then
                ListBox1.Items.Add(DriverName.Trim)
            End If
        Next
    End Sub

Kemudian klik dua kali pada ListBox1 tambahkan kode program berikut ini (untuk mulai menyalakan Kamera dan menampilkannya di PictureBox1) :

Private Sub ListBox1_SelectedIndexChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ListBox1.SelectedIndexChanged
        SendMessage(hWnd, WM_CAP_DRIVER_DISCONNECT, VideoSource, 0)
        DestroyWindow(hWnd)


        VideoSource = ListBox1.SelectedIndex


        hWnd = capCreateCaptureWindowA(VideoSource, WS_VISIBLE Or WS_CHILD, 0, 0, 0, _
            0, PictureBox1.Handle.ToInt32, 0)
        If SendMessage(hWnd, WM_CAP_DRIVER_CONNECT, VideoSource, 0) Then


            SendMessage(hWnd, WM_CAP_SET_SCALE, True, 0)


            SendMessage(hWnd, WM_CAP_SET_PREVIEWRATE, 30, 0)


            SendMessage(hWnd, WM_CAP_SET_PREVIEW, True, 0)


            SetWindowPos(hWnd, HWND_BOTTOM, 0, 0, _
               PictureBox1.Width, PictureBox1.Height, _
               SWP_NOMOVE Or SWP_NOZORDER)
        Else


            DestroyWindow(hWnd)
        End If
    End Sub

Source Code selengkapnya :

Imports System.Runtime.InteropServices

Public Class Form1


    Const WM_CAP_START = &H400S
    Const WS_CHILD = &H40000000
    Const WS_VISIBLE = &H10000000


    Const WM_CAP_DRIVER_CONNECT = WM_CAP_START + 10
    Const WM_CAP_DRIVER_DISCONNECT = WM_CAP_START + 11
    Const WM_CAP_EDIT_COPY = WM_CAP_START + 30
    Const WM_CAP_SEQUENCE = WM_CAP_START + 62
    Const WM_CAP_FILE_SAVEAS = WM_CAP_START + 23


    Const WM_CAP_SET_SCALE = WM_CAP_START + 53
    Const WM_CAP_SET_PREVIEWRATE = WM_CAP_START + 52
    Const WM_CAP_SET_PREVIEW = WM_CAP_START + 50


    Const SWP_NOMOVE = &H2S
    Const SWP_NOSIZE = 1
    Const SWP_NOZORDER = &H4S
    Const HWND_BOTTOM = 1


    Declare Function capGetDriverDescriptionA Lib "avicap32.dll" _
       (ByVal wDriverIndex As Short, _
        ByVal lpszName As String, ByVal cbName As Integer, ByVal lpszVer As String, _
        ByVal cbVer As Integer) As Boolean


    Declare Function capCreateCaptureWindowA Lib "avicap32.dll" _
       (ByVal lpszWindowName As String, ByVal dwStyle As Integer, _
        ByVal x As Integer, ByVal y As Integer, ByVal nWidth As Integer, _
        ByVal nHeight As Short, ByVal hWnd As Integer, _
        ByVal nID As Integer) As Integer


    Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
       (ByVal hwnd As Integer, ByVal Msg As Integer, ByVal wParam As Integer, _
       <MarshalAs(UnmanagedType.AsAny)> ByVal lParam As Object) As Integer


    Declare Function SetWindowPos Lib "user32" Alias "SetWindowPos" _
       (ByVal hwnd As Integer, _
        ByVal hWndInsertAfter As Integer, ByVal x As Integer, ByVal y As Integer, _
        ByVal cx As Integer, ByVal cy As Integer, ByVal wFlags As Integer) As Integer


    Declare Function DestroyWindow Lib "user32" (ByVal hndw As Integer) As Boolean


    Dim VideoSource As Integer
    Dim hWnd As Integer


    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        Dim DriverName As String = Space(80)
        Dim DriverVersion As String = Space(80)
        For i As Integer = 0 To 9
            If capGetDriverDescriptionA(i, DriverName, 80, DriverVersion, 80) Then
                ListBox1.Items.Add(DriverName.Trim)
            End If
        Next
    End Sub


    Private Sub ListBox1_SelectedIndexChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ListBox1.SelectedIndexChanged
        SendMessage(hWnd, WM_CAP_DRIVER_DISCONNECT, VideoSource, 0)
        DestroyWindow(hWnd)


        VideoSource = ListBox1.SelectedIndex


        hWnd = capCreateCaptureWindowA(VideoSource, WS_VISIBLE Or WS_CHILD, 0, 0, 0, _
            0, PictureBox1.Handle.ToInt32, 0)
        If SendMessage(hWnd, WM_CAP_DRIVER_CONNECT, VideoSource, 0) Then


            SendMessage(hWnd, WM_CAP_SET_SCALE, True, 0)


            SendMessage(hWnd, WM_CAP_SET_PREVIEWRATE, 30, 0)


            SendMessage(hWnd, WM_CAP_SET_PREVIEW, True, 0)


            SetWindowPos(hWnd, HWND_BOTTOM, 0, 0, _
               PictureBox1.Width, PictureBox1.Height, _
               SWP_NOMOVE Or SWP_NOZORDER)
        Else


            DestroyWindow(hWnd)
        End If
    End Sub
End Class

Jika dijalankan Hasilnya :

Semoga berguna

Kode program dapat didownload disini (Setelah tampil di Google Docs, Untuk mendownload klik File-Download.)

Selanjutnya penulis akan sharing tentang aplikasi yang bisa Capture Foto dari WebCam dan berikutnya bisa Recording Video dari Kamera sehingga menjadi file Movie.