VBNet - Форум - Вот пример получения с WEB-камеры и вопрос

Вопрос: Вот пример получения с WEB-камеры и вопрос Добавлено: 28.09.08 20:26

Автор вопроса: portC | Web-сайт: feshin.info

Получаю картинку с WEB-камеры, обрабатаваю (опознаю движение, сохраняю картинку), но стоит свернуть форму, как картинка перестает обрабатываться. Вопрос: "Как обрабатывать данные с камеры в памяти, минуя вывод на экран?". Собствененно часть кода ниже:
(В форме Picture1, Label1 и Timer1, плюс два слайдера с Value от 1 до 30)

'Объявления для WEB-камеры
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
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()
'уснановка видео
Picture1.Width = 640 * Screen.TwipsPerPixelX
Picture1.Height = 480 * Screen.TwipsPerPixelY
'через сколько пикселов проверять
Slider2.Value = 8 ' N = 15
Slider1.Value = 20
inten = Slider2.Value '15
'толерантность
Tolerance = Slider1.Value '20
Tppx = Screen.TwipsPerPixelX
Tppy = Screen.TwipsPerPixelY
ReDim POn(640 / inten, 480 / inten)
ReDim P(640 / inten, 480 / inten)
STARTCAM
End Sub

Private Sub Slider1_Click()
Tolerance = Slider1.Value
End Sub

Private Sub Slider2_Click()
inten = Slider2.Value
End Sub

Private Sub Timer1_Timer()
'Получение картинки с камеры (основная часть)
SendMessage mCapHwnd, GET_FRAME, 0, 0
SendMessage mCapHwnd, COPY, 0, 0
Picture1.Picture = Clipboard.GetData
Clipboard.Clear
Ri = 0 'right
Wo = 0 'wrong
LastTime = GetTickCount
For i = 0 To 640 / inten - 1 'y
    For j = 0 To 480 / inten - 1 'x

    'получаем точку
    c = Picture1.Point(i * inten * Tppx, j * inten * Tppy)
    'анализируем её, Red, Green, Blue
        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

    'главная часть сравнивания... если каждый R, G и B такие жу, как и были, тогда этот pixel прежний
    If Abs(R - R2) < Tolerance And Abs(G - G2) < Tolerance And Abs(B - B2) < Tolerance Then
    'pixel не изменился
    Ri = Ri + 1
    'Pon типа boolean (pixel изменился или нет), будет использоваться для обнаружения НАСТОЯЩЕГО движения
    POn(i, j) = True

    Else
    'Pixel изменился
    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
        'За настоящее движение принимаем, когда все 4 пикселя вокруг одного изменились
        'Проще говоря, если этот пиксель изменен и все вокруг него тоже, то считаем это
        'настоящим движением
        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

'чепятаем статистику
On Error Resume Next
Label1.Caption = " движений " & Int(Wo / (Ri + Wo) * 100) & " % " & vbCrLf & " настоящих движений: " & RealRi & vbCrLf _
& " з.п. : " & GetTickCount - LastTime
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

Вот вкратце...
Какие есть предложения по обработке без вывода на экран?
Ответить

Ответы Всего ответов: 4

Номер ответа: 1 Автор ответа: Boconon ICQ: 216390557 Вопросов: 25 Ответов: 71	Web-сайт: microsoft.com Профиль \| \| #1	Добавлено: 28.09.08 21:28
	Обрабатывать через API в виртуальном DC - выходит быстро и правильно. А потом уже bitblt с виртуального dc на dc вывода. Правда там прийдется обрабатывать только через API а не ф-ями VB -но это хорошо - быстрее... Смотри по функциям CreateCompatibleDC, CreateCompatibleBitmap Ответить

Номер ответа: 2 Автор ответа: portC Вопросов: 14 Ответов: 101	Web-сайт: feshin.info Профиль \| \| #2	Добавлено: 16.11.08 17:29
	та же история - при сворачивании окна - перестает что-либо отслеживать Ответить

Номер ответа: 3 Автор ответа: Администратор ICQ: 278109632 Вопросов: 42 Ответов: 3949	Web-сайт: domkratt.com Профиль \| \| #3	Добавлено: 17.11.08 00:11
	Тут много сложностей... копирование через буфер.. нафиг? Создаешь битмапу, выставляешь пиксели и радуешься. А потом уж с этой битовой картой что хочешь делай... Ответить

Номер ответа: 4 Автор ответа: portC Вопросов: 14 Ответов: 101	Web-сайт: feshin.info Профиль \| \| #4	Добавлено: 19.11.08 16:23
	Можешь показать какой-нить кусок кода? Не очень понятно, что имеешь ввиду... Ответить

Страница: 1 |