form1.frm

VB编程实现摄像头图像的捕获,将摄像头的图象保存在一个二进制数组中

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   8400
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   13815
   LinkTopic       =   "Form1"
   ScaleHeight     =   8400
   ScaleWidth      =   13815
   StartUpPosition =   3  '窗口缺省
   Begin VB.CommandButton Command7 
      Caption         =   "将数组还原成图像"
      Height          =   495
      Left            =   240
      TabIndex        =   9
      Top             =   6000
      Width           =   1215
   End
   Begin VB.PictureBox Picture2 
      Height          =   2655
      Left            =   5760
      ScaleHeight     =   2595
      ScaleWidth      =   5595
      TabIndex        =   8
      Top             =   4320
      Width           =   5655
   End
   Begin VB.CommandButton Command8 
      Caption         =   "保存为图像"
      Height          =   495
      Left            =   2760
      TabIndex        =   7
      Top             =   4680
      Width           =   1455
   End
   Begin VB.CommandButton Command6 
      Caption         =   "捕获无文件的视频流序列"
      Height          =   495
      Left            =   1920
      TabIndex        =   6
      Top             =   6120
      Width           =   2055
   End
   Begin VB.CommandButton Command5 
      Caption         =   "direcShow播放视频流"
      Height          =   615
      Left            =   2880
      TabIndex        =   5
      Top             =   5280
      Width           =   1455
   End
   Begin VB.CommandButton Command4 
      Caption         =   "弹出控制窗口"
      Height          =   375
      Left            =   240
      TabIndex        =   4
      Top             =   4680
      Width           =   2055
   End
   Begin VB.CommandButton Command3 
      Caption         =   "结束视频"
      Height          =   495
      Left            =   240
      TabIndex        =   3
      Top             =   5280
      Width           =   1335
   End
   Begin VB.PictureBox Picture1 
      Height          =   3015
      Left            =   5760
      ScaleHeight     =   2955
      ScaleWidth      =   5595
      TabIndex        =   2
      Top             =   240
      Width           =   5655
   End
   Begin VB.CommandButton Command2 
      Caption         =   "保存图象至剪贴板"
      Height          =   495
      Left            =   2640
      TabIndex        =   1
      Top             =   3960
      Width           =   2055
   End
   Begin VB.CommandButton Command1 
      Caption         =   "录制AVI,ESC结束"
      Height          =   495
      Left            =   240
      TabIndex        =   0
      Top             =   3960
      Width           =   2055
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Declare Function capCreateCaptureWindow Lib "avicap32.dll" Alias "capCreateCaptureWindowA" (ByVal lpszWindowName As String, ByVal dwStyle As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hWndParent As Long, ByVal nID As Long) As Long


'----------------------下面两行可设置出可移动窗口------
Private Const WS_CAPTION = &HC00000
Private Const WS_THICKFRAME = &H40000

'--------------------
Private Const WS_CHILD = &H40000000
Private Const WS_VISIBLE = &H10000000
Private Const WM_USER = &H400
Private Const WM_CAP_START = &H400
Private Const WM_CAP_EDIT_COPY = (WM_CAP_START + 30)
Private Const WM_CAP_DRIVER_CONNECT = (WM_CAP_START + 10)
Private Const WM_CAP_SET_PREVIEWRATE = (WM_CAP_START + 52)
Private Const WM_CAP_SET_OVERLAY = (WM_CAP_START + 51)
Private Const WM_CAP_SET_PREVIEW = (WM_CAP_START + 50)
Private Const WM_CAP_DRIVER_DISCONNECT = (WM_CAP_START + 11)
'-----------------
Private Const WM_CAP_GET_SEQUENCE_SETUP = WM_CAP_START + 65
Private Const WM_CAP_SET_SEQUENCE_SETUP = WM_CAP_START + 64
Private Const WM_CAP_SEQUENCE_NOFILE = WM_CAP_START + 63
Private Const WM_CAP_FILE_SAVEAS = WM_CAP_START + 23

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function SendMessageS Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Integer, ByVal lParam As String) As Long



Private Preview_Handle As Long
Private filex() As Byte
'------------------------------以下是为图像进数组用

Private Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long

Private Declare Function GetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, ByVal dwCount As Long, lpBits As Any) As Long

Private Declare Function SetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, ByVal dwCount As Long, lpBits As Any) As Long
Private Type BITMAP

         bmType   As Long

         bmWidth   As Long

         bmHeight   As Long

         bmWidthBytes   As Long

         bmPlanes   As Integer

         bmBitsPixel   As Integer

         bmBits   As Long

