Capture Webcam dengan VB
Kemaren saya ditanya ama Pak Zul yang punya kampus.. nanya soal gimana cara capture foto pake webcam, kayak kita bikin SIM ato KTP.... jadi langsung di capture lewat vb..
Oke, ni saya dah dapet... ^_^
Semoga bisa buat nambah2 pengetahuan kita semua juga .. codenya simple banget kok. Cuman ngandelin fungsi dalam Windows API, tanpa perlu nambahin komponen/activex laen..
Bagi yang bingung apaan tuh windows API.. hehe ntar kita bahas dehh kapan kapan.. Ga usah dibikin pusing dulu ama codenya coz itu emang udah bawaan dari sononya (Windows APInya) yang kita lakukan cuman modif aja.. dalam program kita nantinya.
Oke berikut ini kodenya.. silahkan dicopy ke VB.
Tapi sebelumnya siapkan pula 2 buah Command Button ama 1 Picture Box yaa..
Private Declare Function SendMessage Lib "USER32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function capCreateCaptureWindow Lib "avicap32.dll" Alias "capCreateCaptureWindowA" (ByVal lpszWindowName As String, ByVal dwStyle As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hwndParent As Long, ByVal nID As Long) As Long
Private mCapHwnd As Long
Private Const CONNECT As Long = 1034
Private Const DISCONNECT As Long = 1035
Private Const GET_FRAME As Long = 1084
Private Const COPY As Long = 1054
Dim continue As Boolean
Sub STOPCAM()
DoEvents
SendMessage mCapHwnd, DISCONNECT, 0, 0
End Sub
Sub STARTCAM()
mCapHwnd = capCreateCaptureWindow("WebcamCapture", 0, 0, 0, 640, 480, Me.hwnd, 0)
DoEvents
SendMessage mCapHwnd, CONNECT, 0, 0
End Sub
Private Sub Command1_Click()
SendMessage mCapHwnd, GET_FRAME, 0, 0
SendMessage mCapHwnd, COPY, 0, 0
Picture1.Picture = Clipboard.GetData
SavePicture Picture1.Image, "C:\picture.jpg"
End Sub
Private Sub Command2_Click()
Unload Me
End Sub
Private Sub Form_Activate()
STARTCAM
continue = True
Do While continue
SendMessage mCapHwnd, GET_FRAME, 0, 0
SendMessage mCapHwnd, COPY, 0, 0
Picture1.Picture = Clipboard.GetData
DoEvents
End Sub
Private Sub Form_Unload(Cancel As Integer)
If continue Then
continue = False
STOPCAM
End If
End Sub
0 komentar:
Posting Komentar