VB开发海康摄像头时,不能预览

scmylyk 2015-09-08 04:02:57
在用VB开发时,函数返回值正确,但就是不能预览图像,抓图正常,请高手指教,如果有VB.net的代码请不吝赐教
'屏蔽主窗体的关闭按钮
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 As Long
Private devInfo As NET_DVR_DEVICEINFO_V30
Private clientInfo As NET_DVR_CLIENTINFO
'Download by http://www.codefans.net
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 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 = "192.168.1.64"
devPort.Text = "8000"
devName.Text = "admin"
devPwd.Text = "admin12345"
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)
hMonitorId = -1
Picture1.Refresh
End If

If (hLoginId > -1) Then '已经登录
clientInfo.lChannel = 1 ''devCH.Text hMonitorCha '通道号
clientInfo.lLinkMode = 0 '最高位(31)为0表示主码流,为1表示子,0-30位表示码流连接方式: 0:TCP方式,1:UDP方式,2:多播方式,3 - RTP方式,4-音视频分开(TCP)
clientInfo.hPlayWnd = Picture2.hwnd '播放窗口的句柄,为NULL表示不播放图象
clientInfo.sMultiCastIP = 0 '多播组地址
hMonitorId = NET_DVR_RealPlay_V30(hLoginId, clientInfo, PtrToLong(AddressOf REALDATACALLBACK), 0, True) '实时预览
' hMonitorId = NET_DVR_RealPlay_V30(hLoginId, clientInfo, 0, 0, True) '实时预览
Debug.Print hMonitorId
End If

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(0)
hMonitorId = -1
Picture1.Refresh
End If

End Sub



Private Sub Command2_Click() '退出

On Error Resume Next

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
...全文
1924 6 打赏 收藏 转发到动态 举报
写回复
用AI写文章
6 条回复
切换为时间正序
请发表友善的回复…
发表回复
qq_16637545 2017-04-21
  • 打赏
  • 举报
回复
遇到同样的问题,大神教我
WENSHUI2020 2016-10-13
  • 打赏
  • 举报
回复
hMonitorId值为-1,不是0?
WENSHUI2020 2016-10-13
  • 打赏
  • 举报
回复
学习你的软件了,请问你最终是如何解决的?
Tiger_Zhao 2015-09-09
  • 打赏
  • 举报
回复
万能答案:
要供应商提供样例啊!
你付钱卖硬件还不要服务,太傻了吧!

scmylyk 2015-09-09
  • 打赏
  • 举报
回复
代码没问题,己经解决了
scmylyk 2015-09-08
  • 打赏
  • 举报
回复
自己顶一哈!

809

社区成员

发帖
与我相关
我的任务
社区描述
VB 多媒体
社区管理员
  • 多媒体
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