classvideocapture.cls

优秀的面部识别程序,用VB开发的

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "ClassVideoCapture"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Dim initialised As Integer
Dim image_raw As classImageProcessing
Dim prev_image_raw As classImageProcessing
Dim image_edges As classImageProcessing
Dim image_motion As classImageProcessing
Dim image_rgb(3) As classImageProcessing

Public processMotion As Boolean
Public processEdges As Boolean
Public processRGB As Boolean


Public Sub init(image_Width As Integer, image_height As Integer)
  
  Dim i As Integer
  
  Set image_raw = New classImageProcessing
  Call image_raw.init(image_Width, image_height)
  image_raw.processType = 0
  
  Set prev_image_raw = New classImageProcessing
  Call prev_image_raw.init(image_Width, image_height)
  prev_image_raw.processType = 0
  
  Set image_motion = New classImageProcessing
  Call image_motion.init(image_Width, image_height)
  image_motion.processType = 0
  
  Set image_edges = New classImageProcessing
  Call image_edges.init(image_Width, image_height)
  image_raw.processType = 0
  
  For i = 0 To 2
    Set image_rgb(i) = New classImageProcessing
    Call image_rgb(i).init(image_Width, image_height)
    image_rgb(i).processType = i + 1
  Next
  
  initialised = 1
  
End Sub


Public Sub update(canvas As PictureBox)
  Dim i As Integer
  Dim temp As classImageProcessing
  
  If (initialised = 1) Then
    Call image_raw.update(canvas)
    If (processMotion) Then
      Call updateMotion
      Set temp = prev_image_raw
      Set prev_image_raw = image_raw
      Set image_raw = temp
    End If
    If (processEdges) Then
      Call image_edges.getImageContours(image_raw)
    End If
    If (processRGB) Then
      For i = 0 To 2
        Call image_rgb(i).update(canvas)
      Next
    End If
  End If
End Sub


Public Sub showRawImage(canvas As PictureBox)
  Call image_raw.show(canvas)
End Sub

Public Sub showMotion(canvas As PictureBox)
  Call image_motion.show(canvas)
End Sub

Public Sub showEdgesImage(canvas As PictureBox)
  Call image_edges.show(canvas)
End Sub

Public Sub showRGBImage(canvas As PictureBox, primaryColourIndex As Integer)
  Call image_rgb(primaryColourIndex).show(canvas)
End Sub


Private Sub updateMotion()
  Dim i As Integer
  Dim j As Integer
  Dim dp As Integer
  
  For i = 0 To image_raw.width - 1
    For j = 0 To image_raw.height - 1
      dp = image_raw.getPoint(i, j)
      dp = Abs(dp - prev_image_raw.getPoint(i, j))
      Call image_motion.setPoint(i, j, CByte(dp))
    Next
  Next
End Sub