实例介绍
【实例简介】
【实例截图】
【核心代码】
'屏蔽主窗体的关闭按钮 Private Declare Function RemoveMenu Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long Private Declare Function GetSystemMenu Lib "user32" (ByVal hwnd As Long, ByVal bRevert As Long) As Long Private Const MF_BYPOSITION = &H1000& Private Const SC_CLOSE = &HF060 '关闭 Private Const SC_MAXIMIZE = &HF030 '最大化 Private Const SC_MINIMIZE = &HF020 '最小化 Private Const NET_DVR_SET_TIMECFG As Long = 119 '设置DVR时间 Private Time As LPNET_DVR_TIME Private bInited, bout As Boolean Private hLoginId, hMonitorId, hMonitorId1 As Long Private devInfo As NET_DVR_DEVICEINFO_V30 Private clientInfo As NET_DVR_CLIENTINFO Private clientInfo1 As NET_DVR_CLIENTINFO Public lVoiceHanle As Long Private Sub Command1_Click() Time.dwYear = Mid(ChkTime.Text, 1, 4) ' 2009 Time.dwMonth = Mid(ChkTime.Text, 6, 2) '7 Time.dwDay = Mid(ChkTime.Text, 9, 2) '20 Time.dwHour = Mid(ChkTime.Text, 12, 2) '9 Time.dwMinute = Mid(ChkTime.Text, 15, 2) '38 Time.dwSecond = Mid(ChkTime.Text, 18, 2) ' 0 bSucc = NET_DVR_SetDVRConfig(hLoginId, NET_DVR_SET_TIMECFG, 0, Time, LenB(Time)) End Sub Private Sub Command9_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) bb = NET_DVR_PTZControlWithSpeed(hMonitorId1, 21, 0, 3) End Sub Private Sub Command9_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) bb = NET_DVR_PTZControlWithSpeed(hMonitorId1, 21, 1, 3) End Sub Private Sub Command10_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) bb = NET_DVR_PTZControlWithSpeed(hMonitorId1, 22, 0, 3) End Sub Private Sub Command10_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) bb = NET_DVR_PTZControlWithSpeed(hMonitorId1, 22, 1, 3) End Sub Private Sub Command11_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) bb = NET_DVR_PTZControlWithSpeed(hMonitorId1, 23, 0, 3) End Sub Private Sub Command11_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) bb = NET_DVR_PTZControlWithSpeed(hMonitorId1, 23, 1, 3) End Sub Private Sub Command12_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) bb = NET_DVR_PTZControlWithSpeed(hMonitorId1, 24, 0, 3) End Sub Private Sub Command12_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) bb = NET_DVR_PTZControlWithSpeed(hMonitorId1, 24, 1, 3) End Sub Private Sub Command13_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) bb = NET_DVR_PTZControlWithSpeed(hMonitorId1, 11, 0, 3) End Sub Private Sub Command13_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) bb = NET_DVR_PTZControlWithSpeed(hMonitorId1, 11, 1, 3) End Sub Private Sub Command14_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) bb = NET_DVR_PTZControlWithSpeed(hMonitorId1, 12, 0, 3) End Sub Private Sub Command14_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) bb = NET_DVR_PTZControlWithSpeed(hMonitorId1, 12, 1, 3) End Sub Private Sub Command15_Click() lVoiceHanle = NET_DVR_StartVoiceCom_V30(hLoginId1, 1, 1, 0, 0) Command15.Caption = lVoiceHanle End Sub Private Sub Command16_Click() Dim aa As Long aa = NET_DVR_StopVoiceCom(lVoiceHanle) Command16.Caption = aa End Sub Private Sub Command7_Click() Dim str As String str = BrowseForFolder(hwnd, "请选择抓图目录.") If str <> "" Then Dim strLast As String strLast = Right(str, 1) If strLast <> "\" Then Text1.Text = str "\" Else Text1.Text = str End If End If End Sub Private Sub Command8_Click() '抓图 Dim jg As Boolean Dim bl As LPNET_DVR_JPEGPARA Dim mypath As String Dim filename As String bl.wPicSize = 0 bl.wPicQuality = 0 jg = False mypath = Text1.Text If Trim(mypath) = "" Then mypath = App.Path "\" End If If (hLoginId < 0) Then MsgBox "没有登录", vbInformation, "提示" Exit Sub Else filename = mypath "text1.jpg" ' jg = NET_DVR_CapturePicture(hMonitorId, "c:\test1.bmp") '保存成.bmp文件 jg = NET_DVR_CaptureJPEGPicture(hLoginId, 1, bl, filename) '保存成.jpg文件 GoTo exit1 End If exit1: If (jg = False) Then MsgBox "抓图失败", vbInformation, "提示" Else MsgBox "抓图成功", vbInformation, "提示" End If End Sub Private Sub Form_Load() '窗体加载 On Error GoTo loaderror RemoveMenu GetSystemMenu(Me.hwnd, 0), SC_CLOSE, MF_BYPOSITION '关闭按钮不可用 bInited = False bout = False hLoginId = -1 hMonitorId = -1 devIP.Text = "10.28.9.152" devPort.Text = "8000" devName.Text = "abc" devPwd.Text = "123" devCH.Text = "1" Exit Sub loaderror: MsgBox "系统出错1" End Sub Private Sub Command4_Click() '登陆 On Error GoTo loaderror If devIP.Text = "" Then MsgBox "请输入IP" devIP.SetFocus Exit Sub End If If devPort.Text = "" Then MsgBox "请输入端口" devPort.SetFocus Exit Sub End If If devName.Text = "" Then MsgBox "请输入用户名" devName.SetFocus Exit Sub End If If devCH.Text = "" Then MsgBox "请输入通道号" devCH.SetFocus Exit Sub End If bInited = NET_DVR_Init() '初始化SDK On Error Resume Next If (bInited = False) Then MsgBox "初始化失败" Exit Sub End If hLoginId = NET_DVR_Login_V30(devIP.Text, devPort.Text, devName.Text, devPwd.Text, devInfo) '用户注册 If (hLoginId = -1) Then MsgBox "登陆失败" Exit Sub End If Text4.Text = hLoginId MsgBox "登陆成功" Exit Sub loaderror: MsgBox "系统出错2" End Sub Private Sub Command5_Click() '注销 On Error Resume Next If hMonitorId > -1 Then Call NET_DVR_StopRealPlay(hMonitorId) hLoginId = -1 Picture1.Refresh End If If hLoginId > -1 Then bout = NET_DVR_Logout(hLoginId) hLoginId = -1 Call NET_DVR_Cleanup End If If bout = False Then MsgBox "注销设备失败" Exit Sub End If MsgBox "注销设备成功" End Sub Private Sub Command6_Click() '预览 On Error Resume Next If (hMonitorId > -1) Then Call NET_DVR_StopRealPlay(hMonitorId) Call NET_DVR_StopRealPlay(hMonitorId1) hMonitorId = -1 hMonitorId1 = -1 Picture1.Refresh Picture2.Refresh End If Picture1.Refresh If (hLoginId > -1) Then '已经登录 clientInfo.lChannel = 1 'Val(devCH) '通道号 clientInfo.lLinkMode = 0 '最高位(31)为0表示主码流,为1表示子,0-30位表示码流连接方式: 0:TCP方式,1:UDP方式,2:多播方式,3 - RTP方式,4-音视频分开(TCP) clientInfo.hPlayWnd = Picture1.hwnd '播放窗口的句柄,为NULL表示不播放图象 clientInfo.sMultiCastIP = 0 '多播组地址 hMonitorId = NET_DVR_RealPlay_V30(hLoginId, clientInfo, 0, 0, 0) '实时预览 ' hMonitorId = NET_DVR_RealPlay_V30(hLoginId, clientInfo, PtrToLong(AddressOf REALDATACALLBACK), 0, True) '实时预览 clientInfo1.lChannel = 2 'Val(devCH) '通道号 clientInfo1.lLinkMode = 0 '最高位(31)为0表示主码流,为1表示子,0-30位表示码流连接方式: 0:TCP方式,1:UDP方式,2:多播方式,3 - RTP方式,4-音视频分开(TCP) clientInfo1.hPlayWnd = Picture2.hwnd '播放窗口的句柄,为NULL表示不播放图象 clientInfo1.sMultiCastIP = 0 '多播组地址 hMonitorId1 = NET_DVR_RealPlay_V30(hLoginId, clientInfo1, 0, 0, 0) '实时预览 Debug.Print hMonitorId Debug.Print hMonitorId1 End If 'Picture1.Refresh If (hMonitorId = -1) Then MsgBox "实时预览失败" Exit Sub End If End Sub Private Sub Command3_Click() '停止预览 On Error Resume Next If hMonitorId > -1 Then Debug.Print "hello" Debug.Print hMonitorId Call NET_DVR_StopRealPlay(hMonitorId) Call NET_DVR_StopRealPlay(hMonitorId1) hMonitorId = -1 hMonitorId1 = -1 Picture1.Refresh Picture2.Refresh End If End Sub Private Sub Command2_Click() '退出 On Error Resume Next If lVoiceHanle > 0 Then aa = NET_DVR_StopVoiceCom(lVoiceHanle) End If If hMonitorId > -1 Then Call NET_DVR_StopRealPlay(hMonitorId) Call NET_DVR_StopRealPlay(hMonitorId1) hMonitorId = -1 Picture1.Refresh End If If hLoginId > -1 Then Call NET_DVR_Logout(hLoginId) hLoginId = -1 Call NET_DVR_Cleanup End If End End Sub Private Sub Form_Unload(Cancel As Integer) On Error Resume Next If lVoiceHanle > 0 Then aa = NET_DVR_StopVoiceCom(lVoiceHanle) End If If hMonitorId > -1 Then Call NET_DVR_StopRealPlay(hMonitorId) hMonitorId = -1 Picture1.Refresh End If If hLoginId > -1 Then Call NET_DVR_Logout(hLoginId) hLoginId = -1 Call NET_DVR_Cleanup End If End End Sub
好例子网口号:伸出你的我的手 — 分享!
网友评论
小贴士
感谢您为本站写下的评论,您的评论对其它用户来说具有重要的参考价值,所以请认真填写。
- 类似“顶”、“沙发”之类没有营养的文字,对勤劳贡献的楼主来说是令人沮丧的反馈信息。
- 相信您也不想看到一排文字/表情墙,所以请不要反馈意义不大的重复字符,也请尽量不要纯表情的回复。
- 提问之前请再仔细看一遍楼主的说明,或许是您遗漏了。
- 请勿到处挖坑绊人、招贴广告。既占空间让人厌烦,又没人会搭理,于人于己都无利。
关于好例子网
本站旨在为广大IT学习爱好者提供一个非营利性互相学习交流分享平台。本站所有资源都可以被免费获取学习研究。本站资源来自网友分享,对搜索内容的合法性不具有预见性、识别性、控制性,仅供学习研究,请务必在下载后24小时内给予删除,不得用于其他任何用途,否则后果自负。基于互联网的特殊性,平台无法对用户传输的作品、信息、内容的权属或合法性、安全性、合规性、真实性、科学性、完整权、有效性等进行实质审查;无论平台是否已进行审查,用户均应自行承担因其传输的作品、信息、内容而可能或已经产生的侵权或权属纠纷等法律责任。本站所有资源不代表本站的观点或立场,基于网友分享,根据中国法律《信息网络传播权保护条例》第二十二与二十三条之规定,若资源存在侵权或相关问题请联系本站客服人员,点此联系我们。关于更多版权及免责申明参见 版权及免责申明
支持(0) 盖楼(回复)
支持(0) 盖楼(回复)