VB.NET版本拍照录像代码QZQ

Imports System.Runtime.InteropServices
Imports System.IO

Public Class Form1

'定义常量
Private Const WS_Child As Integer = &H40000000
Private Const WS_Visible As Integer = &H10000000
Private Const WS_Text As Integer = &HC00000
Private Const WS_ThickFrame As Integer = &H40000
Private Const WM_User As Integer = &H400

Private Const WM_CAP_Connect As Integer = WM_User + 10
Private Const WM_CAP_DisConnect As Integer = WM_User + 11
Private Const WM_CAP_Set_PreView As Integer = WM_User + 50
Private Const WM_CAP_Set_Overlay As Integer = WM_User + 51
Private Const WM_CAP_Set_PreViewRate As Integer = WM_User + 52
Private Const WM_CAP_Edit_Copy As Integer = WM_User + 30
Private Const WM_CAP_Sequence As Integer = WM_User + 62
Private Const WM_Cap_File_Set_File As Integer = WM_User + 20
Private Const WM_Cap_File_Get_File As Integer = WM_User + 21
Private Const WM_CAP_SINGLE_FRAME_OPEN As Integer = &H4000 + 60
Private Const WM_CAP_SINGLE_FRAME_CLOSE As Integer = &H4000 + 61
Private Const WM_CAP_SINGLE_FRAME As Integer = &H4000 + 70



'声明外部函数
<DllImport("user32.dll", CharSet:=CharSet.Auto)>
Private Shared Function SendMessage(ByVal hWnd As IntPtr, ByVal Msg As Integer, ByVal wParam As IntPtr, ByVal lParam As IntPtr) As IntPtr
End Function

<DllImport("avicap32.dll", CharSet:=CharSet.Auto)>
Private Shared Function capCreateCaptureWindow(ByVal lpszWindowName As String, ByVal dwStyle As Integer, ByVal X As Integer, ByVal Y As Integer, ByVal nWidth As Integer, ByVal nHeight As Integer, ByVal hwndParent As IntPtr, ByVal nID As Integer) As IntPtr
End Function

Private ctCapWin As IntPtr
Private ctAviPath As String
Private ctPicPath As String
Private ctConnect As Boolean



Private Sub Form_Load(ByVal sender As Object, ByVal e As EventArgs) Handles MyBase.Load
    Me.Text = "摄像头控制"
    Button1.Text = "连接"

    Button2.Text = "断开"

    Button3.Text = "截图"

    Button4.Text = "录像"


    '读出用户设置
    Call ReadSaveSet()
    KjEnabled(True)
End Sub

Private Sub ReadSaveSet(Optional ByVal IsSave As Boolean = False)
    '保存或读出用户设置的图片和视频默认保存目录
    Dim nKey As String = "摄像头控制程序"
    Dim nSub As String = "UserOpt"

    If IsSave Then
        SaveSetting(nKey, nSub, "AviPath", ctAviPath)
        SaveSetting(nKey, nSub, "PicPath", ctPicPath)
    Else
        ctAviPath = GetSetting(nKey, nSub, "AviPath", "")
        ctPicPath = GetSetting(nKey, nSub, "PicPath", "")
    End If
End Sub

Private Sub Form_Unload(ByVal Cancel As Integer)
    Call ReadSaveSet(True) '保存用户设置
End Sub

Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
    '创建视频窗口和连接摄像头
    Dim nStyle As Integer
    Dim T As Integer

    If ctCapWin = IntPtr.Zero Then '创建一个视频窗口，大小：640*480
        T = (Button1.Top + Button1.Height * 1.1) '视频窗口垂直位置：像素
        'nStyle = WS_Child + WS_Visible + WS_Text + WS_ThickFrame '窗口(在 Form1 内)+可见+标题栏+边框
        nStyle = WS_Child + WS_Visible '视频窗口无标题栏和边框
        'nStyle = WS_Visible '视频窗口为独立窗口，关闭主窗口视频窗口也会自动关闭
        ctCapWin = capCreateCaptureWindow("我创建的视频窗口", nStyle, 0, T, 640, 480, Me.Handle, 0)
    End If

    '视频窗口连接到摄像头，如无后面两条语句视频窗口画面不会变化
    SendMessage(ctCapWin, WM_CAP_Connect, IntPtr.Zero, IntPtr.Zero) '连接摄像头
    SendMessage(ctCapWin, WM_CAP_Set_PreView, 1, IntPtr.Zero) '第三个参数：1 - 预览模式有效, 0 - 预览模式无效
    SendMessage(ctCapWin, WM_CAP_Set_PreViewRate, 30, IntPtr.Zero) '第三个参数：设置预览显示频率为每秒 30 帧
    ctConnect = True
    KjEnabled(True)
    '请检检查摄像头连接，并确定没有其他用户和程序使用。"
