'请尊重著作权!谢绝转摘,有疑问请与作者联系!
Imports Microsoft.VisualBasic
Imports Microsoft.Win32
'VideoCampture using VB.NET
' author:自由奔腾 wgscd@126.com
'www.topds.com
'QQ:153964481 website: http://www.topds.com
' 2004 11-26
Public Class Form1
Inherits System.Windows.Forms.Form
#Region " Windows 窗体设计器生成的代码 "
Public Sub New()
MyBase.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
components.Dispose()
End If
End If
MyBase.Dispose(disposing)
End Sub
'Windows 窗体设计器所必需的
Private components As System.ComponentModel.IContainer
'注意: 以下过程是 Windows 窗体设计器所必需的
'可以使用 Windows 窗体设计器修改此过程。
'不要使用代码编辑器修改它。
Friend WithEvents camSrc As System.Windows.Forms.PictureBox
Friend WithEvents Button1 As System.Windows.Forms.Button
<System.Diagnostics.DebuggerStepThrough()> Private Sub InitializeComponent()
Me.camSrc = New System.Windows.Forms.PictureBox
Me.Button1 = New System.Windows.Forms.Button
Me.SuspendLayout()
'
'camSrc
'
Me.camSrc.Location = New System.Drawing.Point(8, 8)
Me.camSrc.Name = "camSrc"
Me.camSrc.Size = New System.Drawing.Size(320, 240)
Me.camSrc.TabIndex = 0
Me.camSrc.TabStop = False
'
'Button1
'
Me.Button1.Location = New System.Drawing.Point(8, 256)
Me.Button1.Name = "Button1"
Me.Button1.Size = New System.Drawing.Size(75, 32)
Me.Button1.TabIndex = 1
Me.Button1.Text = "关闭"
'
'Form1
'
Me.AutoScaleBaseSize = New System.Drawing.Size(6, 14)
Me.ClientSize = New System.Drawing.Size(336, 294)
Me.Controls.Add(Me.Button1)
Me.Controls.Add(Me.camSrc)
Me.Name = "Form1"
Me.Text = "VideoCampture"
Me.ResumeLayout(False)
End Sub
#End Region
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
MapWebcamToWindow(camSrc.Width, camSrc.Height, camSrc.Handle.ToInt32)
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 "avicap32.dll" (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 "avicap32.dll" (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 VB6.FixedLengthString(100)
Dim lpszName As New VBFixedStringAttribute(100)
Dim bmp As BITMAPINFO
With bmp.bmiHeader
.biSize = Len(bmp.bmiHeader)
.biWidth = 320
.biHeight = 240
.biPlanes = 1
.biBitCount = 24
End With
' capGetDriverDescriptionA(0, lpszName.Value, 100, Nothing, 100)
'lwndC = capCreateCaptureWindowA(lpszName.Value, WS_VISIBLE Or WS_CHILD, 0, 0, lWidth, lHeight, hWnd, 0)
capGetDriverDescriptionA(0, lpszName.Length, 100, Nothing, 100)
lwndC = capCreateCaptureWindowA(lpszName.Length, 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, bmp.bmiHeader.biWidth, bmp.bmiHeader.biHeight, 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 System.EventArgs) Handles MyBase.Closed
CloseWebcam()
End Sub
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
If Button1.Text = "关闭" Then
CloseWebcam()
Button1.Text = "显示"
Else : MapWebcamToWindow(camSrc.Width, camSrc.Height, camSrc.Handle.ToInt32)
Button1.Text = "关闭"
End If
End Sub
Private Sub Form1_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles MyBase.Click
MsgBox("VideoCampture Power By wgscd 自由奔腾 2004-12 QQ:153964481 E-mail:wgscd@126.com www.topds.com", MsgBoxStyle.OKOnly, "版权所有")
End Sub
End Class