2024年2月8日发(作者：)

【编程分析】

微软为软件开发人员提供了一个专门用于视频捕获的VFW (Video for Windows) SDK，她为在Windows系统中实现视频捕获提供了标准的接口，从而大大降低了程序的开发难度。

一、VFW简介

VFW是微软公司推出的关于数字视频的一个软件包，它能使应用程序通过数字化设备从传统的模拟视频源得到数字化的视频剪辑。VFW的一个关键思想是播放时不需要专用硬件，为了解决数字视频数据量大的问题，需要对数据进行压缩。它引进了一种叫AVI的文件标准，该标准未规定如何对视频进行捕获、压缩及播放，仅规定视频和音频该如何存储在硬盘上，以及在AVI文件中交替存储视频帧和与之相匹配的音频数据。VFW使程序员能通过发送消息或设置属性来捕获、播放和编辑视频剪辑。VFW主要由以下6个模块组成：

1、：包含执行视频捕获的函数，它给AVI文件的I/O处理和视频、音频设备驱动程序提供一个高级接口；

2、：包含一套特殊的DrawDib函数，用来处理屏幕上的视频操作；

3、：包括对VFW的MCI命令解释器的驱动程序；

4、：包含由标准多媒体I/O（mmio）函数提供的更高的命令，用来访问.AVI文件；

5、压缩管理器（ICM）：用于管理的视频压缩/解压缩的编译码器（Codec）；

6、音频压缩管理器ACM：提供与ICM相似的服务，适用于波形音频。

本程序将使用第一个模块，她是Windows API应用程序接口相关模块，用于对摄像头和其它视频硬件进行AVI电影和视频的截取。她的AVICap窗口类支持实时的视频流捕获和单帧捕获，并提供对视频源的控制，而且能直接访问视频缓冲区，不需要生成中间文件，实时性很强，效率很高，同时，她还可将数字视频捕获到一个文件中。

要使用该动态库，在程序中需要对其中的各个常量和API函数进行声明，由于不再提倡使用API函数，其集成环境也没有API浏览器了，故本文所使用的全部常量和函数的声明都可以在代码包中察看。

说明：以上常量名称可以改名，但要后面的保持一致；函数名称不能改变，否则无法从动态库中找到入口。调用动态库实现视频捕捉，就是在用capCreateCaptureWindowA创建视频窗口后，再调用消息发送函数SendMessage发送以上相应的消息，从而实现对视频设备的控制（包括连接、设置、抓图、录像、停止、断开等）。

二、获取视频设备驱动

为了让计算机支持视频采集，那么必须安装视频设备驱动，微软提供的动态库是一个通用的摄像头视频驱动程序，在视频创建和捕捉前，需要检查当前系统中是否安装了视频设备驱动，编程方法和核心代码如下：

Function LoadDevice() As Integer

Dim strName As String=Space(100)

Dim strVer As String=Space(100)

Dim bRet As Boolean

Dim N As Integer = 0

'获取设备名称和版本信息

bRet=capGetDriverDescriptionA(N,strName,100,strVer ,100)

While bRet '继续获取下一个设备

N += 1 '获得设备则计数1次

'获取设备名称和版本，代码同上

End While

Return (N) '返回可用设备数量

End Function

说明：本文只是检测系统中的可用视频驱动设备数量，没有处理设备名称和版本信息，如果要在程序中显示设备的名称、版本，可以通过strName、strVer变量获取。

三、创建视频窗口

在进行视频捕获之前必需要先创建一个视频窗口，并以它为基础进行所有的捕获及设置操作。视频窗口用AVICap窗口类的“capCreateCaptureWindowA”函数来创建，其窗口风格一般为WS_CHILD或WS_VISIBLE。视频窗类似于标准控件（如PictureBox等），并具有下列功能：

●动态连接或断开视频和音频输入器件

●Preview模式对视频流进行实时显示

●设置捕获速率

●将捕获的单帧图像保存为DIB格式文件

●将视频流和音频流捕获到AVI文件中

创建捕捉窗口（本文用PictureBox控件）的编程方法和核心代码如下：

Dim Hwnd As Integer '视窗句柄

Dim Cned As Boolean '连接状态

Private Sub OpenPreviewWindow()

