VB调用摄像头录像，拍照，保存

私人声明函数库SendMessage函数“USER32”别名“SendMessageA”（BYVAL的hWnd长，BYVAL WMSG长，BYVAL的wParam长，lParam中任意）只要 私人声明函数库capCreateCaptureWindow“avicap32.dll”别名“capCreateCaptureWindowA”（BYVAL lpszWindowName作为字符串，BYVAL dwStyle长，BYVAL×如龙，BYVALÿ长，BYVAL nWidth长，BYVAL nHeight参数长，BYVAL hwndParent长， BYVAL的NID长）只要 昏暗ctCapWin长，ctAviPath作为字符串，ctPicPath作为字符串，ctConnect由于布尔 “视频窗口控制消息常数 常量WS_CHILD =＆H40000000：常量WS_VISIBLE =＆H10000000 常量WS_CAPTION = HC00000：常量WS_THICKFRAME =＆H40000 常量WM_USER =＆H400                                 '用户消息开始号 常量WM_CAP_Connect = WM_USER + 10             '连接一个摄像头 常量WM_CAP_DisConnect = WM_USER + 11         '断开一个摄像头的连接 常量WM_CAP_Set_PreView = WM_USER + 50      '使预览模式有效或者失效 常量WM_CAP_Set_Overlay = WM_USER + 51      “使窗口处于叠加模式，也会自动地使预览模式失效。 常量WM_CAP_Set_PreViewRate = WM_USER + 52'设置在预览模式下帧的显示频率 常量WM_CAP_Edit_Copy = WM_USER + 30         “将当前图像复制到剪贴板 常量WM_CAP_Sequence = WM_USER + 62            “开始录像，录像未结束前不会返回。 常量WM_Cap_File_Set_File = WM_USER + 20    “设置当前的视频捕捉文件 常量WM_Cap_File_Get_File = WM_USER + 21    '得到当前的视频捕捉文件 私人小组的Form_Load（） Me.Left = Screen.Width - 7000 “Me.Top = Screen.Height + 5000    “设置按钮及位置，实际可以在控件设计期间完成       昏暗H1只要       Me.Caption =“监控”       Command1.Caption =“连接”：Command1.ToolTipText =“连接摄像头”       Command2.Caption =“断开”：Command2.ToolTipText =“断开与摄像头的连接”       Command3.Caption =“截图”：Command3.ToolTipText =“将当前图像保存为图片文件”       Command4.Caption =“录像”：Command4.ToolTipText =“开始录像，保存为视频文件”   '    H1 = Me.TextHeight（“A”）      “Command1.Move H1 * 0.5，H1 * 0.5，H1 * 4，H1 * 2       “Command2.Move H1 * 5，H1 * 0.5，H1 * 4，H1 * 2       'Command3.Move H1 * 10，H1 * 0.5，H1 * 4，H1 * 2       “Command4.Move H1 * 15，H1 * 0.5，H1 * 4，H1 * 2      “读出用户设置       呼叫ReadSaveSet       KjEnabled真 结束小组 私人小组Command1_Click（）       “创建视频窗口和连接摄像头         昏暗n型式长，T只要                如果ctCapWin = 0，则“创建一个视频窗口，大小：640 * 480               T = Me.ScaleY（Command1.Top + Command1.Height * 1.1，Me.ScaleMode，3）“视频窗口垂直位置：像素                                                     'n型式= WS_CHILD + WS_VISIBLE + WS_CAPTION + WS_THICKFRAME“子窗口（在Form1中内）+可见+标题栏+边框               'n型式= WS_CHILD + WS_VISIBLE“视频窗口无标题栏和边框             n型式= WS_VISIBLE'视频窗口为独立窗口，关闭主窗口视频窗口也会自动关闭               ctCapWin = capCreateCaptureWindow（“视频监视中”n型式，0，T，500，400，Me.hWnd，0）         万一              “将视频窗口连接到摄像头，如无后面两条语句视频窗口画面不会变化         SendMessage函数ctCapWin，WM_CAP_Connect，0，0               '连接摄像头         SendMessage函数ctCapWin，WM_CAP_Set_PreView，1，0         '第三个参数：1预览模式有效，0〜预览模式无效         SendMessage函数ctCapWin，WM_CAP_Set_PreViewRate，30，0，第三个参数：设置预览显示频率为每秒30帧         ctConnect = TRUE：KjEnabled真       “”请检检查摄像头连接，并确定没有其他用户和程序使用。“ 结束小组 私人小组Command2_Click（）         SendMessage函数ctCapWin，WM_CAP_DisConnect，0，0    '断开摄像头连接         ctConnect =假：KjEnabled真 结束小组 私人小组Command3_Click（）      “截图，保存为图片文件         昏暗f，按字符串，S长，n路径作为字符串，NSTR作为字符串                n路径=修剪（ctPicPath）         如果n路径=“”那么n路径= App.Path＆“\ MyPic”         如果右（n路径，1）<>“\”然后n路径= n路径＆“\”                在错误恢复下一页         做             S = S + 1             F = n路径与“MyPic-”＆S＆“.BMP”             如果目录（女，23）=“”然后退出待办事项         循环         对错误转到0                NSTR =修剪（输入框（“设置图片保存的文件名：”，“保存图片”F））         如果NSTR =“”然后退出小组         呼叫CutPathFile（NSTR，n路径，F）    '分解出文件和目录         如果不MakePath（n路径）然后             MSGBOX“在指定的位置无法建立目录：”＆vbCrLf＆n路径，vbInformation，“保存图片文件”             退出小组         万一         ctPicPath = n路径：F = n路径＆F         如果目录（女，23）<>“”那             如果vbCancel = MSGBOX（“文件已存在，覆盖此文件吗？”＆vbCrLf＆F，vbInformation + vbOKCancel，“截图 - 文件覆盖”），然后退出小组             对错误转到挫             SETATTR楼0             杀˚F             对错误转到0         万一              Clipboard.Clear：SendMessage消息ctCapWin，WM_CAP_Edit_Copy，0,0'将当前图像复制到剪贴板         SavePicture Clipboard.GetData，F'保存为骨形态发生蛋白图像，要保存为JPG格式，参见：将图片保存或转变为JPG格式         退出小组 挫：         MSGBOX“无法写文件：”＆vbCrLf＆F，vbInformation，“保存文件” 结束小组 私人小组Command4_Click（）      “用摄像头录像，并保存为视频文件      “如果不设置文件路径和名称，或路径不存在，视频窗口会使用默认文件名C：\ CAPTURE.AVI         昏暗f，按字符串，S长，n路径作为字符串，NSTR作为字符串                n路径=修剪（ctAviPath）         如果n路径=“”那么n路径= App.Path＆“\ MyVideo网站”         如果右（n路径，1）<>“\”然后n路径= n路径＆“\”                在错误恢复下一页         做             S = S + 1             F = n路径与“MyVideo-”＆S＆“.AVI”             如果目录（女，23）=“”然后退出待办事项         循环         对错误转到0                NSTR =修剪（输入框（“设置录像保存的文件名：”，“录像保存的文件名”，F））         如果NSTR =“”然后退出小组         呼叫CutPathFile（NSTR，n路径，F）    '分解出文件和目录         如果不MakePath（n路径）然后             MSGBOX“在指定的位置无法建立目录：”＆vbCrLf＆n路径，vbInformation，“保存文件”             退出小组         万一         ctAviPath = n路径：F = n路径＆F         如果目录（女，23）<>“”那             如果vbCancel = MSGBOX（“文件已存在，覆盖此文件吗？”＆vbCrLf＆F，vbInformation + vbOKCancel，“视频 - 文件覆盖”），然后退出小组             对错误转到挫             SETATTR楼0             杀˚F             对错误转到0         万一                Me.Caption =“摄像头控制 - 正在录像（任意位置单击鼠标停止）”：KjEnabled错误：的DoEvents         SendMessage函数ctCapWin，WM_Cap_File_Set_File，0，BYVAL F'设置录像保存的文件         SendMessage函数ctCapWin，WM_CAP_Sequence，0，0                  '开始录像。录像未结束前不会返回         Me.Caption =“摄像头控制”：KjEnabled真              退出小组 挫：         MSGBOX“无法写文件：”＆vbCrLf＆F，vbInformation，“保存文件” 结束小组 专用功能CutPathFile（NSTR作为字符串，n路径作为字符串，n文件作为字符串）      “分解出文件和目录       昏暗我一样长，一样久            对于i = 1到莱恩（NSTR）            如果MID（NSTR，I，1）=“\”然后S =我    '查找最后一个目录分隔符       下一个       若S> 0。然后            n路径=左（NSTR，S）：n文件= MID（NSTR，S + 1）       其他            n路径=“”：n文件= NSTR       万一 结束功能 专用功能MakePath（BYVAL n路径作为字符串）作为布尔      “逐级建立目录，成功返回Ť       昏暗我一样长，路径1作为字符串，IsPath由于布尔       n路径=修剪（n路径）       如果右（n路径，1）<>“\”然后n路径= n路径＆“\”       对错误转到退出1       对于i = 1到莱恩（n路径）          如果MID（n路径，I，1）=“\”然后               路径1 =左（n路径，我 - 1）               如果目录（路径1，23）=“”那                   MKDIR路径1               其他                  IsPath = GETATTR（路径1）和16                  如果没有IsPath然后退出功能    “有一个同名的文件               万一          万一       下一个       MakePath = TRUE：退出功能 退出1： 结束功能 私人小组Form_Unload（取消作为整数）       呼叫ReadSaveSet（真）“保存用户设置 结束小组 私人小组KjEnabled（nEnabled由于布尔）       如果nEnabled然后            Command1.Enabled =未ctConnect：Command2.Enabled = ctConnect            Command3.Enabled = ctConnect：Command4.Enabled = ctConnect       其他            Command1.Enabled = nEnabled：Command2.Enabled = nEnabled            Command3.Enabled = nEnabled：Command4.Enabled = nEnabled       万一 结束小组 私人小组ReadSaveSet（可选IsSave由于布尔）      “保存或读出用户设置的图片和视频默认保存目录       昏暗nKey作为字符串，NSUB作为字符串       nKey =“摄像头控制程序”：NSUB =“UserOpt”       如果IsSave然后            SaveSetting nKey，NSUB，“AviPath”，ctAviPath            SaveSetting nKey，NSUB，“PicPath”，ctPicPath       其他            ctAviPath = GetSetting（nKey，NSUB“AviPath”，“”）            ctPicPath = GetSetting（nKey，NSUB“PicPath”，“”）       万一 结束小组