frmtesting.frm

vb做的摄像头程序

VERSION 5.00
Object = "{648A5603-2C6E-101B-82B6-000000000014}#1.1#0"; "MSCOMM32.OCX"
Begin VB.Form frmTesting 
   BackColor       =   &H00000000&
   Caption         =   "Rodney"
   ClientHeight    =   4335
   ClientLeft      =   165
   ClientTop       =   450
   ClientWidth     =   4950
   Icon            =   "frmTesting.frx":0000
   LinkTopic       =   "Form1"
   ScaleHeight     =   4335
   ScaleWidth      =   4950
   StartUpPosition =   2  'CenterScreen
   Begin VB.Frame Frame1 
      BackColor       =   &H00C0C0C0&
      ForeColor       =   &H00000000&
      Height          =   4335
      Left            =   0
      TabIndex        =   0
      Top             =   0
      Width           =   4935
      Begin VB.CommandButton cmdStop 
         Caption         =   "Stop"
         Enabled         =   0   'False
         Height          =   375
         Left            =   3240
         TabIndex        =   6
         Top             =   3480
         Width           =   1215
      End
      Begin VB.PictureBox picStereo1 
         AutoRedraw      =   -1  'True
         BackColor       =   &H00000000&
         Height          =   1935
         Left            =   120
         ScaleHeight     =   113.122
         ScaleMode       =   0  'User
         ScaleWidth      =   121.633
         TabIndex        =   5
         Top             =   240
         Width           =   2295
      End
      Begin VB.PictureBox picStereo2 
         AutoRedraw      =   -1  'True
         BackColor       =   &H00000000&
         Height          =   1935
         Left            =   2520
         ScaleHeight     =   565.611
         ScaleMode       =   0  'User
         ScaleWidth      =   608.163
         TabIndex        =   4
         Top             =   240
         Width           =   2295
      End
      Begin VB.CommandButton cmdCapture 
         Caption         =   "Start Capture"
         Height          =   375
         Left            =   3240
         TabIndex        =   3
         Top             =   2520
         Width           =   1215
      End
      Begin VB.PictureBox picResult 
         AutoRedraw      =   -1  'True
         BackColor       =   &H00000000&
         Height          =   1935
         Left            =   120
         ScaleHeight     =   500
         ScaleMode       =   0  'User
         ScaleWidth      =   500
         TabIndex        =   2
         Top             =   2280
         Width           =   2295
      End
      Begin VB.Timer timMotion 
         Interval        =   40
         Left            =   960
         Top             =   4320
      End
      Begin VB.CommandButton cmdTestMotion 
         Caption         =   "Track Motion"
         Enabled         =   0   'False
         Height          =   375
         Left            =   3240
         TabIndex        =   1
         Top             =   3000
         Width           =   1215
      End
      Begin MSCommLib.MSComm ServoComms 
         Left            =   240
         Top             =   4320
         _ExtentX        =   1005
         _ExtentY        =   1005
         _Version        =   393216
         DTREnable       =   -1  'True
      End
   End
   Begin VB.Menu mnuFile 
      Caption         =   "&File"
      Begin VB.Menu mnuExit 
         Caption         =   "&Exit"
      End
   End
   Begin VB.Menu mnuShow 
      Caption         =   "&Show"
      Begin VB.Menu mnuFormat 
         Caption         =   "Video Format"
      End
   End
   Begin VB.Menu mnuHelp 
      Caption         =   "&Help"
      Begin VB.Menu mnuAbout 
         Caption         =   "&About"
      End
   End
End
Attribute VB_Name = "frmTesting"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Dim finish As Boolean

Const image_Width = 40
Const image_height = 30

Dim StereoDisparity  As New classImageProcessing

Dim cameraID As Integer

Dim StopTracking As Boolean


Dim Rodders As New ClassRodney
Public Tick As Long



Private Sub cmdCapture_Click()
  Call Rodders.Vision_VFWstart(picStereo1)
  cmdTestMotion.Enabled = True
  cmdStop.Enabled = True
End Sub



Private Sub cmdStop_Click()
  StopTracking = True
End Sub

Private Sub cmdTestMotion_Click()
  Call TrackMotion
End Sub


Public Sub TrackMotion()
  Dim startTime As Long
  Dim currTime As Long
  Dim lastMoved As Long
  Dim X As Integer
  Dim Y As Integer
  Dim mid_x As Integer
  Dim mid_y As Integer
  Dim dx As Long
  Dim dy As Long
  Dim px As Long
  Dim minDeviation As Integer
  Dim motionLevel As Single
  Dim change As Long
  
  mid_x = picResult.ScaleWidth / 2
  mid_y = picResult.ScaleHeight / 2
  minDeviation = picResult.ScaleWidth / 15
  
  'Call Rodders.Vision_panorama(ServoComms, VideoPortal1, 0, picStereo1, Picture4)
  
  lastMoved = Timer
  currTime = Timer
  StopTracking = False
  While (Not StopTracking)
    Call Rodders.Vision_VFWgrab(picStereo2)
    Call Rodders.Vision_Motion(picStereo1, picStereo2, picResult)
    Call Rodders.Vision_CentreOfMotion(picResult, X, Y, motionLevel)
    If (currTime - lastMoved > 0) And (motionLevel > 10) Then
      dx = X - mid_x
      dy = Y - mid_y
      If (Abs(dx) > minDeviation) Then
        px = Rodders.Motion_getAxisPosition(0)
        change = ((dx * 70) / picResult.ScaleWidth)
        If (change > 40) Then
          change = 40
        End If
        If (change < -40) Then
          change = -40
        End If
        px = px + change
        If (px < 0) Then
          px = 0
        End If
        If (px > 255) Then
          px = 255
        End If
        Call Rodders.Motion_setTargetPos(ServoComms, 0, CInt(px))
        lastMoved = Timer
      End If
    End If
    DoEvents
    currTime = Timer
  Wend
End Sub



Private Sub Form_Load()
  'Call Rodders.Vision_Init(VideoPortal1)
  Call Rodders.Motion_Init(ServoComms, 2)
  Call Rodders.Motion_setTargetPos(ServoComms, 0, 127)
  Call Rodders.Motion_setTargetPos(ServoComms, 1, 127)
End Sub


Private Sub Form_Unload(Cancel As Integer)
  Call Rodders.Vision_VFWstop
  End
End Sub

Private Sub mnuAbout_Click()
  frmAbout.show 1
End Sub



Private Sub mnuExit_Click()
  Call Rodders.Vision_VFWstop
  End
End Sub


Private Sub mnuFormat_Click()
  Call Rodders.Vision_VFWFormatDialog
End Sub



Private Sub timMotion_Timer()
  Call Rodders.Motion_Update(ServoComms)
End Sub


Public Sub setTimerInterval(interval As Integer)
  timMotion.interval = interval
End Sub