Dim iHeight As Integer=

Dim iWidth As Integer=

Hwnd=capCreateCaptureWindowA(0,WS_VISIBLE Or WS_CHILD,0,0,,

,32,0) '创建视频窗口

If Hwnd <> 0 Then '创建成功

If SendMessage(Hwnd, WM_CN, 0, 0) Then '设备连接成功

'设置视频显示速率

SendMessage(Hwnd,WM_RATE,64,0)

'设置视频预览

SendMessage(Hwnd,WM_PV,1,0)

Cned = True '连接标志

Else '连接失败

DestroyWindow(Hwnd) '关闭设备

End If

End If

End Sub

四、抓取当前视频图像

通过发送WM_COPY消息将当前视频单帧图像拷贝到剪贴板，然后通过剪贴板的GetDataObject方法获取图像到Image对象，再借助图片框控件按Jpeg格式保存，保存时的文件名通过保存对话框设置，编程方法和核心代码如下：

alog() '保存对话框

If me <> "" Then

Dim Data As IDataObject

Dim bMap As Image

'拷贝视频图像到剪贴板

SendMessage(Hwnd,WM_COPY,0,0)

'从剪贴板获取图像并转换格式

Data=aObject()

If aPresent(GetType() ) Then '剪贴板上是位图

bMap=CType(a(GetType( map)),Image) '获取图像

=bMap '转换图像

(me, g) '保存图像

End If

End If

五、录像的实现

动态库支持录像功能，并将视频信息存放到C:文件中，默认的视频大小为320×240。录像数据占用的存储控件比较大，平均每分钟录制的图像数据约130MB，所以，在录像前需要对磁盘剩余空间进行检测，获取磁盘剩余空间的方法有很多，如：

1、用API函数GetDiskFreeSpaceEx获取；

2、用FSO(文件系统对象模型)实现；

3、利用WMI获取硬盘信息；

本文采用代码最简单的第二种方法，首先通过“项目添加引用”菜单项，从COM选项卡中选择“Microsoft Scripting Runtime”项，点击确定返回，核心代码如下：

Imports Scripting '引入

Function DiskSpace() As Long

Dim F As New FileSystemObject

Dim D As Drive=ve("C:")

DiskSpace=ace/1024/1024

End Function

上面返回的磁盘剩余空间大小以MB为单位，检测磁盘剩余空间只是一个提示功能，实现录像控制的核心代码如下：

'提示磁盘剩余空间，代码略

Dim Fn As String="C:"

If (Fn) Then '有文件

ributes(Fn,) '改变文件属性

(Fn) '删除文件

End If

SendMessage(Hwnd,WM_REC,0,0) '录像

在录像的过程中，可以通过发送WM_STOP消息停止录像，核心代码如下：

SendMessage(Hwnd,WM_STOP,0,0) '停止

六、断开设备连接

在不需要捕捉图像时，应断开连接，以便释放系统资源，通过发送WM_DisCN消息可以断

开视窗连接，然后用DestroyWindow函数清除视频窗口以释放资源，核心代码如下：

Private Sub ClosePreviewWindow()

SendMessage(Hwnd,WM_DisCN,0,0)

DestroyWindow(Hwnd) '关闭视窗

Cned = False '断开标志

End Sub

【编程实现】

启动VB2005，新建应用程序项目，向窗体添加一个图片框控件PC（视频显示），一个保存对话框控件SaveDlg（设置图像保存文件名），一个主菜单控件MenuStrip1，添加6个菜单项mCn（连接）、mPic（抓图）、mRec（录像）、mStop（停止）、mCut（断开），mSt（提示），合理布局，并根据以上分析完善代码。

安装好摄像头，运行程序，点击“连接”菜单，在图片框中就可以看到来自摄像头的图像了，有趣的是，当摄像头对准程序运行的屏幕时，在捕获的运行界面上出现了程序界面嵌套的效果。程序运行结果如图所示，调试环境：WinXp+VB2005，源码下载地址：

/down/200641/。

图：程序抓取的图片 dtc09

【编程后记】

