Mengambil Foto dari Webcam Dengan Aplikasi Visual Basic 6

Untuk mengambil foto langsung dari webcam membutuhkan "avicap32.dll" dari library windows. dalam kondisi tertentu langsung jalan webcamnya dan ada juga yang harus menentukan webcam yang akan dipakai. 

project kali ini memakai image untuk menampung gambar, beberapa command button, satu buah timer, dan satu command dialog untuk menyimpan hasil foto.

untuk pemakainya mudah tinggal klik mulai untuk menjalankan programnya, klik simpan untuk menyimpan hasil fotonya (memakai command dialog), stop untuk menonaktifkan webcam, dan exit untuk keluar dari program.

 

Listingnya adalah sebagai berikut:

 Private Sub Command1_Click(Index As Integer)
    Select Case Index
        Case 0  'mulai
            Me.Label1.Visible = False
            webcam_mulai
            working
        Case 1  'simpan
            Dim nama, nm As String
            Dim p As Integer
            Me.CoDog1.DialogTitle = "Simpan Gambar"
            Me.CoDog1.Filter = "JPG|*.jpg"
            Me.CoDog1.FileName = ""
            Me.CoDog1.ShowSave
            If Me.CoDog1.FileName <> "" Then
                nama = Me.CoDog1.FileName
                p = Len(nama)
                nm = Right(nama, p - 3)
                SavePicture Me.Image1.Picture, nm
                MsgBox "Di simpan", vbInformation, "SAVE"
            End If
            Exit Sub
        Case 2  'stop
            Me.Label1.Visible = True
            webcam_stop
            awal
        Case 3  'exit
            Unload Me
    End Select
End Sub
Private Sub Form_Load()
    'posisi form
    Me.Top = (Screen.Height - Me.Height) / 2
    Me.Left = (Screen.Width - Me.Width) / 2
    'tombol
    awal
    'image stretch
    Me.Image1.Stretch = True
End Sub
Sub webcam_mulai()
    mCapHwnd = capCreateCaptureWindow("WebcamCapture", 0, 0, 0, 640, 480, Me.hWnd, 0)
    DoEvents
    SendMessage mCapHwnd, HUBUNG, 0, 0
End Sub
Sub webcam_stop()
    DoEvents: SendMessage mCapHwnd, PUTUS, 0, 0
End Sub
Private Sub Timer1_Timer()
    SendMessage mCapHwnd, AMBIL_FRAME, 0, 0
    SendMessage mCapHwnd, Copy, 0, 0
    Me.Image1.Picture = Clipboard.GetData
    Clipboard.Clear
End Sub
Sub awal()
    Me.Command1(0).Enabled = True   'mulai
    Me.Command1(1).Enabled = False  'simpan
    Me.Command1(2).Enabled = True   'stop
    Me.Command1(3).Enabled = True   'exit
End Sub
Sub working()
    Me.Command1(0).Enabled = True   'mulai
    Me.Command1(1).Enabled = True   'simpan
    Me.Command1(2).Enabled = True   'stop
    Me.Command1(3).Enabled = True   'exit
End Sub

Catatan : 

Tombol CommandButtonya nama nya command1 semua dan harus di beri index,, Dengan ketentuan Index 0 untuk tombol Mulai dan seterusnya.

untuk program jadinya silahkan download disini..https://www.box.com/s/yytpdf4jlaxzsbg6l04l