End Sub

Private Sub KjEnabled(ByVal nEnabled As Boolean)
    If nEnabled Then
        Button1.Enabled = Not ctConnect
        Button2.Enabled = ctConnect
        Button3.Enabled = ctConnect
        Button4.Enabled = ctConnect
    Else
        Button1.Enabled = nEnabled
        Button2.Enabled = nEnabled
        Button3.Enabled = nEnabled
        Button4.Enabled = nEnabled
    End If
End Sub

Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
    SendMessage(ctCapWin, WM_CAP_Disconnect, 0, 0)  '断开摄像头连接
    ctConnect = False : KjEnabled(True)
End Sub
Private Sub Button3_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button3.Click
    '截图，保存为图片文件
    Dim F As String
    Dim S As Integer
    Dim nPath As String
    Dim nStr As String

    nPath = Trim(ctPicPath)
  

    On Error Resume Next
    Do
        S = S + 1
        F = nPath & "MyPic_" & DateTime.Now.ToString("yyyyMMddHHmmss") & ".bmp" '用当前的日期时间生成不同的文件名
        If Dir(F, 23) = "" Then Exit Do
    Loop

    nStr = Trim(InputBox("设置图片保存的文件名:", "保存图片", F))
    If nStr = "" Then Exit Sub
    If Not System.IO.Directory.Exists(nPath) Then System.IO.Directory.CreateDirectory(nPath)

    ctPicPath = nPath
    F = nPath & F

    If File.Exists(F) Then
        If vbCancel = MsgBox("文件已存在，覆盖此文件吗？" & vbCrLf & F, vbInformation + vbOKCancel, "截图 - 文件覆盖") Then Exit Sub

        SetAttr(F, 0)
        Kill(F)
        On Error GoTo 0
    End If

    Clipboard.Clear()
    SendMessage(ctCapWin, WM_CAP_Edit_Copy, 0, 0) '将当前图像复制到剪贴板
    If System.Windows.Forms.Clipboard.ContainsImage() Then
        System.Windows.Forms.Clipboard.GetImage().Save(F) '保存为 Bmp 图像
    End If
End Sub


Private Sub Button4_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button4.Click
    '摄像头录像，并保存为视频文件
    '果不设置文件路径和名称，或路径不存在，视频窗口会使用默认文件名 C:\CAPTURE.AVI
    Dim F As String
    Dim S As Integer
    Dim nPath As String
    Dim nStr As String

    nPath = Trim(ctAviPath)


    Do
        S = S + 1
        F = nPath & "MyVideo-" & S & ".avi"
        If Dir(F, 23) = "" Then Exit Do
    Loop

    nStr = Trim(InputBox("设置录像保存的文件名:", "录像保存的文件名", F))
    If nStr = "" Then Exit Sub



    ctAviPath = nPath
    F = nPath & F

    If System.IO.File.Exists(F) Then
        If MessageBox.Show("文件已存在，覆盖此文件吗？" & vbCrLf & F, "视频 - 文件覆盖", MessageBoxButtons.OKCancel) = DialogResult.Cancel Then Exit Sub
        Try
            System.IO.File.Delete(F)
        Catch ex As Exception
            MessageBox.Show("无法删除文件：" & vbCrLf & F, "保存文件")
            Exit Sub
        End Try
    End If

    Me.Text = "摄像头控制 - 正在录像（任意位置单击鼠标停止）"
    KjEnabled(False)
    SendMessage(ctCapWin, WM_Cap_File_Set_File, IntPtr.Zero, Marshal.StringToHGlobalAnsi(F)) '置录像保存的文件
    SendMessage(ctCapWin, WM_CAP_Sequence, IntPtr.Zero, IntPtr.Zero) '始录像。录像未结束前不会返回
    Me.Text = "摄像头控制"
    KjEnabled(True)
End Sub


Private Function MakePath(ByVal path As String) As Boolean
    '这里实现创建路径的逻辑
    '返回是否创建成功的布尔值
    '例：
    Try
        System.IO.Directory.CreateDirectory(path)
        Return True
    Catch ex As Exception
        Return False
    End Try
End Function

End Class