?? classvideocapture.cls
字號:
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
?? 快捷鍵說明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -