VS2010旗舰版VB.Net摄像头拍照程序代码

Public Class Form1

'定义常量
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
Const WM_CAP_SAVEDIB As Integer = WM_CAP + 25


Dim iDevice As Integer = 0  '设备 ID
Dim hHwnd As Integer  '预览窗口句柄

'声明函数
Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
    (ByVal hwnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, _
     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 LoadDeviceList()
    Dim strName As String = Space(100)
    Dim strVer As String = Space(100)
    Dim bReturn As Boolean
    Dim x As Integer = 0

    Do
        '获取驱动名称和版本
        bReturn = capGetDriverDescriptionA(x, strName, 100, strVer, 100)
        '如果有设备，将其名称添加到列表中
        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

    hHwnd = capCreateCaptureWindowA(iDevice, WS_VISIBLE Or WS_CHILD, 0, 0, picCapture.Width, picCapture.Height, picCapture.Handle.ToInt32, 0)

    '尝试连接设备
    If ConnectToDevice() Then
        '设置预览相关参数
        SetPreviewSettings()
        '调整窗口大小以适应图片框
        ResizePreviewWindow()
        btnSave.Enabled = True
        btnStop.Enabled = True
        btnStart.Enabled = False
    Else
        '连接设备出错处理
        DestroyWindow(hHwnd)
        btnSave.Enabled = False
        MessageBox.Show("连接设备出错，请检查设备是否正常连接或驱动是否安装正确。")
    End If
End Sub

'连接设备的函数
Private Function ConnectToDevice() As Boolean
    Return SendMessage(hHwnd, WM_CAP_DRIVER_CONNECT, iDevice, 0) <> 0
End Function

'设置预览的相关设置
Private Sub SetPreviewSettings()
    SendMessage(hHwnd, WM_CAP_SET_SCALE, True, 0)
    SendMessage(hHwnd, WM_CAP_SET_PREVIEWRATE, 66, 0)
    SendMessage(hHwnd, WM_CAP_SET_PREVIEW, True, 0)
End Sub

'调整预览窗口大小
Private Sub ResizePreviewWindow()
    SetWindowPos(hHwnd, HWND_BOTTOM, 0, 0, picCapture.Width, picCapture.Height, SWP_NOMOVE Or SWP_NOZORDER)
End Sub

'保存图片的点击事件
Private Sub btnSave_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnSave.Click
    Using sfdImage As New SaveFileDialog()
        sfdImage.Filter = "JPEG 图像|*.jpg;|PNG 图像|*.png;|BMP 图像|*.bmp;|GIF 图像|*.gif"
        If sfdImage.ShowDialog() = DialogResult.OK Then
            Dim selectedFile As String = sfdImage.FileName
            Dim bmp As New Bitmap(picSaved.Width, picSaved.Height) '根据您的预览窗口大小设置
            Dim fileExtension As String = System.IO.Path.GetExtension(selectedFile).ToLower()
            Try
                Select Case fileExtension
                    Case ".bmp"
                        picSaved.Image.Save(selectedFile, System.Drawing.Imaging.ImageFormat.Bmp)
                    Case ".jpg"
                        picSaved.Image.Save(selectedFile, System.Drawing.Imaging.ImageFormat.Jpeg)
                    Case ".png"
                        picSaved.Image.Save(selectedFile, System.Drawing.Imaging.ImageFormat.Png)
                    Case ".gif"
                        picSaved.Image.Save(selectedFile, System.Drawing.Imaging.ImageFormat.Gif)
                    Case Else
                        MessageBox.Show("不支持的图片格式！")
                End Select
            Catch ex As Exception
                MessageBox.Show("保存图片时出错：" & ex.Message) '加错误提示
            End Try
        End If
    End Using
End Sub

'拍照功能
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
    Dim bmp As New Bitmap(picCapture.Width, picCapture.Height) '设拍照分辨率为 640x480，您可以根据实际需求修改

    Dim g As Graphics = Graphics.FromImage(bmp)
    g.CopyFromScreen(New Point(picCapture.Width, picCapture.Height), Point.Empty, picCapture.Size)


    '拍照的图片显示在另一个图片框（picSaved）中
    picSaved.Image = bmp

End Sub

'复制图像到剪贴板的函数
Private Function CopyToClipboard() As Boolean
    Return SendMessage(hHwnd, WM_CAP_EDIT_COPY, 0, 0) <> 0
End Function

'关闭预览窗口
Private Sub ClosePreviewWindow()
    '断开与设备的连接
    If DisconnectFromDevice() Then
        '销毁窗口
        If DestroyWindow(hHwnd) Then
            '关闭成功后的处理
        Else
            MessageBox.Show("销毁预览窗口时出错。")
        End If
    Else
        MessageBox.Show("断开与设备的连接时出错。")
    End If
End Sub

'断开与设备连接的函数
Private Function DisconnectFromDevice() As Boolean
    Return SendMessage(hHwnd, WM_CAP_DRIVER_DISCONNECT, iDevice, 0) <> 0
End Function

'开始按钮的点击事件
Private Sub btnStart_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnStart.Click
    OpenPreviewWindow()
End Sub

'停止按钮的点击事件
Private Sub btnStop_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnStop.Click
    ClosePreviewWindow()
End Sub

End Class