Membuat Software Security Camera dengan VB6

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

Web_Cam_Scurity.rar

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

Security_Camera.exe

http://rapidshare.com/files/364489862/Security_Camera.exe

Size: 1695 KB Downloads: 23 Status: File available Last Download: 17.04.2010 10:13:35