本文通过VFW的模块实现了摄像头视频的实时采集，采集的图像除在计算机屏幕上实时显示外，还可以通过录像功能保存到AVI文件，以便日后回放，如果您的视频采集设备支持语音输入（如数码摄像机），那么形成的AVI录像文件会自动包含音频部分。程序还可以考虑采用实时拍照的方式来“连续”监控（比如每秒抓图一次），设计这个功能可以大大节约磁盘空间，因为每秒一张的图片大小仅10KB左右，而平均每秒的录像数据有2MB之多，至少是图片数据的200倍，具体的实现方法留给读者思考！

Imports Basic

Imports 32

'VideoCampture using

Public Class Form1

Inherits

#Region " Windows 窗体设计器生成的代码 "

Public Sub New()

()

'该调用是 Windows 窗体设计器所必需的。

InitializeComponent()

'在 InitializeComponent() 调用之后添加任何初始化

End Sub

'窗体重写 dispose 以清理组件列表。

Protected Overloads Overrides Sub Dispose(ByVal disposing As Boolean)

If disposing Then

If Not (components Is Nothing) Then

e()

End If

End If

e(disposing)

End Sub

'Windows 窗体设计器所必需的

Private components As iner

'注意: 以下过程是 Windows 窗体设计器所必需的

'可以使用 Windows 窗体设计器修改此过程。

'不要使用代码编辑器修改它。

Friend WithEvents camSrc As eBox

Friend WithEvents Button1 As

Private Sub InitializeComponent()

= New eBox

1 = New

dLayout()

'

'camSrc

'

on = New (8, 8)

= "camSrc"

= New (320, 240)

ex = 0

p = False

'

'Button1

'

on = New (8, 256)

= "Button1"

= New (75, 32)

ex = 1

= "关闭"

'

'Form1

'

aleBaseSize = New (6, 14)

Size = New (336, 294)

(1)

()

= "Form1"

= "VideoCampture"

Layout(False)

End Sub

#End Region

Private Sub Form1_Load(ByVal sender As , ByVal e As rgs)

Handles

MapWebcamToWindow(, , 32)

End Sub

Public lwndC As Integer

Public Const WS_CHILD As Integer = &H40000000

Public Const WS_VISIBLE As Integer = &H10000000

Public Const SWP_NOMOVE As Short = &H2S

Public Const SWP_NOZORDER As Short = &H4S

Public Const WM_USER As Short = &H400S

Public Const WM_CAP_DRIVER_CONNECT As Integer = WM_USER + 10

Public Const WM_CAP_DRIVER_DISCONNECT As Integer = WM_USER + 11

Public Const WM_CAP_SET_VIDEOFORMAT As Integer = WM_USER + 45

Public Const WM_CAP_SET_PREVIEW As Integer = WM_USER + 50

Public Const WM_CAP_SET_PREVIEWRATE As Integer = WM_USER + 52

Public Structure BITMAPINFOHEADER

Dim biSize As Integer

Dim biWidth As Integer

Dim biHeight As Integer

Dim biPlanes As Short

Dim biBitCount As Short

Dim biCompression As Integer

Dim biSizeImage As Integer

Dim biXPelsPerMeter As Integer

Dim biYPelsPerMeter As Integer

Dim biClrUsed As Integer

Dim biClrImportant As Integer

End Structure

Public Structure BITMAPINFO

Dim bmiHeader As BITMAPINFOHEADER

Dim bmiColors() As Integer

End Structure

Declare Function SetWindowPos Lib "user32" (ByVal hWnd As Integer, ByVal

hWndInsertAfter As Integer, ByVal x As Integer, ByVal y As Integer, ByVal cx As Integer, ByVal

cy As Integer, ByVal wFlags As Integer) As Integer

Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As

Integer, ByVal wMsg As Integer, ByVal wParam As Short, ByVal lParam As Integer) As Integer

Declare Function SendMessageAsBitMap Lib "user32" Alias "SendMessageA" (ByVal

hWnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, ByRef lParam As

BITMAPINFO) As Integer

Declare Function capCreateCaptureWindowA Lib "" (ByVal lpszWindowName

As String, ByVal dwStyle As Integer, ByVal x As Integer, ByVal y As Integer, ByVal nWidth As

Integer, ByVal nHeight As Short, ByVal hWndParent As Integer, ByVal nID As Integer) As Integer

