?? classrodney.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 = "ClassRodney"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
Const image_Width = 40
Const image_height = 30
'types of move
Const MOVE_LINEAR = 0
Dim cameraID As Integer
Dim StereoDisparity As New classImageProcessing
Dim axisPosition(16) As Byte
Dim MoveBufferSize(16) As Integer
Dim MoveBufferStartTick(16) As Integer
Dim MoveBufferStartPosition(16) As Integer
Dim MoveBuffer(16, 20, 3) As Long
Dim hwndc As Long
Private Function Vision_vote(n As Long) As Integer
'Counts the bits in long integer n
Dim Value As Integer
Dim power As Long
Dim i As Integer
Value = 0
power = 1
For i = 0 To 23
If (n And power) Then
Value = Value + 1
End If
power = power * 2
Next i
Vision_vote = Value
End Function
Public Sub Motion_Init(comCtrl As Object, ComPort As Integer)
comCtrl.Settings = "9600,N,8,1"
comCtrl.CommPort = ComPort
comCtrl.PortOpen = True
End Sub
Public Sub Motion_setTargetPos(comCtrl As Object, axis As Integer, Position As Integer)
'position must be between 0 and 254
If (Position > -1) And (Position < 256) Then
comCtrl.Output = Chr$(255)
comCtrl.Output = Chr$(axis)
comCtrl.Output = Chr$(Position)
axisPosition(axis) = CByte(Position)
End If
End Sub
Public Function Motion_getAxisPosition(axis As Integer) As Integer
Motion_getAxisPosition = axisPosition(axis)
End Function
Public Sub Motion_MoveLinear(comCtrl As Object, frm As Form, axis As Integer, TargetPosition As Integer, TargetTime As Long)
Call Motion_addMove(axis, TargetPosition, TargetTime, MOVE_LINEAR)
End Sub
Private Sub Motion_addMove(axis As Integer, TargetPosition As Integer, TargetTime As Long, MoveType As Integer)
'adds an item to the move buffer
If (MoveBufferSize(axis) < 20) Then
MoveBuffer(axis, MoveBufferSize(axis), 0) = TargetPosition
MoveBuffer(axis, MoveBufferSize(axis), 1) = TargetTime
MoveBuffer(axis, MoveBufferSize(axis), 2) = MoveType
If (MoveBufferSize(axis) = 0) Then
MoveBufferStartTick(axis) = -1
End If
MoveBufferSize(axis) = MoveBufferSize(axis) + 1
Else
MsgBox "Move buffer overflow"
End If
End Sub
Private Sub Motion_moveComplete(axis As Integer)
'a move has been completed - update the buffer
Dim i As Integer
If (MoveBufferSize(axis) > 0) Then
For i = 1 To 19
MoveBuffer(axis, i - 1, 0) = MoveBuffer(axis, i, 0)
MoveBuffer(axis, i - 1, 1) = MoveBuffer(axis, i, 1)
MoveBuffer(axis, i - 1, 2) = MoveBuffer(axis, i, 2)
Next
MoveBufferStartTick(axis) = -1
MoveBufferSize(axis) = MoveBufferSize(axis) - 1
End If
End Sub
Public Sub Motion_Update(comCtrl As Object)
'run this within a timer control
Dim maxTick As Long
Dim axis As Integer
Dim TicksElapsed As Integer
Dim pos As Integer
Static Tick As Integer
Const timer_interval = 40
For axis = 0 To 15
If (MoveBufferSize(axis) > 0) Then
If (MoveBufferStartTick(axis) = -1) Then
MoveBufferStartTick(axis) = Tick
MoveBufferStartPosition(axis) = axisPosition(axis)
End If
maxTick = MoveBuffer(axis, 0, 1) / timer_interval
If (maxTick > 0) Then
TicksElapsed = Tick - MoveBufferStartTick(axis)
If (Tick < MoveBufferStartTick(axis)) Then
TicksElapsed = ((60000 / timer_interval) - MoveBufferStartTick(axis)) + Tick
End If
pos = (((MoveBuffer(axis, 0, 0) - MoveBufferStartPosition(axis)) * (TicksElapsed / maxTick))) + MoveBufferStartPosition(axis)
Call Motion_setTargetPos(comCtrl, axis, pos)
End If
If (TicksElapsed >= maxTick) Then
'the move is complete
Call Motion_moveComplete(axis)
End If
End If
Next
Tick = Tick + 1
If (Tick > 60000 / timer_interval) Then
Tick = 0
End If
End Sub
Public Sub Motion_ClearBuffer()
Dim axis As Integer
For axis = 0 To 15
MoveBufferSize(axis) = 0
Next
End Sub
Public Sub Vision_VFWstart(canvas As PictureBox)
'starts VFW
Dim temp As Long
hwndc = capCreateCaptureWindow("Rodney Vision", ws_child Or ws_visible, 0, 0, 160, 120, canvas.hWnd, 0)
If (hwndc <> 0) Then
temp = SendMessage(hwndc, wm_cap_driver_connect, 0, 0)
temp = SendMessage(hwndc, wm_cap_set_preview, 1, 0)
temp = SendMessage(hwndc, WM_CAP_SET_PREVIEWRATE, 30, 0)
Else
MsgBox ("Can't open capture window")
End If
End Sub
Public Sub Vision_VFWFormatDialog()
Dim temp As Long
temp = SendMessage(hwndc, WM_CAP_DLG_VIDEOFORMAT, 0&, 0&)
End Sub
Public Sub Vision_VFWgrab(destination As PictureBox)
'grabs a frame to the given picturebox
Dim temp As Long
temp = SendMessageAsLong(hwndc, WM_CAP_GRAB_FRAME, 0&, 0&)
temp = SendMessage(hwndc, WM_CAP_EDIT_COPY, 1, 0)
destination.Picture = Clipboard.GetData
End Sub
Public Sub Vision_CentreOfMotion(canvas As PictureBox, ByRef cx As Integer, ByRef cy As Integer, ByRef motionLevel As Single)
'returns the centre of motion
Const steps = 40
Dim X As Integer
Dim Y As Integer
Dim sx As Integer
Dim sy As Integer
Dim p As Long
Dim p2 As Long
Dim xx As Double
Dim yy As Double
Dim tot As Double
Dim rgbsource As RGBthingy
Dim rgbdest As RGBpoint
Dim r As Single
Dim pixels As Long
pixels = steps * steps
motionLevel = 0
xx = 0
yy = 0
tot = 0
sx = canvas.ScaleWidth / steps
sy = canvas.ScaleHeight / steps
For X = sx To canvas.ScaleWidth - 1 Step sx
For Y = sy To canvas.ScaleHeight - 1 Step sy
p = canvas.Point(X - sx, Y - sy)
rgbsource.Value = p
Call CopyMemory(rgbdest, rgbsource, 3)
r = rgbdest.Red
p = canvas.Point(X, Y)
rgbsource.Value = p
Call CopyMemory(rgbdest, rgbsource, 3)
r = r + rgbdest.Red
If (r > 200) Then
motionLevel = motionLevel + r
'r = r * r
tot = tot + r
xx = xx + (X * r)
yy = yy + (Y * r)
End If
Next
Next
If (tot > 0) Then
xx = xx / tot
yy = yy / tot
Else
xx = canvas.ScaleWidth / 2
yy = canvas.ScaleHeight / 2
End If
cx = xx
cy = yy
motionLevel = motionLevel / pixels
canvas.FillColor = RGB(255, 0, 0)
canvas.FillStyle = 0
canvas.Circle (cx, cy), sx
End Sub
Public Sub Vision_VFWstop()
Dim temp As Long
temp = SendMessageAsLong(hwndc, WM_CAP_DRIVER_DISCONNECT, 0&, 0&)
End Sub
Public Sub Vision_Motion(inputImage As PictureBox, backgroundImage As PictureBox, motionImage As PictureBox)
'BitBlit motion compare
Const SRCCOPY = &HCC0020
Const SRCINVERT = &H660046
Dim rc As Long
Call Vision_VFWgrab(inputImage)
rc = BitBlt(motionImage.hDC, 0, 0, inputImage.ScaleWidth, inputImage.ScaleHeight, backgroundImage.hDC, 0, 0, SRCCOPY)
rc = BitBlt(motionImage.hDC, 0, 0, inputImage.ScaleWidth, inputImage.ScaleHeight, inputImage.hDC, 0, 0, SRCINVERT)
End Sub
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -