VB程序VB代码:摄像头视频图像的监控,截图,录像(改进)

版权声明:本文为博主原创文章,遵循 CC 4.0 BY-SA 版权协议,转载请附上原文出处链接和本声明。
本文链接:https://blog.csdn.net/NCTU_to_prove_safety/article/details/53433706
本程序是“ 实现USB摄像头视频图像的监控,截图,录像 ”的改进。可实现对摄像头视频的监控,截图,录像,可以分别保存为图片文件和视频(压缩)文件。保存的视频文件可以用媒体播放机(Windows媒体播放器),暴风影音等软件进行播放,轻松实现家庭录像制作。
   利用电脑配备的USB摄像头进行视频控制,要用到两个API函数:capCreateCaptureWindow和SendMessage函数其中,capCreateCaptureWindow的作用是创建一个视频窗口,摄像头捕捉到的视频图像在此窗口内显示,函数返回值就是代表此窗口的句柄。视频窗口创建后,剩下的事情就是用SendMessage函数向该窗口发送各种消息,实现对摄像头的控制。
【转】VB程序VB代码:摄像头视频图像的监控,截图,录像(改进) 

  本程序特点主要有:
  1,实现对摄像头视频图像的监控,截图,视频录像并保存为磁盘文件
  。2.可控制多个视频摄像头例如,如果一台电脑配置了两个摄像头,启动本程序两次,单击按钮“源”,在弹出的“视频源”对话框中选择不同的捕获源,两个窗口就能同时显示不同摄像头获得的图像如下图所示
【转】VB程序VB代码:摄像头视频图像的监控,截图,录像(改进) 

  3,在“视频源”对话框中,还可以设置视频的亮度,对比度等许多参数:
【转】VB程序VB代码:摄像头视频图像的监控,截图,录像(改进) 

  4.录像时,如果采用默认的AVI文件格式,得到的视频文件会很大单击按钮“压”,在弹出的“视频压缩”对话框中选择压缩方式的“MPEG-4”,这样得到的视频文件会比默认方式小10倍以上。
【转】VB程序VB代码:摄像头视频图像的监控,截图,录像(改进) 


  5.本程序的视频窗口有自动大小和全屏功能。在全屏状态时,工具栏会自动隐藏。将鼠标移动到屏幕顶部,工具栏又会自动显示出来。

   遗憾的是,由于水平有限,本程序无法判断是否使用了压缩记录方式,压缩后的文件其扩展名仍然是AVI 。当然,这并不影响播放,录像完成后也可以手动将扩展名修改为英里。其次,录像状态下改变视频窗口大小,有时会出现莫名其妙的错误。这个错误时有时无,毫无规律,因此本程序不得不关闭了录像状态下视频窗口自动大小的功能

“”以下是窗体  Form1中的完整代码,在VB6和WindowsXP的下调试通过:
“在窗体放置4个控件:
'     COMMAND1:在属性窗口将索引属性设置为0 
'     检查1:   在属性窗口将索引属性设置为0,将样式属性设置为1 
'     图片1:不必设置任何属性
'     定时器1:   不必设置任何属性
'程序调试时要注意:终止程序要用运行中的Form1的窗口关闭。不要使用VB主窗口的菜单命令或VB工具栏上的关闭按钮,这样无法关闭打开的视频窗口,导致VB无响应。如果VB无响应,只有用系统任务管理器才能终止VB进程,调试过程中所做的修改将丢失。
“本人原创,转载请注明来源:http://hi.baidu.com/100bd/blog/item/525292c3a37f210d0ff47724 的.html
公共ctCapWin长,ctRec由于布尔,ctDir作为字符串,周大福作为字符串,ctAutoSize作为布尔
点心ctRefresh为布尔,ctConnect为布尔,ctAutoHide为布尔,IsFillScreen由于布尔

私人声明函数GetCursorPos库“USER32”(LPPOINT作为POINTAPI),只要
私人类型POINTAPI 
     ×如龙: Ÿ只要
结束类型
私人声明函数SetWindowPos库“USER32”(BYVAL HWND长,BYVAL hWndInsertAfter长,BYVAL×如龙,BYVALÿ长,BYVAL CX长,BYVAL CY长,BYVAL wFlags长)作为龙
常量HWND_TOP = 0         'hWndInsertAfter参数:Z序列的顶部
常量HWND_TOPMOST = -1     '最前
常量HWND_NOTOPMOST = -2   '不在最前
常量HWND_Bottom = 1       '位于底层
常量SWP_NOSIZE =&H1      'wFlags参数
常量SWP_NOMOVE = H2 
常量SWP_NOZORDER = H4 
常量SWP_NOACTIVATE =&H10 
常量SWP_SHOWWINDOW =&H40 
常量SWP_HIDEWINDOW =&H80 

私人声明函数SendMessage函数库“USER32”别名“SendMessageA”(BYVAL HWND长,BYVAL WMSG长,BYVAL的wParam长,lParam中任何的),只要
私人声明函数SendMessageLong库“USER32”别名“SendMessageA”(BYVAL HWND长,BYVAL WMSG长,BYVAL的wParam长,lParam的长),只要
私人声明函数PostMessage的库“USER32”别名“PostMessageA”(BYVAL HWND长,BYVAL WMSG长,BYVAL的wParam长,BYVAL lParam的长),只要
常量WM_CLOSE =&H10 

私人声明函数capGetDriverDescriptionA 库“avicap32.dll”(BYVAL wDriver整数,BYVAL lpszName作为字符串,BYVAL cbName长,BYVAL lpszVer作为字符串, BYVAL cbVer长)为布尔
私人声明函数库capCreateCaptureWindow“avicap32.dll”别名“capCreateCaptureWindowW”(BYVAL lpszWindowName作为字符串,BYVAL dwStyle长,BYVAL×如龙,BYVALÿ长,BYVAL nWidth长,BYVAL nHeight参数作为龙BYVAL hwndParent长,BYVAL的NID长),只要
常量WS_CHILD =&H40000000 
常量WS_VISIBLE =&H10000000 
常量WS_CAPTION = HC00000 
常量WS_THICKFRAME =&H40000 

常量GET_Frame = 1084 

常量WM_USER =&H400         '用户消息开始号,偏移地址:1024 
CONST WM_CAP_GET_CAPSTREAMPTR = WM_USER + 1          
常量WM_CAP_SET_CALLBACK_ERROR = WM_USER + 2        '当出错回调函数
常量WM_CAP_SET_CALLBACK_STATUS = WM_USER + 3       '当状态(状态)改变的时回调函数
常量WM_CAP_SET_CALLBACK_YIELD = WM_USER + 4        '在流捕获期间的回调函数
常量WM_CAP_SET_CALLBACK_FRAME = WM_USER + 5        '帧预览回调函数
常量WM_CAP_SET_CALLBACK_VIDEOSTREAM = WM_USER + 6'在流捕获期间,当一个新的视频缓存区可用的时候就调用它
常量WM_CAP_SET_CALLBACK_WAVESTREAM = WM_USER + 7   “在流捕获期间,当一个新的音频缓存区可用的时候就调用它

常量WM_CAP_GET_USER_DATA = WM_USER + 8'获取:数据关联到一个捕捉窗口
常量WM_CAP_SET_USER_DATA = WM_USER + 9'设置:数据关联到一个捕捉窗口

常量WM_CAP_DLG_VideoFormat = WM_USER + 41       '对话框:视频格式
常量WM_CAP_DLG_VideoSource = WM_USER + 42       '对话框:视频源,枚举视频源,控制颜色,对比度,饱和度的改变需视频驱动程序支技
常量WM_CAP_DLG_VideoDisplay = WM_USER + 43      “对话框:视频显示控制视频捕捉过程中视频在显示器上的显示对捕捉数据无影响,但会影响数了信号表达式。
常量WM_CAP_DLG_VideoCompression = WM_USER + 46'对话框:视频压缩

私人枚举enWinSet 
'   en_Copy = -1 
   es_Show = 0 
   es_Hide 
   es_Close 
   es_Move 
   es_Size 
结束枚举

“捕捉文件和缓存
常量WM_Cap_File_Set_File = WM_USER + 20”设置当前的捕捉文件
常量WM_Cap_File_Get_File = WM_USER + 21'得到当前的捕捉文件
常量WM_CAP_FILE_ALLOCATE = WM_USER + 22“为捕捉文件预分配空间,从而可以减少被漏掉的帧
常量WM_CAP_FILE_SaveAs = WM_USER + 23“将捕捉文件保存为另一个用户指定的文件。这个消息不会改变捕捉文件的名字和内容
                                        ”由于捕捉文件保留它最初的文件名,因此必须指定个新的文件的文件名来保存
常量WM_CAP_FILE_SET_INFOCHUNK = WM_USER + 24'可以把信息块例如文本或者自定义数据插入AVI文件。同样用这个消息也可以清除AVI文件中的信息块
常量WM_CAP_FILE_SaveDIB = WM_USER + 25'把从帧缓存中复制出图像存为设备无关位图书馆(DIB),应用程序也可以使用这两个单帧捕捉消息来编辑帧序列
                                         '或者创建一个慢速摄影序列

常量WM_CAP_Edit_Copy = WM_USER + 30' 1054:把缓存中图像复制到剪贴板中

常量WM_CAP_SET_AUDIOFORMAT = WM_USER + 35“。设置音频格式设置时传入一个WAVEFORMAT,WAVEFORMATEX,或PCMWAVEOFMAT结构的指针
常量WM_CAP_GET_AUDIOFORMAT = WM_USER + 36'来得到音频数据的格式和该格式结构体的大小。默认的捕捉音频格式是单声道,8位和11KHZ PCM 

常量WM_CAP_Get_VideoFormat = WM_USER + 44'给捕捉窗口来得到视频格式的结构和该结构的大小
常量WM_CAP_SET_VideoFormat = WM_USER + 45'用来设置视频格式

常量WM_CAP_SET_PreView = WM_USER + 50“发送给捕捉窗口来使预览模式有效或者失效
常量WM_CAP_SET_Overlay = WM_USER + 51”使窗口处于叠加模式。使叠加模式有效也会自动地使预览模式失效
常量WM_CAP_SET_PreViewRate = WM_USER + 52“发送给捕捉窗口来设置在预览模式下帧的显示频率
常量WM_CAP_SET_Scale = WM_USER + 53”来使预览模式的缩放有效或者无效

常量WM_CAP_SET_SCROLL = WM_USER + 55'如果是在预览模式或者叠加模式,还可以通过本消息发送给窗口,
                                       “在窗口里的用户区域设置视频帧的滚动条的位置