Declare Function capGetDriverDescriptionA Lib "" (ByVal wDriver As Short,

ByVal lpszName As String, ByVal cbName As Integer, ByVal lpszVer As String, ByVal cbVer As

Integer) As Boolean

Function capDriverConnect(ByVal lwnd As Integer, ByVal i As Short) As Boolean

capDriverConnect = SendMessage(lwnd, WM_CAP_DRIVER_CONNECT, i, 0)

End Function

Function capDriverDisconnect(ByVal lwnd As Integer) As Boolean

capDriverDisconnect = SendMessage(lwnd, WM_CAP_DRIVER_DISCONNECT, 0, 0)

End Function

Function capSetVideoFormat(ByVal hCapWnd As Integer, ByRef BmpFormat As

BITMAPINFO, ByVal CapFormatSize As Integer) As Boolean

capSetVideoFormat = SendMessageAsBitMap(hCapWnd,

WM_CAP_SET_VIDEOFORMAT, CapFormatSize, BmpFormat)

End Function

Function capPreview(ByVal lwnd As Integer, ByVal f As Boolean) As Boolean

capPreview = SendMessage(lwnd, WM_CAP_SET_PREVIEW, f, 0)

End Function

'The capPreview function is used to initiate the streaming of images between the VFW driver

and the capture window.

Function capPreviewRate(ByVal lwnd As Integer, ByVal wMS As Short) As Boolean

capPreviewRate = SendMessage(lwnd, WM_CAP_SET_PREVIEWRATE, wMS, 0)

End Function

'The capPreviewRate function determines the refresh rate by specifying the refresh interval in

milliseconds. In our case, it is set to 66 ms (15 Frames Per second).

'Now, we must implement the two functions referenced by the main form as follows ?

Sub MapWebcamToWindow(ByRef lWidth As Integer, ByRef lHeight As Integer, ByRef

hWnd As Integer)

' Dim lpszName As New engthString(100)

Dim lpszName As New VBFixedStringAttribute(100)

Dim bmp As BITMAPINFO

With der

.biSize = Len(der)

.biWidth = 320

.biHeight = 240

.biPlanes = 1

.biBitCount = 24

End With

' capGetDriverDescriptionA(0, , 100, Nothing, 100)

'lwndC = capCreateCaptureWindowA(, WS_VISIBLE Or WS_CHILD,

0, 0, lWidth, lHeight, hWnd, 0)

capGetDriverDescriptionA(0, , 100, Nothing, 100)

lwndC = capCreateCaptureWindowA(, WS_VISIBLE Or WS_CHILD,

0, 0, lWidth, lHeight, hWnd, 0)

If capDriverConnect(lwndC, 0) Then

capPreviewRate(lwndC, 66)

capPreview(lwndC, True)

capSetVideoFormat(lwndC, bmp, Len(bmp))

SetWindowPos(lwndC, 0, 0, 0, h, ht,

SWP_NOMOVE Or SWP_NOZORDER)

End If

End Sub

'The MapWebcamToWindow sub performs the following tasks

'Retrieves the name of the first available VFW driver.

'Creates a capture window, and attaches it to a given window handle.

'Connects the VFW driver to the capture window

'Sets the refresh rate to 15 frames per second

'Initiates the transfer of video between the VFW driver and capture window

'Sets the video format to 320x240

'Moves and stretches the capture window to 320 x 240 pixels

'Finally, we provide our CloseWebcam function to perform the cleanup

Sub CloseWebcam()

capDriverDisconnect(lwndC)

End Sub

Dim cc As VBFixedStringAttribute

Private Sub Form1_Closed(ByVal sender As Object, ByVal e As rgs) Handles

CloseWebcam()

End Sub

Private Sub Button1_Click(ByVal sender As , ByVal e As rgs)

Handles

If = "关闭" Then

CloseWebcam()

= "显示"

Else : MapWebcamToWindow(, , 32)

= "关闭"

End If

End Sub

Private Sub Form1_Click(ByVal sender As Object, ByVal e As rgs) Handles

MsgBox("VideoCampture Power By wgscd 自由奔腾 2004-12 QQ：153964481

E-mail:wgscd@ ", , "版权所有")

End Sub

End Class