|
源代码网推荐
"-------------------------------------------------
"--------Code By Ken Tucker-------------
"-------------------------------------------------
Imports System.Runtime.InteropServices
Public Class Form1
源代码网推荐 Inherits System.Windows.Forms.Form
#Region " Windows Form Designer generated code "
Public Sub New()
源代码网推荐 MyBase.New()
"This call is required by the Windows Form Designer.
源代码网推荐 InitializeComponent()
"Add any initialization after the InitializeComponent() call
End Sub
"Form overrides dispose to clean up the component list.
源代码网推荐 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
"Required by the Windows Form Designer
源代码网推荐 Private components As System.ComponentModel.IContainer
"NOTE: The following procedure is required by the Windows Form Designer
源代码网推荐 "It can be modified using the Windows Form Designer.
源代码网推荐 "Do not modify it using the code editor.
源代码网推荐 Friend WithEvents picCapture As System.Windows.Forms.PictureBox
源代码网推荐 Friend WithEvents lstDevices As System.Windows.Forms.ListBox
源代码网推荐 Friend WithEvents lblDevice As System.Windows.Forms.Label
源代码网推荐 Friend WithEvents btnStart As System.Windows.Forms.Button
源代码网推荐 Friend WithEvents btnSave As System.Windows.Forms.Button
源代码网推荐 Friend WithEvents btnStop As System.Windows.Forms.Button
源代码网推荐 Friend WithEvents sfdImage As System.Windows.Forms.SaveFileDialog
源代码网推荐 <System.Diagnostics.DebuggerStepThrough()> Private Sub InitializeComponent()
源代码网推荐 Me.picCapture = New System.Windows.Forms.PictureBox()
源代码网推荐 Me.lstDevices = New System.Windows.Forms.ListBox()
源代码网推荐 Me.lblDevice = New System.Windows.Forms.Label()
源代码网推荐 Me.btnStart = New System.Windows.Forms.Button()
源代码网推荐 Me.btnSave = New System.Windows.Forms.Button()
源代码网推荐 Me.btnStop = New System.Windows.Forms.Button()
源代码网推荐 Me.sfdImage = New System.Windows.Forms.SaveFileDialog()
源代码网推荐 Me.SuspendLayout()
源代码网推荐 "
源代码网推荐 "picCapture
源代码网推荐 "
源代码网推荐 Me.picCapture.BorderStyle = System.Windows.Forms.BorderStyle.Fixed3D
源代码网推荐 Me.picCapture.Location = New System.Drawing.Point(208, 24)
源代码网推荐 Me.picCapture.Name = "picCapture"
源代码网推荐 Me.picCapture.Size = New System.Drawing.Size(256, 272)
源代码网推荐 Me.picCapture.TabIndex = 0
源代码网推荐 Me.picCapture.TabStop = False
源代码网推荐 "
源代码网推荐 "lstDevices
源代码网推荐 "
源代码网推荐 Me.lstDevices.Location = New System.Drawing.Point(8, 55)
源代码网推荐 Me.lstDevices.Name = "lstDevices"
源代码网推荐 Me.lstDevices.Size = New System.Drawing.Size(184, 238)
源代码网推荐 Me.lstDevices.TabIndex = 1
源代码网推荐 "
源代码网推荐 "lblDevice
源代码网推荐 "
源代码网推荐 Me.lblDevice.Location = New System.Drawing.Point(8, 32)
源代码网推荐 Me.lblDevice.Name = "lblDevice"
源代码网推荐 Me.lblDevice.Size = New System.Drawing.Size(184, 16)
源代码网推荐 Me.lblDevice.TabIndex = 2
源代码网推荐 Me.lblDevice.Text = "Available Devices"
源代码网推荐 Me.lblDevice.TextAlign = System.Drawing.ContentAlignment.TopCenter
源代码网推荐 "
源代码网推荐 "btnStart
源代码网推荐 "
源代码网推荐 Me.btnStart.Location = New System.Drawing.Point(20, 320)
源代码网推荐 Me.btnStart.Name = "btnStart"
源代码网推荐 Me.btnStart.Size = New System.Drawing.Size(112, 32)
源代码网推荐 Me.btnStart.TabIndex = 3
源代码网推荐 Me.btnStart.Text = "Start Preview"
源代码网推荐 "
源代码网推荐 "btnSave
源代码网推荐 "
源代码网推荐 Me.btnSave.Anchor = (System.Windows.Forms.AnchorStyles.Bottom Or System.Windows.Forms.AnchorStyles.Right)
源代码网推荐 Me.btnSave.Location = New System.Drawing.Point(348, 320)
源代码网推荐 Me.btnSave.Name = "btnSave"
源代码网推荐 Me.btnSave.Size = New System.Drawing.Size(112, 32)
源代码网推荐 Me.btnSave.TabIndex = 4
源代码网推荐 Me.btnSave.Text = "Save Image"
源代码网推荐 "
源代码网推荐 "btnStop
源代码网推荐 "
源代码网推荐 Me.btnStop.Location = New System.Drawing.Point(184, 320)
源代码网推荐 Me.btnStop.Name = "btnStop"
源代码网推荐 Me.btnStop.Size = New System.Drawing.Size(112, 32)
源代码网推荐 Me.btnStop.TabIndex = 5
源代码网推荐 Me.btnStop.Text = "Stop Preview"
源代码网推荐 "
源代码网推荐 "sfdImage
源代码网推荐 "
源代码网推荐 Me.sfdImage.FileName = "Webcam1"
源代码网推荐 Me.sfdImage.Filter = "Bitmap|*.bmp"
源代码网推荐 "
源代码网推荐 "Form1
源代码网推荐 "
源代码网推荐 Me.AutoScaleBaseSize = New System.Drawing.Size(5, 13)
源代码网推荐 Me.ClientSize = New System.Drawing.Size(480, 382)
源代码网推荐 Me.Controls.AddRange(New System.Windows.Forms.Control() {Me.btnStop, Me.btnSave, Me.btnStart, Me.lblDevice, Me.lstDevices, Me.picCapture})
源代码网推荐 Me.Name = "Form1"
源代码网推荐 Me.StartPosition = System.Windows.Forms.FormStartPosition.CenterScreen
源代码网推荐 Me.Text = "Video Capture"
源代码网推荐 Me.ResumeLayout(False)
End Sub
#End Region
Const WM_CAP As Short = &H400S
Const WM_CAP_DRIVER_CONNECT As Integer = WM_CAP + 10
源代码网推荐 Const WM_CAP_DRIVER_DISCONNECT As Integer = WM_CAP + 11
源代码网推荐 Const WM_CAP_EDIT_COPY As Integer = WM_CAP + 30
Const WM_CAP_SET_PREVIEW As Integer = WM_CAP + 50
源代码网推荐 Const WM_CAP_SET_PREVIEWRATE As Integer = WM_CAP + 52
源代码网推荐 Const WM_CAP_SET_SCALE As Integer = WM_CAP + 53
源代码网推荐 Const WS_CHILD As Integer = &H40000000
源代码网推荐 Const WS_VISIBLE As Integer = &H10000000
源代码网推荐 Const SWP_NOMOVE As Short = &H2S
源代码网推荐 Const SWP_NOSIZE As Short = 1
源代码网推荐 Const SWP_NOZORDER As Short = &H4S
源代码网推荐 Const HWND_BOTTOM As Short = 1
Dim iDevice As Integer = 0 " Current device ID
源代码网推荐 Dim hHwnd As Integer " Handle to preview window
Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
源代码网推荐 (ByVal hwnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, _
源代码网推荐 <MarshalAs(UnmanagedType.AsAny)> ByVal lParam As Object) As Integer
Declare Function SetWindowPos Lib "user32" Alias "SetWindowPos" (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 DestroyWindow Lib "user32" (ByVal hndw As Integer) As Boolean
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
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
源代码网推荐 LoadDeviceList()
源代码网推荐 If lstDevices.Items.Count > 0 Then
源代码网推荐 btnStart.Enabled = True
源代码网推荐 lstDevices.SelectedIndex = 0
源代码网推荐 btnStart.Enabled = True
源代码网推荐 Else
源代码网推荐 lstDevices.Items.Add("No Capture Device")
源代码网推荐 btnStart.Enabled = False
源代码网推荐 End If
btnStop.Enabled = False
源代码网推荐 btnSave.Enabled = False
源代码网推荐 picCapture.SizeMode = PictureBoxSizeMode.StretchImage
源代码网推荐 End Sub
Private Sub LoadDeviceList()
源代码网推荐 Dim strName As String = Space(100)
源代码网推荐 Dim strVer As String = Space(100)
源代码网推荐 Dim bReturn As Boolean
源代码网推荐 Dim x As Integer = 0
"
源代码网推荐 " Load name of all avialable devices into the lstDevices
源代码网推荐 "
Do
源代码网推荐 "
源代码网推荐 " Get Driver name and version
源代码网推荐 "
源代码网推荐 bReturn = capGetDriverDescriptionA(x, strName, 100, strVer, 100)
"
源代码网推荐 " If there was a device add device name to the list
源代码网推荐 "
源代码网推荐 If bReturn Then lstDevices.Items.Add(strName.Trim)
源代码网推荐 x += 1
源代码网推荐 Loop Until bReturn = False
源代码网推荐 End Sub
Private Sub OpenPreviewWindow()
源代码网推荐 Dim iHeight As Integer = picCapture.Height
源代码网推荐 Dim iWidth As Integer = picCapture.Width
"
源代码网推荐 " Open Preview window in picturebox
源代码网推荐 "
源代码网推荐 hHwnd = capCreateCaptureWindowA(iDevice, WS_VISIBLE Or WS_CHILD, 0, 0, 640, _
源代码网推荐 480, picCapture.Handle.ToInt32, 0)
"
源代码网推荐 " Connect to device
源代码网推荐 "
源代码网推荐 If SendMessage(hHwnd, WM_CAP_DRIVER_CONNECT, iDevice, 0) Then
源代码网推荐 "
源代码网推荐 "Set the preview scale
源代码网推荐 "
源代码网推荐 SendMessage(hHwnd, WM_CAP_SET_SCALE, True, 0)
"
源代码网推荐 "Set the preview rate in milliseconds
源代码网推荐 "
源代码网推荐 SendMessage(hHwnd, WM_CAP_SET_PREVIEWRATE, 66, 0)
"
源代码网推荐 "Start previewing the image from the camera
源代码网推荐 "
源代码网推荐 SendMessage(hHwnd, WM_CAP_SET_PREVIEW, True, 0)
"
源代码网推荐 " Resize window to fit in picturebox
源代码网推荐 "
源代码网推荐 SetWindowPos(hHwnd, HWND_BOTTOM, 0, 0, picCapture.Width, picCapture.Height, _
源代码网推荐 SWP_NOMOVE Or SWP_NOZORDER)
btnSave.Enabled = True
源代码网推荐 btnStop.Enabled = True
源代码网推荐 btnStart.Enabled = False
源代码网推荐 Else
源代码网推荐 "
源代码网推荐 " Error connecting to device close window
源代码网推荐 "
源代码网推荐 DestroyWindow(hHwnd)
btnSave.Enabled = False
源代码网推荐 End If
源代码网推荐 End Sub
Private Sub btnStart_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnStart.Click
源代码网推荐 iDevice = lstDevices.SelectedIndex
源代码网推荐 OpenPreviewWindow()
源代码网推荐 End Sub
Private Sub ClosePreviewWindow()
源代码网推荐 "
源代码网推荐 " Disconnect from device
源代码网推荐 "
源代码网推荐 SendMessage(hHwnd, WM_CAP_DRIVER_DISCONNECT, iDevice, 0)
"
源代码网推荐 " close window
源代码网推荐 "
DestroyWindow(hHwnd)
源代码网推荐 End Sub
Private Sub btnStop_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnStop.Click
源代码网推荐 ClosePreviewWindow()
源代码网推荐 btnSave.Enabled = False
源代码网推荐 btnStart.Enabled = True
源代码网推荐 btnStop.Enabled = False
源代码网推荐 End Sub
Private Sub btnSave_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnSave.Click
源代码网推荐 Dim data As IDataObject
源代码网推荐 Dim bmap As Image
"
源代码网推荐 " Copy image to clipboard
源代码网推荐 "
源代码网推荐 SendMessage(hHwnd, WM_CAP_EDIT_COPY, 0, 0)
"
源代码网推荐 " Get image from clipboard and convert it to a bitmap
源代码网推荐 "
源代码网推荐 data = Clipboard.GetDataObject()
源代码网推荐 If data.GetDataPresent(GetType(System.Drawing.Bitmap)) Then
源代码网推荐 bmap = CType(data.GetData(GetType(System.Drawing.Bitmap)), Image)
源代码网推荐 picCapture.Image = bmap
源代码网推荐 ClosePreviewWindow()
源代码网推荐 btnSave.Enabled = False
源代码网推荐 btnStop.Enabled = False
源代码网推荐 btnStart.Enabled = True
If sfdImage.ShowDialog = DialogResult.OK Then
源代码网推荐 bmap.Save(sfdImage.FileName, Imaging.ImageFormat.Bmp)
源代码网推荐 End If
End If
源代码网推荐 End Sub
Private Sub Form1_Closing(ByVal sender As Object, ByVal e As System.ComponentModel.CancelEventArgs) Handles MyBase.Closing
源代码网推荐 If btnStop.Enabled Then
源代码网推荐 ClosePreviewWindow()
源代码网推荐 End If
源代码网推荐 End Sub
源代码网推荐End Class
源代码网推荐
源代码网供稿. | 
