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

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,