main.frm

vb做的摄像头程序

VERSION 5.00
Begin VB.Form frmMain 
   BackColor       =   &H8000000C&
   Caption         =   "Video For Windows Frame Grabber"
   ClientHeight    =   2190
   ClientLeft      =   2850
   ClientTop       =   3405
   ClientWidth     =   4950
   Icon            =   "Main.frx":0000
   LinkTopic       =   "Form1"
   ScaleHeight     =   146
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   330
   Begin VB.CommandButton cmdGrab 
      Caption         =   "Grab"
      Height          =   495
      Left            =   120
      TabIndex        =   3
      Top             =   1440
      Width           =   1215
   End
   Begin VB.PictureBox picImg 
      BackColor       =   &H00FFFFFF&
      Height          =   1155
      Left            =   120
      ScaleHeight     =   77
      ScaleMode       =   0  'User
      ScaleWidth      =   78
      TabIndex        =   2
      Top             =   120
      Width           =   1170
   End
   Begin VB.PictureBox picCapture2 
      Height          =   2160
      Left            =   1440
      MousePointer    =   2  'Cross
      ScaleHeight     =   2100
      ScaleWidth      =   3435
      TabIndex        =   1
      Top             =   0
      Width           =   3495
   End
   Begin VB.PictureBox picCapture 
      Height          =   2160
      Left            =   1440
      MousePointer    =   2  'Cross
      ScaleHeight     =   2100
      ScaleWidth      =   3435
      TabIndex        =   0
      Top             =   -120
      Width           =   3495
   End
   Begin VB.Shape shaBorder2 
      BackColor       =   &H00000000&
      BackStyle       =   1  'Opaque
      FillColor       =   &H00404040&
      Height          =   4215
      Left            =   0
      Top             =   2640
      Width           =   1455
   End
   Begin VB.Shape shaBorder 
      BackColor       =   &H00000000&
      BackStyle       =   1  'Opaque
      FillColor       =   &H00404040&
      Height          =   2655
      Left            =   0
      Top             =   0
      Width           =   1455
   End
   Begin VB.Menu mnuFile 
      Caption         =   "&File"
      Begin VB.Menu mnuExit 
         Caption         =   "E&xit"
      End
   End
   Begin VB.Menu mnuOptions 
      Caption         =   "&Options"
      Begin VB.Menu mnuFormat 
         Caption         =   "&Format..."
         Enabled         =   0   'False
      End
      Begin VB.Menu mnuSource 
         Caption         =   "S&ource..."
         Enabled         =   0   'False
      End
      Begin VB.Menu mnuDisplay 
         Caption         =   "&Display..."
         Enabled         =   0   'False
      End
      Begin VB.Menu mnuspacer5 
         Caption         =   "-"
      End
      Begin VB.Menu mnuCompression 
         Caption         =   "&Compression..."
      End
      Begin VB.Menu mnuspacer6 
         Caption         =   "-"
      End
      Begin VB.Menu mnuDriver 
         Caption         =   "<none>"
         Enabled         =   0   'False
         Index           =   0
      End
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private hCapWnd As Long       ' Handle to the Capture Windows
Private nDriverIndex As Long  ' video driver index (default 0)
Private m_CapParams As CAPTUREPARMS

'Public property to prevent reentrancy in Form_Resize event
Public AutoSizing As Boolean

Public vidCapture As New ClassVideoCapture
Public LeftBorderWidth As Integer
Public minBorderHeight As Integer


Public Property Get capwnd() As Long
'read-only public property to allow other forms to retrieve hwnd of Cap Window
  capwnd = hCapWnd
End Property


Public Property Get MenuHeight() As Long
'read-only properties for sizing
  MenuHeight = GetSystemMetrics(SM_CYMENU)
End Property


Public Property Get CaptionHeight() As Long
  CaptionHeight = GetSystemMetrics(SM_CYCAPTION)
End Property



Private Sub cmdGrab_Click()
  Dim FileName As String
  Dim retval As Boolean
  
  Call capGrabFrame(hCapWnd)
  
  FileName = App.Path & "\bob.bmp"
  retval = capFileSaveDIB(hCapWnd, FileName)
  If (retval = False) Then
    MsgBox "Problem saving frame", vbInformation, App.Title
  End If
  picCapture2.Picture = LoadPicture(FileName)
  
  vidCapture.processEdges = False
  
  Call vidCapture.update(picCapture2)
  Call vidCapture.showRawImage(picImg)
