Please respect the copyright and reprint, please indicate the author and the source.
Imports Microsoft.VisualBasicImports Microsoft.Win32'VideoCampture using VB.NET 'author: Freedom Pentium (vwgscd) wgscd@126.com' www.wgscd.com'QQ: 153964481 '2004 11-26Public Class Form1 Inherits System.Windows.Forms. FORM
#Region "Windows Form Designer Generated Code"
Public Sub new () mybase.new ()
'This call is required for the Windows Form Designer. InitializeComponent ()
'Add any initialization after INITIALIZECOMPONENT ()
End Sub
'Form rewriting Dispose to clean up the list of components. Protected overloads overrides sub dispose (byval disposing as boolean) ing disponation kiln (Components Is Nothing) Then components.dispose () end if endiffs) End sub
'Windows Form Designer Supply Private Components as System.comPonentModel.icontainer
'Note: The following procedure is necessary to use the Windows Form Designer to modify this process using the Windows Form Designer. 'Don't modify it using the code editor. Friend WithEvents camSrc As System.Windows.Forms.PictureBox Friend WithEvents Button1 As System.Windows.Forms.Button
#End region
Private Sub Form1_Load (Byval E 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 in integer = & h10000000
Public const swP_nomove as short = & h2spublic const swP_nozorder as shert = & h4s
Public const wm_user as shrnet = & 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 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 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 IntegerDeclare 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 Dermines 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, limht, 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 cleanupSub CloseWebcam () CAPDRIVERDISCONNECT (LWNDC)
End Sub
DIM CC as vbfixedstringattribute
Private Sub Form1_closed (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 = "Close" Then CloseWebcam () Button1.Text = "Display" Else: MapWebcamToWindow (camSrc.Width, camSrc .Height32) Button1.text = "Close" 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 consisting Pentium 2004-12 QQ: 153964481 E-mail: wgscd@126.com www.wgscd.com" , Msgboxstyle.okonly, "copyright")
End Subend Class
