untuk para master vb6 mohon koreksi jikalau newbe ada salah dalam menjelaskan atau artikel ini ada yang menyimpang. yuk langsung aja disiapkan formnya seperti dibawah ini.
selanjutnya buka jendela code mulai ketikkan barisan code seperti dibawah ini..
untuk baris code dibawah ini letakkan pada "general "
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
'declarations
Dim P() As Long
Dim POn() As Boolean
Dim inten As Integer
Dim i As Integer, j As Integer
Dim Ri As Long, Wo As Long
Dim RealRi As Long
Dim c As Long, c2 As Long
Dim R As Integer, G As Integer, b As Integer
Dim R2 As Integer, G2 As Integer, B2 As Integer
Dim Tppx As Single, Tppy As Single
Dim Tolerance As Integer
Dim RealMov As Integer
Dim Counter As Integer
Private Declare Function GetTickCount Lib "kernel32" () As Long
Dim LastTime As Long
' sampai sini batas code general ( script diatas adalah API code CMIIW)
Private Sub Command1_Click() ' tombol hidupkan kamera
mCapHwnd = capCreateCaptureWindow("WebcamCapture", 0, 0, 0, 400, 300, Me.hwnd, 0)
DoEvents
SendMessage mCapHwnd, CONNECT, 0, 0
Timer3.Enabled = True
End Sub
Private Sub Command2_Click() ' tombol capture
SavePicture Picture3.Image, App.Path + "\hasilgambar\" & Text1.Text & ".jpg"
dtcamera.Recordset.Edit
dtcamera.Recordset.Fields(0) = dtcamera.Recordset.Fields(0) + 1
dtcamera.Recordset.Update
dthasilgambar.Recordset.AddNew
dthasilgambar.Recordset.Fields(0) = Text1.Text
dthasilgambar.Recordset.Update
Command3_Click
On Error Resume Next
Picture2.Picture = LoadPicture(App.Path + "\hasilgambar\" & Text3.Text & ".jpg")
Exit Sub
End Sub
Private Sub Command3_Click() ' tombol otomatis no
Dim no As Integer
Dim Nmr, Nmrx, Nomor, Nomorx, thn As String
thn = Format(Date, "DDMMYY")
no = dtcamera.Recordset.Fields(0)
Nmr = LTrim$(Str$(no))
Nomor = "CN" + thn + String$(3 - Len(Nmr), "0") + Nmr
Text1.Text = Nomor
'Text2.Text = 0
Dim total As Integer
On Error Resume Next
total = dthasilgambar.Recordset.RecordCount
If total > 0 Then
dthasilgambar.Refresh
dthasilgambar.Recordset.MoveLast
Text3.Text = dthasilgambar.Recordset.Fields(0)
Else
Exit Sub
Text3.Text = ""
End If
End Sub
Private Sub Command4_Click() 'tombol mulai menganalisis
Timer1.Enabled = True
Timer2.Enabled = True
End Sub
Private Sub Command5_Click() 'tombol keluar
DoEvents: SendMessage mCapHwnd, DISCONNECT, 0, 0
Timer1.Enabled = False
Timer2.Enabled = False
Timer3.Enabled = False
End
End Sub
Private Sub Form_Activate()
Timer1.Enabled = False
Timer2.Enabled = False
Timer3.Enabled = False
End Sub
Private Sub Form_Load()
Picture1.Width = 400 * Screen.TwipsPerPixelX
Picture1.Height = 300 * Screen.TwipsPerPixelY
Picture2.Width = 400 * Screen.TwipsPerPixelX
Picture2.Height = 300 * Screen.TwipsPerPixelY
Picture3.Width = 400 * Screen.TwipsPerPixelX
Picture3.Height = 300 * Screen.TwipsPerPixelY
inten = 15 'tadinya 15
Tolerance = 20 'kepekaan tadinya 20
Tppx = Screen.TwipsPerPixelX
Tppy = Screen.TwipsPerPixelY
ReDim POn(400 / inten, 300 / inten)
ReDim P(400 / inten, 300 / inten)
dtcamera.DatabaseName = App.Path & "\database\programkamera.mdb"
dtcamera.RecordSource = "nourut"
dtcamera.Refresh
dtcamera.EOFAction = AddNew
dtcamera.RecordsetType = 0
dthasilgambar.DatabaseName = App.Path & "\database\programkamera.mdb"
dthasilgambar.RecordSource = "hasilgambar"
dthasilgambar.Refresh
dthasilgambar.EOFAction = AddNew
dthasilgambar.RecordsetType = 0
End Sub
Private Sub Timer1_Timer()
Ri = 0 'right
Wo = 0 'wrong
Picture1.CurrentX = 10
Picture1.CurrentY = 10
LastTime = GetTickCount
For i = 0 To 400 / inten - 1
For j = 0 To 300 / inten - 1
c = Picture1.Point(i * inten * Tppx, j * inten * Tppy)
R = c Mod 256
G = (c \ 256) Mod 256
b = (c \ 256 \ 256) Mod 256
c2 = P(i, j)
R2 = c2 Mod 256
G2 = (c2 \ 256) Mod 256
B2 = (c2 \ 256 \ 256) Mod 256
If Abs(R - R2) < Tolerance And Abs(G - G2) < Tolerance And Abs(b - B2) < Tolerance Then
Ri = Ri + 1
POn(i, j) = True
Else
Wo = Wo + 1
P(i, j) = Picture1.Point(i * inten * Tppx, j * inten * Tppy)
Picture1.PSet (i * inten * Tppx, j * inten * Tppy), vbRed
POn(i, j) = False
End If
Next j
Next i
RealRi = 0
For i = 1 To 400 / inten - 2
For j = 1 To 300 / inten - 2
If POn(i, j) = False Then
If POn(i, j + 1) = False Then
If POn(i, j - 1) = False Then
If POn(i + 1, j) = False Then
If POn(i - 1, j) = False Then
RealRi = RealRi + 1
Picture1.PSet (i * inten * Tppx, j * inten * Tppy), vbGreen
End If
End If
End If
End If
End If
Next j
Next i
If Picture1.Picture = 0 Then
Text2.Text = 0
ElseIf Not Picture1.Picture = 0 Then
Label1.Caption = Int(Wo / (Ri + Wo) * 100) & " % movement" & vbCrLf & "Real Movement: " & RealRi & vbCrLf _
& "Completed in: " & GetTickCount - LastTime
Text2.Text = Int(Wo / (Ri + Wo) * 100)
End If
End Sub
Private Sub Timer2_Timer()
Dim nilai As Integer
nilai = Text2.Text
If Picture1.Picture = 0 Then
Label2.Visible = False
Label2.Caption = ""
ElseIf Not Picture1.Picture = 0 Then
Command3_Click
If nilai > 30 Then
Label2.Visible = True
Label2.Caption = "ADA PERGERAKAN YANG MENCURIGAKAN"
Command2_Click
ElseIf nilai <= 30 Then
Label2.Visible = False
Label2.Caption = "'"
End If
End If
End Sub
Private Sub Timer3_Timer()
SendMessage mCapHwnd, GET_FRAME, 0, 0
SendMessage mCapHwnd, COPY, 0, 0
Picture1.Picture = Clipboard.GetData
Picture3.Picture = Picture1.Picture
Clipboard.Clear
End Sub
Langkah selanjutnya buat database dengan nama programkamera.mdb (ms access)
dengan duabuah tabel seperti gambar dibawah ini
tabel 2 ==> nourut dengan nama field ==> no (text 50)
untuk nama database,tabel dan nama field dapat anda sesuaikan sendiri
letakkan atau atur folder sesuai dengan gambar dibawah ini
letakkan file database pada folder database, dan nanti hasil capture camera akan diletakkan di folder hasilgambar.
setelah semua dilakukan jangan lupa untuk merapikan form sehingga tampilan seperti dibawah ini
selamat mencoba
jika ada kesalahan dalam artikel ini newbe mohon maaf dan butuh masukan ..
salam "Maju Terus Deveoper Indonesia"
0 comments:
Post a Comment