VB开发海康摄像头时,不能预览
在用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