在好例子网，分享、交流、成长！
您当前所在位置：首页 → ASP 开发实例 → VB编程 → vb海康摄像编程

vb海康摄像编程

VB编程

下载此实例
  • 开发语言：ASP
  • 实例大小：7.88M
  • 下载次数：164
  • 浏览次数：1665
  • 发布时间：2018-08-07
  • 实例类别：VB编程
  • 发 布 人：kaleven
  • 文件格式：.rar
  • 所需积分：2
 相关标签： vb 摄像 编程 海康
网友评论 举报投诉 收藏该页

实例介绍

【实例简介】

【实例截图】

from clipboard

【核心代码】


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
'屏蔽主窗体的关闭按钮
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


标签： vb 摄像 编程 海康

实例下载地址

vb海康摄像编程

不能下载？内容有错？ 点击这里报错 + 投诉 + 提问

好例子网口号：伸出你的我的手 — 分享！

相关软件

相关文章

网友评论

我要评论

第 1 楼 创意 发表于: 2021-02-03 14:53 41
不能获取摄像机的声音

支持(0) 盖楼(回复)

第 2 楼 1711701015 发表于: 2021-04-04 18:46 23
实时预览失败 怎么回事

支持(0) 盖楼(回复)

发表评论

(您的评论需要经过审核才能显示)

查看所有2条评论>>

小贴士

感谢您为本站写下的评论，您的评论对其它用户来说具有重要的参考价值，所以请认真填写。

  • 类似“顶”、“沙发”之类没有营养的文字，对勤劳贡献的楼主来说是令人沮丧的反馈信息。
  • 相信您也不想看到一排文字/表情墙，所以请不要反馈意义不大的重复字符，也请尽量不要纯表情的回复。
  • 提问之前请再仔细看一遍楼主的说明，或许是您遗漏了。
  • 请勿到处挖坑绊人、招贴广告。既占空间让人厌烦，又没人会搭理，于人于己都无利。

关于好例子网

本站旨在为广大IT学习爱好者提供一个非营利性互相学习交流分享平台。本站所有资源都可以被免费获取学习研究。本站资源来自网友分享，对搜索内容的合法性不具有预见性、识别性、控制性，仅供学习研究，请务必在下载后24小时内给予删除，不得用于其他任何用途，否则后果自负。基于互联网的特殊性，平台无法对用户传输的作品、信息、内容的权属或合法性、安全性、合规性、真实性、科学性、完整权、有效性等进行实质审查；无论平台是否已进行审查，用户均应自行承担因其传输的作品、信息、内容而可能或已经产生的侵权或权属纠纷等法律责任。本站所有资源不代表本站的观点或立场，基于网友分享，根据中国法律《信息网络传播权保护条例》第二十二与二十三条之规定，若资源存在侵权或相关问题请联系本站客服人员，点此联系我们。关于更多版权及免责申明参见 版权及免责申明

;
报警