End Type
Private PictureBits() As Byte, PictureInfo As BITMAP, iBit As Long

Private Sub Command1_Click()
    Dim sFileName As String
    Dim CAP_PARAMS As CAPTUREPARMS


     SendMessage lwndC, WM_CAP_GET_SEQUENCE_SETUP, Len(CAP_PARAMS), VarPtr(CAP_PARAMS)
    
    CAP_PARAMS.dwRequestMicroSecPerFrame = (1 * (10 ^ 6)) / 30  ' 30 Frames per second
    CAP_PARAMS.fMakeUserHitOKToCapture = True
    CAP_PARAMS.fCaptureAudio = False
    

SendMessage lwndC, WM_CAP_SET_SEQUENCE_SETUP, Len(CAP_PARAMS), VarPtr(CAP_PARAMS)
sFileName = "C:\myvideo.avi"
SendMessage lwndC, WM_CAP_SEQUENCE, 0, 0
SendMessageS lwndC, WM_CAP_FILE_SAVEAS, 0, sFileName
End Sub

Private Sub Command2_Click()
 SendMessage lwndC, WM_CAP_EDIT_COPY, 0, 0
 
 '取出将获得的数剪贴板中的数据进Picture1.Picture
Picture1.AutoRedraw = True
Picture1.AutoSize = True
Picture1.Visible = True
Picture1.Picture = Clipboard.GetData
 
End Sub

Private Sub Command3_Click()
If lwndC Then
SendMessage lwndC, WM_CAP_DRIVER_DISCONNECT, 0, 0
lwndC = 0
End If
End Sub

Private Sub Command4_Click()

SendMessage lwndC, WM_CAP_DLG_VIDEOSOURCE, 0, 0
End Sub

Private Sub Command5_Click()
Static MyObject As Object
      Dim MyFile As String

      MyFile = "c:\1.jpg"  '或AVI文件
      Set MyObject = New FilgraphManager
      MyObject.RenderFile MyFile
      MyObject.Run
      
End Sub

Private Sub Command6_Click()
'捕获无文件的视频流序列,与回调函数配合使用
SendMessage lwndC, WM_CAP_SET_CALLBACK_VIDEOSTREAM, 0, CALLBACK(lwndC)
SendMessage lwndC, WM_CAP_SEQUENCE_NOFILE, 0, 0
SendMessage lwndC, WM_CAP_SET_CALLBACK_VIDEOSTREAM, 0, Null
End Sub




Private Sub Command7_Click()

        Picture2.Width = Picture1.Width

        Picture2.Height = Picture1.Height
        
        GetObject Picture1.Image, Len(PictureInfo), PictureInfo

        ReDim PictureBits(1 To PictureInfo.bmWidthBytes * PictureInfo.bmHeight) As Byte

        GetBitmapBits Picture1.Image, UBound(PictureBits), PictureBits(1)

        SetBitmapBits Picture2.Image, UBound(PictureBits), PictureBits(1) '将数组还原成图像

         Picture2.Refresh
End Sub

Private Sub Command8_Click()
SendMessage lwndC, WM_CAP_EDIT_COPY, 0, 0         '视频截图至内存
SavePic Clipboard.GetData, "c:\1.jpg", "jpg"      '保存内存至图像
End Sub

Private Sub Form_Load()

'建立捕获窗口

lwndC = capCreateCaptureWindow("my Video", WS_CAPTION Or WS_THICKFRAME Or WS_CHILD + WS_VISIBLE, 0, 0, 320, 240, Me.hWnd, 1)

'建立捕获窗口到捕获设备的连接

SendMessage lwndC, WM_CAP_DRIVER_CONNECT, 0, 0
'设置捕获的帧频率为30毫秒一帧

SendMessage lwndC, WM_CAP_SET_PREVIEWRATE, 30, 0
 '用预览模式在捕获窗口开始预览图像

 SendMessage lwndC, WM_CAP_SET_PREVIEW, 1, 0
End Sub

Private Sub Form_Unload(Cancel As Integer)
'断开到捕获设备的连接

SendMessage Preview_Handle, WM_CAP_DRIVER_DISCONNECT, 0, 0
End Sub


Function CALLBACK(ByVal lwnd As Long) As Boolean
MsgBox "aa"
End Function