MENAMPILKAN GAMBAR DARI WEBCAM (VB DOT NET 2010) lengkap dengan contoh run aplikasinya

Salah satu cara UNTUK menampilkan video atau gambar pada vb_dot_net 2010 yang saodara dan saoudari perlukan adalah :

•  Mendeklarasikan lagi fungsi dari class yang  terdapat pada  library windows agar pengkodingan jadi lebih  sederhana calsss tersebut adalah :

1. Setwindowspos : memfasilitasi gambar pada saat tampil di windows
2. capCreateCaptureWindowA  : memfasilitasi pengambilan data gambar pada device
3. capGetDriverDescriptionA : menghubungkan device dan aplikasi melalui driver yang sudah ada pada system windows.

• Selanjutnya Membuat desain form aplikasi seperti gambar dibawah ini : 

form diatas terdiri dari :
-3 control button
-1 buah textbox untuk melihat device webcam yang tersambung
-1 picturebox

• KOde yang di kodekan adalah sebagai berikut :

Imports System.Runtime.InteropServices
Imports System.Drawing
Imports System.Drawing.Drawing2D
Imports System.Windows.Forms
Public Class Form1
    Const WM_CAP As Short = &H400S
    Const WM_CAP_DRIVER_CONNECT As Integer = WM_CAP + 10
    Const WM_CAP_DRIVER_DISCONNECT As Integer = WM_CAP + 11
    Const WM_CAP_EDIT_COPY As Integer = WM_CAP + 30
    Const WM_CAP_SET_PREVIEW As Integer = WM_CAP + 50
    Const WM_CAP_SET_PREVIEWRATE As Integer = WM_CAP + 52
    Const WM_CAP_SET_SCALE As Integer = WM_CAP + 53
    Const WS_CHILD As Integer = &H40000000
    Const WS_VISIBLE As Integer = &H10000000
    Const SWP_NOMOVE As Short = &H2S
    Const SWP_NOSIZE As Short = 1
    Const SWP_NOZORDER As Short = &H4S
    Const HWND_BOTTOM As Short = 1
    Dim iDevice As Integer = 0
    Dim hHwnd As Integer

    Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, <MarshalAs(UnmanagedType.AsAny)> ByVal lParam As Object) As Integer
    ' Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, 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
    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 hWndParent As Integer, ByVal nID As Integer) As Integer
    Declare Function capGetDriverDescriptionA Lib "avicap32.dll" (ByVal wDriver As Short, ByVal lpszName As String, ByVal cbName As Integer, ByVal lpszVer As String, ByVal cbVer As Integer) As Boolean
   
 '---fariable lokal-------------------------------------------
    Private Sub LoadDeviceList()
        Dim strName As String = Space(100)
        Dim strVer As String = Space(100)
        Dim bReturn As Boolean
        Dim x As Integer = 0
        Do
            bReturn = capGetDriverDescriptionA(x, strName, 100, strVer, 100)
            If bReturn Then lstdevices.Items.Add(strName.Trim)
            x += 1
        Loop Until bReturn = False
    End Sub

    Private Sub OpenPreviewWindow()
        Dim iHeight As Integer = piccapture.Height
        Dim iWidth As Integer = piccapture.Width
        hHwnd = capCreateCaptureWindowA(iDevice, WS_VISIBLE Or WS_CHILD, 0, 0, 640, 480, piccapture.Handle.ToInt32, 0)
        If SendMessage(hHwnd, WM_CAP_DRIVER_CONNECT, iDevice, 0) Then
            SendMessage(hHwnd, WM_CAP_SET_SCALE, True, 0)
            SendMessage(hHwnd, WM_CAP_SET_PREVIEWRATE, 66, 0)
            SendMessage(hHwnd, WM_CAP_SET_PREVIEW, True, 0)
            SetWindowPos(hHwnd, HWND_BOTTOM, 0, 0, piccapture.Width, piccapture.Height, SWP_NOMOVE Or SWP_NOZORDER)
            'btnSave.Enabled = True
            btnstop.Enabled = True
            'btnStart.Enabled = False
        Else
            DestroyWindow(hHwnd)
            btnsave.Enabled = False
        End If
    End Sub

    Private Sub ClosePreviewWindow()
        SendMessage(hHwnd, WM_CAP_DRIVER_DISCONNECT, iDevice, 0)
        DestroyWindow(hHwnd)
    End Sub

    Private Sub Button1_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles btnsave.Click
        Dim data As IDataObject
        Dim bmap As Image
        bmap = Nothing
        SendMessage(hHwnd, WM_CAP_EDIT_COPY, 0, 0)
        data = Clipboard.GetDataObject()
        If data.GetDataPresent(GetType(System.Drawing.Bitmap)) = True Then
            bmap = CType(data.GetData(GetType(System.Drawing.Bitmap)), Image)
            piccapture.Image = bmap
        End If
    End Sub



    Private Sub btnstop_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnstop.Click
        SendMessage(hHwnd, WM_CAP_DRIVER_DISCONNECT, iDevice, 0)
        ' DestroyWindow(hHwnd)
        btnstart.Enabled = True
        btnstop.Enabled = False
        btnsave.Enabled = False
    End Sub

    Private Sub btnstart_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnstart.Click

        LoadDeviceList()
        OpenPreviewWindow()
        btnstop.Enabled = True
        btnsave.Enabled = True
    End Sub

    Private Sub garis_nama()
        '' garis
        Dim bit As Bitmap = New Bitmap(piccapture.Image)
        Dim g As Graphics = Graphics.FromImage(bit)
        Dim mypen As Pen = New Pen(Color.Blue, 3)
        g.DrawLine(mypen, 100, 50, 100, 100) 'garis1
        g.DrawString(" MUCHLIS", New Font("arial", 12), Brushes.Blue, New PointF(20, 25))
        piccapture.Image = bit


    End Sub


    Private Sub Button1_Click_1(ByVal sender As System.Object, ByVal e As System.EventArgs)
        garis_nama()
        Timer1.Enabled = True
    End Sub

    Private Sub Form1_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
        btnstop.Enabled = False
    End Sub

   
    Private Sub Timer1_Tick(ByVal sender As Object, ByVal e As System.EventArgs) Handles Timer1.Tick
        garis_nama()
    End Sub
End Class

• hasil run

DOWNLOAD APLIKASI MENTAHNYA