专用类型BITMAPINFOHEADER”tagBitMapInfoHeader结构
     biSize只要         
     biWidth只要
     biHeight只要       “LONG DWORD 
     双翼飞机作为整数    'WORD 
     biBitCount作为整数
     biCompression只要
     biSizeImage只要
     biXPelsPerMeter只要
     biYPelsPerMeter只要
     biClrUsed只要
     biClrImportant只要
结束类型
专用类型BITMAPINFO 
    bmiHeader由于BITMAPINFOHEADER“ 
    bmiColors为字节    'RGBQUAD 
结束类型


'基本视频捕获消息--------- ----------------------------- 
常量WM_CAP_Connect = WM_USER + 10     '连接一个视频驱动,成功返回真(1)。连接驱动后,不一定就能显示视频,还要保证摄像头硬件连接良好,未被其他程序使用。
常量WM_CAP_DisConnect = WM_USER + 11'断开视频窗口与驱动的连接


“    的wParam:视频设备序号,从0到9 
常量WM_CAP_Sequence = WM_USER + 62“开始录像
常量WM_CAP_Stop = WM_USER + 68      '终止视频捕获
常量WM_CAP_Abort = WM_USER + 69     '暂停录像捕获?,成功返回真
常量WM_CAP_Set_Sequence_Setup = WM_USER + 64 
常量WM_CAP_Get_Sequence_Setup = WM_USER + 65 

”录像参数设置和获取
“暗淡nParms作为CaptureParms 
'SendMessage函数ctCapWin,WM_CAP_Get_Sequence_Setup,莱恩(nParms),nParms'获取参数的设置
'nParms.fAbortLeftMouse =假'关闭:单击鼠标停止录像的功能
”SendMessage函数ctCapWin,WM_CAP_Set_Sequence_Setup,莱恩(nParms) ,nParms“重新设置参数
专用类型CaptureParms” 
    dwRequestMicroSecPerFram Ë只要   “DWORD 
    fMakeUserHitOKToCapture由于布尔”开始录像时,是否显示确认对话框,默认为假
    wPercentDropForError只要“每毫秒捕捉帧率,默认66667,即每秒15帧
    fYield由于布尔             “布尔:如果为真,将产生一个后台线程来进行视频捕捉
    dwIndexSize只要           ”DWORD:视频文件最大的索引入口数
    wChunkGranularity只要     'UINT:以字节为单位表示AVI文件的大小
    fUsingDOSMemory由于布尔    'BOOL:未使用
    wNumVideoRequested只要    'UINT:分配视频缓冲区的最大数量
    fCaptureAudio布尔      “是否捕获音频流,默认值由具体的硬件设置
    wNumAudioRequested只要    ”分配的音频缓冲区的最大数量
    vKeyAbort作为龙             “结束录像的按键,默认为VK_ESCAPE(ESC键)
    fAbortLeftMouse由于布尔    ”单击鼠标左键停止录像,默认为真
    fAbortRightMouse由于布尔   “单击鼠标右键停止录像,默认为假
    fLimitEnabled由于布尔      '是否开启捕获时间限制,默认为真
    wTimeLimit只要            '捕获时间限制(秒),fLimitEnabled为真时有效
    fMCIControl由于布尔        'BOOL:为TRUE,控制MCI(媒体设备接口)兼容的视频源
    fStepMCIDevice由于布尔     'BOOL 
    dwMCIStartTime只要        “DWORD:以毫秒为单位标识MCI设备视频捕捉序列的起始位置,如果fMCIControl成员为FALSE,该成员被忽略
    dwMCIStopTime只要         ”DWORD:以毫秒为单位标识MCI设备视频捕捉序列的停止位置,如果fMCIControl成员为FALSE,该成员被忽略
    fStepCaptureAt2x由于布尔   'BOOL:为TRUE,捕捉的视频帧使用两个分辨率
    wStepCaptureAverageFrame 一样久“:在捕捉时每帧图像使用的时间大小
    dwAudioBufferSize只要      ”音频缓冲大小,默认0 
    fDisableWriteCache由于布尔'的Win32系统未使用
    AVStreamMaster只要         “确定在写入AVI文件时,音频流是否控制时钟
端类型