End Sub


Private Sub Form_Load()
  Dim retval As Boolean
  Dim numDevs As Long
    
  LeftBorderWidth = shaBorder.width
  minBorderHeight = shaBorder.height
    
  Set vidCapture = New ClassVideoCapture
  Call vidCapture.init(25, 25)
        
  'detect hardware
  numDevs = VBEnumCapDrivers(Me)
  If (numDevs <> 0) Then
  
    nDriverIndex = Val(GetSetting(App.Title, "driver", "index", "0"))
  
    'if invalid entry is in registry use default (0)
    If (mnuDriver.UBound < nDriverIndex) Then
      nDriverIndex = 0
    End If
    mnuDriver(nDriverIndex).Checked = True
  
    'Create Capture Window
    hCapWnd = capCreateCaptureWindow("VB CAP WINDOW", WS_CHILD Or WS_VISIBLE, 0, 0, 160, 120, picCapture.hWnd, 0)
    If (hCapWnd <> 0) Then
  
      retval = ConnectCapDriver(hCapWnd, nDriverIndex)
      If (retval = False) Then
        MsgBox "could not connect to capture driver", vbInformation, App.Title
        Unload Me
        Else
        #If (USECALLBACKS = 1) Then
          'if we have a valid capwnd we can enable our status callback function
          Call capSetCallbackOnStatus(hCapWnd, AddressOf StatusProc)
        #End If
      End If
 
      Else
    
      MsgBox "could not create capture window", vbCritical, App.Title
      Unload Me
    End If
    
    Else

    MsgBox "No capture hardware detected", vbCritical, App.Title
    Unload Me
  End If
  
  'grab an initial frame
  Call cmdGrab_Click

End Sub


Public Sub Form_Resize()
  Dim retval As Boolean
  Dim capStat As CAPSTATUS
    
  'Get the capture window attributes
  retval = capGetStatus(hCapWnd, capStat)
  If (retval) Then
    picCapture.left = LeftBorderWidth
    picCapture.width = capStat.uiImageWidth
    picCapture.ScaleWidth = picCapture.width
    picCapture.height = capStat.uiImageHeight
    picCapture.ScaleHeight = picCapture.height
    
    picCapture2.left = LeftBorderWidth
    picCapture2.width = capStat.uiImageWidth
    picCapture2.ScaleWidth = picCapture.width
    picCapture2.height = capStat.uiImageHeight
    picCapture2.ScaleHeight = picCapture.height
  End If

End Sub

Private Sub Form_Unload(Cancel As Integer)

  'save trivial settings
  If (Me.WindowState = vbDefault) Then
    Call SaveSetting(App.Title, "preferences", "left", Me.left)
    Call SaveSetting(App.Title, "preferences", "top", Me.top)
  End If

  'unsubclass if necessary
  #If USECALLBACKS = 1 Then
    'Disable status callback
    Call capSetCallbackOnStatus(hCapWnd, 0&)
  #End If

  'disconnect VFW driver
  Call basVFW.capDriverDisconnect(hCapWnd)
  'destroy CapWnd
  If (hCapWnd <> 0) Then Call DestroyWindow(hCapWnd)

End Sub


Private Sub mnuCompression_Click()
  Call capDlgVideoCompression(hCapWnd)
End Sub



Private Sub mnuDisplay_Click()
  Call capDlgVideoDisplay(hCapWnd)
End Sub


Private Sub mnuDriver_Click(Index As Integer)
  Dim retval As Boolean
    
  retval = ConnectCapDriver(hCapWnd, Index)
  If (retval = False) Then
    MsgBox "could not connect to capture driver", vbInformation, App.Title
    Else
    Call SaveSetting(App.Title, "driver", "index", CStr(Index)) 'save selected device index
  End If
End Sub


Private Sub mnuExit_Click()
  Unload Me
End Sub

Private Sub mnuFormat_Click()
  Call capDlgVideoFormat(hCapWnd)
  Call ResizeCaptureWindow(hCapWnd, LeftBorderWidth, minBorderHeight)
End Sub


Private Sub mnuSource_Click()
'Display the Video Source dialog when "Source" is selected from the menu bar
  Call capDlgVideoSource(hCapWnd)
End Sub