Kolay gelsin. Webcam hareket algılama kodu var; fakat nasıl mouse hareket ettirebilirim onu cozemedim. Orneğin picture1 i 2 ye ayıralım. ortasından solda kalan kısımda hareketlenme daha coksa mouse sola gitsin, sağda varsa sağa gitsin gibi birşey olabilir mi? Yardımlarınızı bekliyorum. Hareket algılama kodu;
'Hareket algılayan webcam
'visual basic 6 denendi form1 code kısmı boş olacak kodları kopyala yapıştır
'Picturebox = Picture1 formun uzerine genişletin PROPERTİES DE ,DRAwWidth =3 olsun
'label iki tane aynı kalsın isimler
'time1 = isim aynı kal. Interval =50 olacak
Not benim web camera kuruludu
'Burayı form1 code ye yapıştır
'For WEBCAM DECLARATIONS
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 Sub Form_Load()
'cerceve boyutu
Picture1.Width = 640 * Screen.TwipsPerPixelX
Picture1.Height = 480 * Screen.TwipsPerPixelY
'Inten kac pixel işleneceğini tutar. Bu sayıyı yuksek tutmayın
'P 3.0 GHz PC de bile tekleme yapabiliyor
'Her 15nci pixel kontrol edilecek:
inten = 15
'Pixel değişikliğini kontrol etme toleransı
Tolerance = 20
Tppx = Screen.TwipsPerPixelX
Tppy = Screen.TwipsPerPixelY
ReDim POn(640 / inten, 480 / inten)
ReDim P(640 / inten, 480 / inten)
STARTCAM
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 Timer1_Timer()
'Ana bolum burası. Kameradan resim alı:
SendMessage mCapHwnd, GET_FRAME, 0, 0
SendMessage mCapHwnd, COPY, 0, 0
Picture1.Picture = Clipboard.GetData
Clipboard.Clear
Ri = 0 'Doğru
Wo = 0 'yanlış
LastTime = GetTickCount
For i = 0 To 640 / inten - 1
For j = 0 To 480 / inten - 1
'bir nokta al
c = Picture1.Point(i * inten * Tppx, j * inten * Tppy)
'Red, Green, Blue analizini yap
R = c Mod 256
G = (c / 256) Mod 256
B = (c / 256 / 256) Mod 256
'Bundan bir onceki adımı kontrol et
c2 = P(i, j)
'analiz et
R2 = c2 Mod 256
G2 = (c2 / 256) Mod 256
B2 = (c2 / 256 / 256) Mod 256
'Esas karşılaştıma bolumu... Eğer tum R, G ve B'ler aynı ise, pixelde geğişiklik olmamıştır.
'iyi bir kamerada yazılım toleransı teorik olarak 1 olur. Ancak işIn aslı oyle değil
If Abs(R - R2) < Tolerance And Abs(G - G2) < Tolerance And Abs(B - B2) < Tolerance Then
'pixel aynı kalmış
Ri = Ri + 1
'Pon pixelin değişip değişmediğini tutar
POn(i, j) = True
Else
'Pixel değişti
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
'Asıl hareket pixelin etrafındaki 4 pixel değiştiği zaman meydana gelmiş demektir
'Daha basit bir ifade ile, eğer bir pixel ve etrafındaki dort pixel
'değişmişse bu gercek bir harekettir
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
'olayın istatistiğini verelim
Label1.Caption = Int(Wo / (Ri + Wo) * 100) & " % movement" & vbCrLf & "Real Movement: " & RealRi & vbCrLf _
& "Completed In: " & GetTickCount - LastTime
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
'Aslında resim cıkışını da kaydedebilirsiniz. Aşağıdaki kısmı kapalı tuttum.
'isterseniz tek tırnakları kaldırın ve sonucu gorun
'Private Sub Timer2_Timer()
'SavePicture Picture1.Image, "C:/pics/img" & Counter & ".bmp"
'Counter = Counter + 1
'End Sub
__________________
vb6 webcam ile mouse hareket ettirme ?
Programlama0 Mesaj
●25 Görüntüleme
- ReadBull.net
- Programlama ve Yazılım
- Programlama
- vb6 webcam ile mouse hareket ettirme ?