CAPTURE IMAGE DARI WEBCAM TANPA OCX DI VISUAL BASIC 6.0

Salam kenal para blogger mania, aku baru dalam dunia blogger, namun dikesempatan ini saya juga mau berbagi untuk para master blog mania semua. Pada kesempatan ini, saya mau memposting tentang Visual Basic 6.0. Mungkin bagi sebagian orang, ini sudah kada luarsa, namun saya yakin masih ada yang mau belajar tentang VB. (Hehehe..) langsung aja ke TKP.

Seperti judul dari postingan ini, kita akan membuat sebuah form capture foto dari webcam laptop dan sejenisnya, tanpa OCX. kita langsung aja ke VBnya, dan buatlah sebuah form standard di VB, dan buatlah sebuah module dengan source-code sebagai berikut :

'KARENA AKAN DISIMPAN KE TABEL, JADI TAMBAHKAN INIPublic dt As New ADODB.ConnectionPublic tb As New ADODB.RecordsetPublic sementara As New ADODB.RecordsetPublic rsfoto As New Stream 'DEKLARASI NILAIPublic Const WS_CHILD As Long = &H40000000Public Const WS_VISIBLE As Long = &H10000000Public Const WM_USER As Long = &H400 'START AKTIVA KAMERAPublic Const WM_CAP_START As Long = WM_USERPublic Const WM_CAP_DRIVER_CONNECT As Long = WM_CAP_START + 10Public Const WM_CAP_DRIVER_DISCONNECT As Long = WM_CAP_START + 11Public Const WM_CAP_SET_PREVIEW As Long = WM_CAP_START + 50Public Const WM_CAP_SET_PREVIEWRATE As Long = WM_CAP_START + 52Public Const WM_CAP_DLG_VIDEOFORMAT As Long = WM_CAP_START + 41Public Const WM_CAP_FILE_SAVEDIB As Long = WM_CAP_START + 25 'CAPTURASAUN CLIBOARD WINDOWPublic 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 LongPublic Declare Function SendMessage Lib "user32" _Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long _, ByVal wParam As Long, ByRef lParam As Any) As Long Sub buka()dt.CursorLocation = adUseClientdt.Open ("Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\Database.mdb;Persist Security Info=False") End Sub

Buatlah sebuah form dengan design sebagai berikut, kalau ada yang mau membuatnya lengkap dengan beberapa field, silahkan aja.. karena disini saya hanya memakai 3 field pada contoh ini, namun sebelumnya, buat dulu sebuah database access dengan nama database: Database dan table diadalamnya bernama : Mahasisawa  dengan field sebagai berikut : Nim (text 8), nama (text 50) dan Foto(Object) . berikut desainnya :

Double klik pada formnya, dan ketikkan atau copas listing berikut :

Private Sub Command1_Click()camera.ShowEnd Sub
Private Sub simpan_Click()With tb.AddNew!nim = Text1.Text!nama = Text2.Text .Update.Requerysementara.Open ("select * from mahasiswa where nim='" & Text1 & "'"), dt, adOpenDynamic, adLockOptimisticsementara.Fields("foto").Value = rsfoto.Readsementara.Fields("nim").Value = Text1sementara.Updatesementara.CloseEnd WithEnd Sub
Private Sub Form_Load()rsfoto.Type = adTypeBinaryIf rsfoto.State = adStateOpen Thenrsfoto.Closersfoto.OpenElsersfoto.OpenEnd If
Call bukatb.Open ("mahasiswa"), dt, 1, 3Set DataGrid1.DataSource = tb
End Sub

Setelah selesai ketikkan Listingnya, sekarang kita membuat Form kedua, dimana form ini yang akan digunakan untuk menotret fotonya.

Setelah mendesain form tersebut diatas(Nama object-Objectnya, harus sama ya??). dan ketikan listing berikut :

Dim hCap As LongPrivate Sub cmd4_Click()Dim sFileName As StringCall SendMessage(hCap, WM_CAP_SET_PREVIEW, CLng(False), 0&)With CDialog.CancelError = True.Flags = cdlOFNPathMustExist Or cdlOFNOverwritePrompt.Filter = "JPEG Picture(*.jpg)|*.jpg|Bitmap Picture(*.bmp)|*.bmp|All Files|*.*".ShowSavesFileName = .FileNameEnd WithCall SendMessage(hCap, WM_CAP_FILE_SAVEDIB, 0&, ByVal CStr(sFileName))DoFinally:Call SendMessage(hCap, WM_CAP_SET_PREVIEW, CLng(True), 0&)
Dim temp As Longtemp = SendMessage(hCap, WM_CAP_DRIVER_DISCONNECT, 0&, 0&)If Len(sFileName) > 0 ThenForm2.CommonDialog1.FileName = sFileNamersfoto.LoadFromFile (sFileName)Form2.Image1.Picture = LoadPicture(sFileName)End If
Unload MeEnd SubPrivate Sub Cmd3_Click()Dim temp As Longtemp = SendMessage(hCap, WM_CAP_DRIVER_DISCONNECT, 0&, 0&)End SubPrivate Sub Cmd1_Click()hCap = capCreateCaptureWindow("Take a Camera Shot", WS_CHILD Or WS_VISIBLE, 0, 0, PicWebCam.Width, PicWebCam.Height, PicWebCam.hWnd, 0)If hCap <> 0 ThenCall SendMessage(hCap, WM_CAP_DRIVER_CONNECT, 0, 0)Call SendMessage(hCap, WM_CAP_SET_PREVIEWRATE, 66, 0&)Call SendMessage(hCap, WM_CAP_SET_PREVIEW, CLng(True), 0&)End IfEnd Sub
Private Sub Command1_Click()temp = SendMessage(hCap, WM_CAP_DRIVER_DISCONNECT, 0&, 0&)Unload Me
End Sub
Private Sub Form_Load()CMD1.Caption = "Koneksi Ke Camera"CMD4.Caption = "Ambil Gambar"End Sub

Sekarang semua sudah selesai, sekarang kita masuk pada langkah terakhir yaitu, Eksekusi alias running program. untuk menjalakan, tekan tombol F5. sekarang anda bisa menggunakan form ini untuk mengambil foto dari Webcam. mngkin ada teman-teman yang sudah samapai pada crop gambar yang dipotre, aku tunggu link updatenya..

Semoga membantu.