”视频窗口消息----------------- --------------------- 
“私人声明函数capGetDriverDescriptionA 库”avicap32.dll“(_ 
'BYVAL wDriver整数,BYVAL lpszName作为字符串,BYVAL cbName长, BYVAL lpszVer作为字符串,BYVAL cbVer长)为布尔
   '可利用此API获取所有驱动程序名称和版本信息例子
“    点心一样久
”    昏暗lpszName作为字符串* 128 
'    昏暗lpszVer作为字符串* 128 

'    
“       如果不capGetDriverDescriptionA (S,lpszName,128,lpszVer,128),然后退出做'获得驱动程序名称和版本信息
”       S = S + 1 
“    循环
常量WM_CAP_Get_Status = WM_USER + 54'获取捕捉窗口的当前状态
专用类型CapStatus “■■?
    uiImageWidth只要             ”图像宽度,像素
    uiImageHeight只要            “图像高度,像素
    fLiveWindow由于布尔           ”视频显示是否使用预览
    fOverlayWindow由于布尔        “视频显示是否使用硬件
    FSCALE由于布尔                ”图像是否随窗口大小自动缩放
    ptScroll由于POINTAPI             'POINT?
    fUsingDefaultPalette由于布尔'是否使用默认调色板
    fAudioHardware由于布尔        “是否安装了音频波形硬件
    fCapFileExists由于布尔        '是否生成了正确的捕获文件
    dwCurrentVideoFrame只要
    dwCurrentVideoFramesDrop PED只要
    dwCurrentWaveSamples只要
    dwCurrentTimeElapsedMS只要    ”视频流已录像时间(毫秒)
    hPalCurrent只要               'HPALETTE当前调色板句柄
    fCapturingNow由于布尔          “是否正在进行捕获
    dwReturn只要                  '错误返回值,根据这个数值可以调用一个错误回调函数
    wNumVideoAllocated只要        ”视频缓冲
    wNumAudioAllocated只要        “音频缓冲
结束类型

私人小组CloseMouse()
  昏暗nParms作为CaptureParms 
  SendMessage函数ctCapWin,WM_CAP_Get_Sequence_Setup,莱恩(nParms),nParms   '获取参数的设置
  'nParms.fMakeUserHitOKToCapture = TRUE'开始录像时,是否显示确认对话框
  nParms。 fYield = TRUE'用一个后台线程来进行视频捕捉
  nParms.fAbortLeftMouse =假   '关闭:单击鼠标左键停止录像的功能。
  nParms.fAbortRightMouse =假'关闭:单击鼠标右键停止录像的功能
  SendMessage函数ctCapWin,WM_CAP_Set_Sequence_Setup ,LEN(nParms),nParms“重新设置参数
   
'FF = SendMessageLong(ctCapWin,WM_CAP_SET_CALLBACK_STATUS,0,AddressOf CallBackStatus)”状态回调函数
'FF = SendMessageLong(ctCapWin,WM_CAP_SET_CALLBACK_FRAME,0,AddressOf MyFrameCallback)“帧回调函数
'FF = SendMessageLong(ctCapWin,WM_CAP_SET_CALLBACK_YIELD,0,AddressOf CallbackYield)
结束小组

私人小组NoRecord()
   SendMessage函数ctCapWin,WM_CAP_Stop,0,0'停止录像
   ctRec =假:调用SetCaption(“”)
结束小组

私人小组startRecord用于()
   昏暗f,按字符串,NDIR作为字符串,nF的作为字符串

    '如果路径不存在,用默认文件名C:\ CAPTURE.AVI 
    NDIR =修剪(ctDir)
    如果NDIR =“”或者NDIR =“<>”或NDIR =“<默认>”然后NDIR = App.Path&“\影片” 
    如果右(NDIR,1)<>“”那NDIR NDIR =&“” 
    如果不MakePath(NDIR)然后
       MSGBOX“在指定的位置无法建立目录:”&vbCrLf& n路径,vbInformation,“保存视频文件” 
       退出小组
    结束如果
    
    NF =修剪(CTF)
    若NF =“”或者NF =“<>”或NF =“<默认>”那么NF =格式(现在,“年月日- HHMMSS “)&”.AVI“ 
    如果INSTR(NF,”“)= 0,那么NF = nF的&”.AVI“ 
    F = NDIR与nF的
      如果CheckDirFile(F)= 1,则
       如果vbNo = MSGBOX(”文件已存在,覆盖此文件吗?“&vbCrLf&F,vbInformation + vbYesNo,”开始录像“),然后退出小组
       对错误转到挫
       SETATTR楼0 
       杀˚F 
       对错误转到0 
   结束如果
    
    ctRec =假
    SetWin ctCapWin,es_Size,,,, 1 
    ctRec =真
    呼叫SetCaption(“正在录像:”&NF)
    呼叫KjEnabled(真)
    
    的DoEvents 
    呼叫CloseMouse 
    SendMessage函数ctCapWin,WM_Cap_File_Set_File,0,BYVAL F'设置录像保存的文件
    PostMessage的ctCapWin,WM_CAP_Sequence,0,0            '开始录像
    。如果ctAutoHide然后Me.Visible =假
   退出小组
挫:
   MSGBOX“无法写文件:”&vbvrlf&vbCrLf&F,vbInformation,“录像-错误” 
结束子
“”一篇文章放不下全部代码,这是仅是第一页,转到:第二页 '本人原创,转载请注明来源:http://hi.baidu.com/100bd/blog/item/525292c3a37f210d0ff47724 的.htmlnF的如果CheckDirFile(F)= 1,则如果vbNo = MSGBOX(“文件已存在,覆盖此文件吗?”&vbCrLf&F,vbInformation + vbYesNo,“开始录像”),然后退出小组对错误转到挫SETATTR楼0 杀˚F 对错误转到0 结束如果ctRec =假SetWin ctCapWin,es_Size,,,,1 ctRec =真呼叫SetCaption(“正在录像:”&NF)呼叫KjEnabled(真)的DoEvents 呼叫CloseMouse SendMessage函数ctCapWin,WM_Cap_File_Set_File,0,BYVAL F'设置录像保存的文件PostMessage的ctCapWin,WM_CAP_Sequence,0,0 '开始录像如果ctAutoHide然后Me.Visible =假退出小组挫:MSGBOX“无法写文件:”&vbvrlf&vbCrLf&F,vbInformation,“录像-错误“ 结束子”“一篇文章放不下全部代码,这是仅是第一页,转到:第二页 '本人原创,转载请注明来源:http://hi.baidu.com/100bd/blog /项目/ 525292c3a37f210d0ff47724 的.htmlnF的如果CheckDirFile(F)= 1,则如果vbNo = MSGBOX(“文件已存在,覆盖此文件吗?”&vbCrLf&F,vbInformation + vbYesNo,“开始录像”),然后退出小组对错误转到挫SETATTR楼0 杀˚F 对错误转到0 结束如果ctRec =假SetWin ctCapWin,es_Size,,,,1 ctRec =真呼叫SetCaption(“正在录像:”&NF)呼叫KjEnabled(真)的DoEvents 呼叫CloseMouse SendMessage函数ctCapWin,WM_Cap_File_Set_File,0,BYVAL F'设置录像保存的文件PostMessage的ctCapWin,WM_CAP_Sequence,0,0  '开始录像如果ctAutoHide然后Me.Visible =假退出小组挫:MSGBOX“无法写文件:”&vbvrlf&vbCrLf&F,vbInformation,“录像-错误“ 结束子”“一篇文章放不下全部代码,这是仅是第一页,转到:第二页 '本人原创,转载请注明来源:http://hi.baidu.com/100bd/blog /项目/ 525292c3a37f210d0ff47724 的.html

第二页

''一篇文章放不下全部代码,这仅是第二页,转到:第一页

  本程序是“ 实现USB摄像头视频图像的监控,截图,录像 ”的改进。可实现对摄像头视频的监控,截图,录像,可以分别保存为图片文件和视频(压缩)文件。保存的视频文件可以用媒体播放机(Windows媒体播放器),暴风影音等软件进行播放,轻松实现家庭录像制作。

【转】VB程序VB代码:摄像头视频图像的监控,截图,录像(改进)

 

【转】VB程序VB代码:摄像头视频图像的监控,截图,录像(改进)

 

【转】VB程序VB代码:摄像头视频图像的监控,截图,录像(改进)


''一篇文章放不下全部代码,这仅是第二页,转到:第一页

私人小组SetDir()
    昏暗的NSTR作为字符串
    如果修剪(ctDir)=“”然后ctDir = App.Path&“\视频”'如果路径不存在,用默认文件名C:\ CAPTURE.AVI 
    NSTR =“设置录像保存的文件夹“&vbCrLf&”输入“<>”表示使用默认文件夹:“&vbCrLf&App.Path&”\影片“ 
    NSTR =修剪(输入框(NSTR,”录像保存的文件夹“,ctDir) )
    如果NSTR =“”然后退出小组
    ctDir = NSTR 
    如果ctDir =“<>”或ctDir =“<默认>”然后ctDir =“” 
结束小组

私人小组SetFile()
    昏暗的NSTR作为字符串,nF的作为字符串
    
    NF =字符串(255,“”)
    SendMessage函数ctCapWin,WM_Cap_File_Get_File,莱恩(NF),BYVAL nF的
    NF = GetStrLeft(NF,vbNullChar)
   
    如果修剪(CTF)=“”然后CTF =“<默认>”'如果路径不存在,用默认文件名C:\ CAPTURE.AVI 
    NSTR =“设置录像保存的文件名(不带路径)。”&vbCrLf&“输入”<>“表示使用默认文件名:日期-时间扩展名” 
    NSTR =修剪(输入框(NSTR,“录像保存的文件名”,CTF))
    如果NSTR =“”然后退出小组
    CTF = NSTR 
    如果CTF =“<>”或CTF =“<默认>”然后CTF =“” 
    
    SendMessage函数ctCapWin,WM_Cap_File_Set_File ,0,BYVAL周大福
端子

专用功能GetStrLeft(NSTR作为字符串,富作为字符串)作为字符串
   '去掉富及后面的字符
   昏暗一样久
   S = INSTR(NSTR,富)
   若S> 0,则GetStrLeft =左(NSTR ,S - 1)否则GetStrLeft = NSTR 
端功能

专用功能CheckDirFile(nDirFile)只要
   '检查目录或文件夹,返回值:0不存在,1是文件,2是目录
   昏暗NSTR作为字符串,ND为布尔
   NSTR =迪尔(nDirFile,23)
   如果NSTR =“”然后退出功能
   ND = GETATTR(nDirFile)和16 
   如果ND然后CheckDirFile = 2否则CheckDirFile = 1 
结束函数

私人小组的Form_Load()
    昏暗W¯¯长,H只要
    呼叫SetCaption( “”)
  
    Me.ScaleMode = 3:Picture1.ScaleMode = 3 
    Picture1.BorderStyle = 0 
    设置的Command(0)= .Container图片1 
    组检查1(0)= .Container图片1 

    呼叫ReadSaveSet“读取用户设置
    ”装载数组控件
    AddKj COMMAND1 “连”,“连接”,“连接摄像头” 
    AddKj COMMAND1,“断”,“断开”,“断开与摄像头的连接” 
    AddKj COMMAND1,“ - ” 
    AddKj COMMAND1,“源”,“VideoSource”,“选择:视频源“ 
    AddKj COMMAND1,”格“,”VideoFormat“,”设置:视频格式,分辨率“ 
    AddKj COMMAND1,”显“,”的VideoDisplay“,”视频显示对话框某些显卡不支持此功能。 “ 
    AddKj COMMAND1,” - “ 
    。AddKj COMMAND1,”夹“,”SetDir“,”设置录像文件保存的文件夹默认为主程序所在目录下的“视频”文件夹“ 
    AddKj COMMAND1,”文“,”SetFile “,”录像保存的文件名,默认为:时间-编号扩展名“。
    AddKj COMMAND1,”压“,”VideoCompression“,”设置:视频录像文件的压缩方式“ 
    AddKj COMMAND1,” - “ 
    AddKj COMMAND1,”录“,”记录“,”开始录像“ 
    AddKj COMMAND1,”停“,”NoRecord“,”停止录像“ 
    AddKj COMMAND1,”图“,”CopyImg“,”将当前图像复制到剪贴板“ 
    AddKj COMMAND1” - “ 
    AddKj COMMAND1,”全“,”FillScreen“,”切换:全屏/窗口“ 
    AddKj COMMAND1,”关“,”退出“,”关闭:退出程序“ 
    
    如果ctAutoSize那么W = 1否则W = 0 
    AddKj(检查1 “自”,“自动调整大小”,“视频窗口是否随主窗口自动改变大小”).value的= W 
    如果ctAutoHide则W = 1否则W = 0 
    AddKj(检查1,“隐”,“自动隐藏”,“录像时自动隐藏主窗口“).value的= W 
    
  '   ctAutoSize = TRUE'预览图像随窗口自动缩放
    ListKj COMMAND1,COMMAND1(0).Height * 0.1'排列数组控件
    W = Command1.UBound:W =指令(W)。左+ COMMAND1(W)* .WIDTH 2 
    ListKj检查1,W'排列数组控件
    Picture1.Height =指令(0).Height * 1.2 
              
    呼叫WinCenter“窗口居中
    ctRefresh =真
    呼叫CreateCapWin”创建视频窗口
    调用KjEnabled(真)
    定时器。启用=真:Timer1.Interval = 500 
结束小组

私人小组Form_Resize()
   Picture1.Move 0,0,Me.ScaleWidth,COMMAND1(0).Height * 1.3 
   如果ctAutoSize然后SetWin ctCapWin,es_Size   “视频子窗口随主窗口自动改变大小
结束小组

私人小组Timer1_Timer()
   昏暗的NP作为POINTAPI,X长,Y长,H只要
   昏暗n状态作为CapStatus,NREC为布尔
   
'    '我读取窗口的当前状态n状态总是失败,忘高手赐教
“    X = SendMessageLong(ctCapWin,WM_CAP_Get_Status,莱恩(n状态),BYVAL VarPtr(n状态))
'    X = SendMessage函数(ctCapWin,WM_CAP_Get_Status,莱恩(n状态),n状态)
'    NREC = nStatus.fCapturingNow”是否正在进行捕获
'    S = nStatus.uiImageWidth      “图像宽度,像素
'    Me.Caption = X 
   
   GetCursorPos NP 
   X = nP.X - Me.Left / Screen.TwipsPerPixelX 
   Y = nP.Y - Me.Top / Screen.TwipsPerPixelY 
   
   如果没有IsFillScreen然后退出小组
   H = Me.Height / Screen.TwipsPerPixelY - Me.ScaleHeight“窗口标题栏高度
   如果Y> -1和Y <H + Picture1.Height然后
      如果Picture1.Visible然后退出小组
      Picture1.Visible = TRUE,
   否则
      如果没有Picture1.Visible然后退出子
      Picture1.Visible =假
   结束如果
   SetWin ctCapWin,es_Size 
结束小组

私人小组SetCaption(可选NCAP作为字符串)
   如果NCAP <>“”那Me.Tag =修剪(NCAP)
   如果IsFillScreen然后'全屏方式
      Me.Caption =“” 
   否则'窗口方式
      如果Me.Tag =“”那Me.Caption =“摄像头控制”其他Me.Caption =“摄像头控制- ”&Me.Tag 
   结束如果
结束小组

私人小组Check1_Click(指数为整数)
   昏暗nTag作为字符串,TF作为布尔
   
   如果没有ctRefresh然后退出小组
   nTag =检查1(指数).TAG:TF =检查1(指数).value的= 1 
   选择案例LCASE(nTag)
   案例LCASE(“自动调整大小”)
       ctAutoSize = TF 
       SendMessage函数ctCapWin,WM_CAP_SET_Scale, ctAutoSize,0'预览图像随窗口自动缩放
       调用SetWin(ctCapWin,es_Size)
   案例LCASE(“自动隐藏”)
       ctAutoHide = TF 
   最终选择
结束小组

私人小组Command1_Click(指数为整数)
   Cmd的COMMAND1(指数).TAG 
结束小组

私人小组CMD(NCMD作为字符串)
   选择案例LCASE(NCMD)
   案例LCASE(“连接”):           呼叫CapConnect“连接摄像头
   案例LCASE(”断开“):        ctConnect =假:SendMessage函数ctCapWin,WM_CAP_DisConnect,0,0       '断开摄像头连接
   
   案例LCASE(“VideoSource”):       SendMessage函数ctCapWin,WM_CAP_DLG_VideoSource,0,0   '对话框:视频源
   的情况下LCASE(“VideoFormat”):       SendMessage函数ctCapWin,WM_CAP_DLG_VideoFormat,0,0:通话SetWin(ctCapWin,es_Size)“显示对话框:视频格式,分辨率
   案例LCASE(“的VideoDisplay”):      SendMessage函数ctCapWin,WM_CAP_DLG_VideoDisplay,0,0'对话框:视频显示某些显卡不支持?
   
   案例LCASE(“SetDir”):            呼叫SetDir 
   案例LCASE(“SetFile “):           呼叫SetFile 
   案例LCASE(”VideoCompression“):SendMessage函数ctCapWin,WM_CAP_DLG_VideoCompression,0,0'对话框:视频压缩
   案例LCASE(”记录“):            呼叫startRecord用于
   案例LCASE(”NoRecord“):          呼叫NoRecord 
   
   案例LCASE( “CopyImg”):Clipboard.Clear:SendMessage函数ctCapWin,WM_CAP_Edit_Copy,0,0'将当前图像复制到剪贴板
   案例LCASE(“FillScreen”):        呼叫FillScreen 
   案例LCASE(“”)
   案LCASE(“”)
   案LCASE( “”)
   案LCASE(“退出”):              卸载我:退出小组
   结束选择
   呼叫KjEnabled(真)
结束次

公用Sub FillScreen() 
   “ 全屏切换
   IsFillScreen =不IsFillScreen 
   Picture1.Visible =不IsFillScreen 
   如果IsFillScreen然后Me.BorderStyle = 0否则Me.BorderStyle = 2 
   呼叫SetCaption 
   
   如果IsFillScreen然后'全屏方式
      Me.WindowState = 2 
      检查1(KjIndex(检查1,“自动调整大小”))值= 1'切换到:视频窗口随主窗口自动改变大小
   别人的窗口方式
      Me.WindowState = 0 
      呼叫WinCenter“窗口居中
   结束如果
   检查1(KjIndex(检查1,”自动调整大小“))。启用=不IsFillScreen 
结束小组

私人小组WinCenter()
   '窗口居中
   昏暗W¯¯长,H只要
   W = 650 * Screen.TwipsPerPixelX:H = 560 * Screen.TwipsPerPixelY 
   Me.Move(Screen.Width - W)* 0.5(Screen.Height - H)* 0.5,W,H'窗口居中
结束小组

私人小组VideoSize(W只要,H只要)
   “获取视频的大小尺寸
   昏暗nInf作为BITMAPINFO 
   SendMessage函数ctCapWin,WM_CAP_Get_VideoFormat,莱恩(nInf),nInf 
   W = nInf.bmiHeader.biWidth:H = nInf.bmiHeader.biHeight 
端子

专用功能AddKj(KJ为对象,NCAP作为字符串,可选nTag作为字符串,可选n注意作为字符串)作为控制
   '装载一个数组控件
   昏暗我只要
   
   我= Kj.UBound 
   如果KJ(我).TAG <>“”那我= I + 1:负载KJ(I)
   上的错误继续下一步
   KJ(我).Caption = NCAP 
   如果nTag =“”那KJ(I)= .TAG KJ(I).Name点&“ - ”&我KJ否则(I)= .TAG nTag 
   KJ(我).ToolTipText = n注意
   设置AddKj = KJ(我)
结束函数

私人小组ListKj(KJ为对象,L长)
  “排列数组控件
  昏暗我一样长,H1长,T长,W只要
  
  H1 = Picture1.TextHeight(“A”):T = H1 * 0.25:W = H1 * 2 
  对于I = Kj.lBound要Kj.UBound 
     如果KJ(我).Caption =“ - ”然后
        L = L + H1:KJ (I)。可见=假
     否则
        KJ(我).Move L,T,W,W:KJ(我)。可见=真
        L = + W 
     结束如果
  下一页
尾子

专用功能KjIndex(KJ为对象,nTag作为字符串),只要
   昏暗我只要
   对我= Kj.lBound要Kj.UBound 
      如果LCASE(KJ(我).TAG)= LCASE(nTag)然后KjIndex = I:退出功能
   下一步
   KjIndex = -1 
结束函数

私人小组KjEnabled (可选nEnabled由于布尔)
  昏暗的KJ,TF作为布尔值,n类型为String 
  上的错误继续下一步
  对于每个KJ在Me.Controls 
     n类型= LCASE(类型名(KJ))
     如果n类型=“命令”或n类型=“复选框”然后
        KJ .Enabled = nEnabled 
     结束如果
  下一步

  COMMAND1(KjIndex按钮(Command,“FillScreen”))。启用=真
  COMMAND1(KjIndex按钮(Command,“退出”))。启用=真
  检查1(KjIndex(检查1,“自动调整大小”))。启用=不IsFillScreen 
  如果没有nEnabled然后退出小组
  
  TF = ctConnect 
  如果ctRec然后TF =假
  
  COMMAND1(KjIndex按钮(Command,“连接”))。启用=未TF 
  COMMAND1(KjIndex按钮(Command,“断开”))。启用= TF'按钮在摄像头连接状态才可用
  
  COMMAND1(KjIndex按钮(Command,“VideoSource”))。启用= TF 
  COMMAND1(KjIndex按钮(Command,“VideoFormat”))。启用= TF 
  COMMAND1(KjIndex按钮(Command“的VideoDisplay”))。启用= TF 

  COMMAND1(KjIndex按钮(Command,“VideoCompression”))。启用= TF 
  COMMAND1(KjIndex按钮(Command,“记录”))。启用= TF 
  COMMAND1(KjIndex按钮(Command,“NoRecord”))。启用= TF 
  COMMAND1(KjIndex按钮(Command,“CopyImg”))。启用= TF 
  
  如果没有ctRec然后退出小组
  COMMAND1(KjIndex按钮(Command,“记录”))。启用=假
  COMMAND1(KjIndex按钮(Command,“NoRecord”))。启用=真
  COMMAND1( KjIndex按钮(Command,“SetFile”))。启用=假
  COMMAND1(KjIndex按钮(Command,“SetDir”))。启用=假
结束小组

私人小组CreateCapWin()
   '创建视频窗口
   昏暗n型式长,S只要
   昏暗lpszName作为字符串* 128 
   昏暗lpszVer作为字符串* 128 
   
   
      如果不capGetDriverDescriptionA (S,lpszName,128,lpszVer,128),然后退出做'获得驱动程序名称和版本信息
      S = S + 1 
   循环
   n型式= WS_CHILD + WS_VISIBLE'+ WS_CAPTION + WS_THICKFRAME“子窗口+可见+标题栏+边框
   如果ctCapWin <> 0,则退出子
   ctCapWin = capCreateCaptureWindow(”我创建的视频窗口“,n型式,0,0,640,480,Me.hwnd,0)
   如果ctCapWin = 0然后退出小组
   SetWin ctCapWin,es_Move,0,命令1(0).TOP + COMMAND1(0).Height * 1.2,640,480 
结束子

私人小组CapConnect()
   昏暗ð只要
   “打开摄像头
   D = SendMessage函数(ctCapWin, WM_CAP_Connect,0,0)         '连接一个视频驱动,成功返回真(1)
   
   的SendMessage ctCapWin,WM_CAP_SET_Scale,ctAutoSize,0   '预览图像随窗口自动缩放
   的SendMessage ctCapWin,WM_CAP_SET_PreViewRate,30,0     '设置预览显示频率
   的SendMessage ctCapWin,WM_CAP_SET_PreView ,1,0          '第三个参数:1预览模式有效,0〜预览模式无效
   ctConnect = TRUE 
   呼叫SetWin(ctCapWin,es_Size)“调整视频窗口为正确的大小
结束小组

私人小组SetWin(hWnds长,n设置作为enWinSet,可选BYVAL L,以龙,可选BYVAL T作为长,可选BYVALW¯¯长,可选BYVAL H作为龙)
   昏暗hWndZOrder长,wFlags只要
  
   如果hWnds = 0,则退出子
   选择案例n设置
   案例es_Close:SendMessage函数hWnds ,WM_CLOSE,0,0:退出小组
   案例es_Hide:wFlags = SWP_NOMOVE + SWP_NOSIZE + SWP_NOZORDER + SWP_HIDEWINDOW'隐藏
   案例es_Show:hWndZOrder = HWND_TOP:wFlags = SWP_NOSIZE + SWP_SHOWWINDOW       “显示
   案例es_Move 
      hWndZOrder = HWND_TOP:wFlags = SWP_NOACTIVATE + SWP_NOSIZE 
   案例es_Size 
      hWndZOrder = HWND_TOP:wFlags = SWP_NOACTIVATE 
      “录像状态下改变视频窗口大小,有时会出现莫名其妙的错误
      。如果ctRec然后wFlags = wFlags + SWP_NOSIZE 
      L = 0 
      如果Picture1.Visible然后T = Picture1.Height 
      如果ctAutoSize然后
         W =我。 ScaleWidth L - 
         如果H = 1则H = Me.ScaleHeight否则H = Me.ScaleHeight - T的
      否则
         呼叫VideoSize(W,H)'获取视频的实际大小
      结束如果
      当w <20或H <20然后退出小组
   结束选择
  
   SetWindowPos hWnds,hWndZOrder,L,T,W,H,wFlags 
结束小组

私人小组ReadSaveSet(可选IsSave正如布尔)
   暗淡n路径作为字符串,NSUB作为字符串
   n路径=“摄像头控制”:NSUB =“USERSET” 
   如果IsSave然后
      SaveSetting n路径,NSUB,“自动调整大小”,ctAutoSize 
      SaveSetting n路径,NSUB,“自动隐藏”,ctAutoHide 
      SaveSetting n路径,NSUB,“路径”,ctDir 
      SaveSetting n路径,NSUB,“文件”,周大福
   否则
      ctAutoSize = GetSetting(n路径,NSUB,“自动调整大小” “假”)
      ctAutoHide = GetSetting(n路径,NSUB,“自动隐藏”,“假”)
      ctDir = GetSetting(n路径,NSUB,“路径”,“”)
      CTF = GetSetting(n路径,NSUB,“文件”,“” )
   结束如果
结束小组

私人小组Form_Unload(取消作为整数)
   “停止摄像头。一般情况,如果母窗体关闭,子窗体就会自动释放。下面两句代码是否可省?
   如果ctRec然后调用NoRecord 
   CMD”断开连接“'断开摄像头连接
   SetWin ctCapWin,es_Close 
   呼叫ReadSaveSet(真)”保存用户设置
完子

专用功能CutPathFile(NSTR作为字符串,n路径作为字符串,n文件作为字符串)
   “分解出文件和目录
   暗淡我作为龙,S作为龙
   
   对于i = 1到莱恩(NSTR)
      如果MID(NSTR,I,1)=“”则S = I   '查找最后一个目录分隔符
   接下来
   若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:
端功能

 

''一篇文章放不下全部代码,这仅是第二页,转到:第一页

展开阅读全文

没有更多推荐了,返回首页