Aplikasi Scurity Camera CCTV bisa dengan mudah kita dapatkan di internet dengan nama yang bermacam-macam diantaranya Catch It!, Cam Wizard dan lain-lain. Tapi sayangnya software tersebut tidaklah gratis. Oleh karena itu saya mencoba membuat software yang diberi nama Camera Scurity. Tidak seperti CCTV yang merekam keseluruhan, software ini hanya merekam bila hanya ada gerakan saja, tanpa gerakan perekaman secara otomatis berhenti. Dengan kata lain Software ini cara kerjanya mirip dengan kamera yang terpasang di ATM, yang hanya merekam bila terjadi pergerakan. Saya mencoba membuat software ini menggunakan VB6
Gambar sebelah kiri adalah tampilan pada saat perekaman, sedangkan gambar sebelah kanan adalah hasil perekaman
Cara Kerja :
- START, berfungsi untuk mulai mengaktipkan kamera, bila Record di ceklist, maka akan merekam bilamana ada gerakan, bila Sound di ceklist, maka alarm akan bunyi bila terjadi gerakan yang ditangkap oleh web cam. Bila tombol START di klik maka akan berubah menjadi STOP yang berfungsi untuk menghentikan perekaman
- Reply, berfungsi untuk memutar ulang hasil perekaman. Bila tombol Reply ini di klik akan berubah menjadi Stop yang berfungsi untuk menghentikan pemutaran rekaman
- Clear, berfungsi untuk menghapus seluruh rekaman, hasil capture web cam sebenarnya tidak berupa file video melainkan file picture (BMP) dengan format nama yyMMddhhmmss.bmp sehingga bila terjadi sesuatu bisa langsung dicetak.
[caption id="attachment_95786" align="aligncenter" width="500" caption="Hasil Capture Web Cam"][/caption]
Software bisa didownload secara gratis DISINI dengan ukuran file sekitar 1692 KB
atau bisa dipelajari Source Code nya, yang bisa di download DISINI Yang isinya seperti di bawah ini
Catatan :
Kualitas gambar sangat tergantung dari kualitas web cam nya
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
Option Explicit
Private Declare Function sndPlaySound Lib "winmm" Alias "sndPlaySoundA" (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long
Public Sub PlaySound(strFileName As String)
sndPlaySound strFileName, 1
End Sub
Private Sub Command1_Click()
If Command1.Caption = "START" Then
Command1.Caption = "STOP"
STARTCAM
Else
Command1.Caption = "START"
STOPCAM
End If
End Sub
Private Sub Command2_Click()
File1.Refresh
Dim i As Integer
For i = 0 To File1.ListCount - 1
Text4.Text = File1.List(i)
Picture4.Picture = LoadPicture(App.Path & "" & Text4.Text)
Next i
End Sub
Private Sub Command3_Click()
If Command3.Caption = "Reply" Then
Command3.Caption = "Stop"
Timer2.Enabled = True
Else
Command3.Caption = "Reply"
Timer2.Enabled = False
End If
End Sub
Private Sub Command4_Click()
On Error Resume Next
Dim i As Integer
For i = 0 To File1.ListCount - 1
Kill App.Path & "" & File1.List(i)
Next i
End Sub
Private Sub Command5_Click()
Me.WindowState = 1
End Sub
Private Sub Form_Load()
Picture1.Width = 640 * Screen.TwipsPerPixelX
Picture1.Height = 480 * Screen.TwipsPerPixelY
inten = 15
Tolerance = 20
Tppx = Screen.TwipsPerPixelX
Tppy = Screen.TwipsPerPixelY
ReDim POn(640 / inten, 480 / inten)
ReDim P(640 / inten, 480 / inten)
File1.Path = App.Path
Me.Top = (Info.WorkAreaHeight - Me.Height) / 2
Me.Left = (Info.WorkAreaWidth - Me.Width) / 2
End Sub
Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then
STARTCAM
ElseIf Button = 2 Then
STOPCAM
End If
End Sub
Private Sub Text5_Change()
Dim tanggal, bulan, tahun, jam, menit, detik As String
On Error Resume Next
tahun = Left(File1.List(Text5.Text), 4)
bulan = Mid(File1.List(Text5.Text), 5, 2)
tanggal = Mid(File1.List(Text5.Text), 7, 2)
jam = Mid(File1.List(Text5.Text), 9, 2)
menit = Mid(File1.List(Text5.Text), 11, 2)
detik = Mid(File1.List(Text5.Text), 13, 2)
Label2.Caption = jam & ":" & menit & ":" & detik & "" & tanggal & "-" & bulan & "-" & tahun
Label2.Refresh
Image1.Picture = LoadPicture(App.Path & "" & File1.List(Text5.Text))
End Sub
Private Sub Timer1_Timer()
'Get the picture from camera.. the main part
SendMessage mCapHwnd, GET_FRAME, 0, 0
SendMessage mCapHwnd, COPY, 0, 0
Picture1.Picture = Clipboard.GetData
Picture3.Picture = Picture1.Picture
Clipboard.Clear
Ri = 0 'right
Wo = 0 'wrong
Text1.Text = Format(Date, "dd-MM-yyyy") & " " & Format(Time, "hh:mm:ss")
Text3.Text = Format(Date, "yyyyMMdd") & Format(Time, "hhmmss")
Picture1.CurrentX = 10
Picture1.CurrentY = 10
Picture1.Print Text1.Text
LastTime = GetTickCount
For i = 0 To 640 / inten - 1
For j = 0 To 480 / 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 640 / inten - 2
For j = 1 To 480 / 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
Label1.Caption = Int(Wo / (Ri + Wo) * 100) & " % movement" & vbCrLf & "Real Movement: " & RealRi & vbCrLf _
& "Completed in: " & GetTickCount - LastTime
Text2.Text = Int(Wo / (Ri + Wo) * 100)
If Val(Text2.Text) > 1 Then
If Check1.Value = 1 Then
SavePicture Picture3.Image, App.Path & "" & Text3.Text & ".bmp"
End If
If Check2.Value = 1 Then
PlaySound App.Path & "alarm.wav"
End If
End If
End Sub
Sub STOPCAM()
DoEvents: SendMessage mCapHwnd, DISCONNECT, 0, 0
Timer1.Enabled = False
End Sub
Sub STARTCAM()
mCapHwnd = capCreateCaptureWindow("WebcamCapture", 0, 0, 0, 640, 480, Me.hwnd, 0)
DoEvents
SendMessage mCapHwnd, CONNECT, 0, 0
Timer1.Enabled = True
End Sub
Private Sub Timer2_Timer()
File1.Refresh
Text5.Text = Val(Text5.Text) + 1
If Val(Text5.Text) > (File1.ListCount - 2) Then Text5.Text = 0
End Sub
http://rapidshare.com/files/364490398/Web_Cam_Scurity.rar
Size: 34 KB Downloads: 21 Status: File available Last Download: 16.04.2010 20:37:55
http://rapidshare.com/files/364489862/Security_Camera.exe
Size: 1695 KB Downloads: 23 Status: File available Last Download: 17.04.2010 10:13:35