vb.net怎么调用外置usb相机(摄像机)进行拍照保存

gussie 2018-05-16 03:35:38
如题:在网上找到一个调用程序,但是只能调用本机的相机,外置的能找到相机但是不能显示和保存图片。高手请帮忙!
Imports System
Imports System.Runtime.InteropServices
Imports System.Drawing
Imports System.Drawing.Imaging
Class Camera
Private Const WM_CAP_START = WM_USER
Private Const WM_CAP_STOP = WM_CAP_START + 68
Private Const WM_CAP_DRIVER_CONNECT = WM_CAP_START + 10
Private Const WM_CAP_DRIVER_DISCONNECT = WM_CAP_START + 11
Private Const WM_CAP_SAVEDIB = WM_CAP_START + 25
Private Const WM_CAP_GRAB_FRAME = WM_CAP_START + 60
Private Const WM_CAP_SEQUENCE = WM_CAP_START + 62
Private Const WM_CAP_FILE_SET_CAPTURE_FILEA = WM_CAP_START + 20
Private Const WM_CAP_SEQUENCE_NOFILE = WM_CAP_START + 63
Private Const WM_CAP_SET_OVERLAY = WM_CAP_START + 51
Private Const WM_CAP_SET_PREVIEW = WM_CAP_START + 50
Private Const WM_CAP_SET_CALLBACK_VIDEOSTREAM = WM_CAP_START + 6
Private Const WM_CAP_SET_CALLBACK_ERROR = WM_CAP_START + 2
Private Const WM_CAP_SET_CALLBACK_STATUSA = WM_CAP_START + 3
Private Const WM_CAP_SET_CALLBACK_FRAME = WM_CAP_START + 5
Private Const WM_CAP_SET_SCALE = WM_CAP_START + 53
Private Const WM_CAP_SET_PREVIEWRATE = WM_CAP_START + 52
Sub New(ByVal I As PictureBox)
o = I
End Sub
Dim o As PictureBox
Dim M_Handle As IntPtr

Private Const WM_CAP_EDIT_COPY = (WM_CAP_START + 30)

Private Declare Sub Sleep Lib "kernel32" Alias "Sleep" (ByVal dwMilliseconds As Integer)
Private Declare Function capCreateCaptureWindow Lib "avicap32.dll" _
Alias "capCreateCaptureWindowA" (ByVal lpszWindowName As String, _
ByVal dwStyle As Integer, ByVal x As Integer, ByVal y As Integer, ByVal nWidth As Integer, _
ByVal nHeight As Integer, ByVal hWndParent As Integer, ByVal nID As Integer) As Integer
Private Const WS_CHILD = &H40000000
Private Const WS_VISIBLE = &H10000000
Private Const WM_USER = &H400

Private Declare Function SendMessage Lib "user32" _
Alias "SendMessageA" (ByVal hwnd As Integer, _
ByVal wMsg As Integer, ByVal wParam As Integer, _
ByVal lParam As String) As Integer


Public Function GrabImage() As Bitmap
'paht:要保存bmp文件的路径

SendMessage(M_Handle, WM_CAP_EDIT_COPY, 0, 0)
Return Clipboard.GetImage
End Function
Function CreateCaptureWindow(ByVal hWndParent As PictureBox,
ByVal x As Integer, ByVal y As Integer, ByVal nWidth As Integer, ByVal nHeight As Integer,
ByVal nCameraID As Integer) As Integer
Dim Preview_Handle As Integer
Preview_Handle = capCreateCaptureWindow("Video", _
WS_CHILD + WS_VISIBLE, x, y, _
hWndParent.Width, hWndParent.Height, hWndParent.Handle, 0)
Dim BOOL As Boolean
BOOL = SendMessage(Preview_Handle, WM_CAP_DRIVER_CONNECT, nCameraID, 0) 'ncameraid(视频只有一个为0,多个以此类推)
If (BOOL = False) Then
MsgBox("没有找到视频设备!")
End If
SendMessage(Preview_Handle, WM_CAP_SET_PREVIEWRATE, 30, 0)
SendMessage(Preview_Handle, WM_CAP_SET_OVERLAY, 1, 0)
SendMessage(Preview_Handle, WM_CAP_SET_PREVIEW, 1, 0)
M_Handle = Preview_Handle
Return Preview_Handle
End Function

Dim blnRunning As Boolean = False
Public Sub Disconnect()
SendMessage(M_Handle, WM_CAP_DRIVER_DISCONNECT, 0, 0)
End Sub
Dim blnRecording As Boolean = False
'录像
Public Sub KineScope(ByVal path As String)
If blnRecording Then
Return
Else
blnRecording = True
End If

'path:要保存avi文件的路径
Dim hBmp As IntPtr = Marshal.StringToHGlobalAnsi(path)
SendMessage(M_Handle, WM_CAP_FILE_SET_CAPTURE_FILEA, 0, hBmp.ToInt64())
SendMessage(M_Handle, WM_CAP_SEQUENCE, 0, 0)
End Sub
Public Sub StopKinescope()
If blnRecording Then
SendMessage(M_Handle, WM_CAP_STOP, 0, 0)
End If
blnRecording = False
End Sub
End Class

上面是camera.vb接口类
下面是实现form

Public Class CamoraForm
Dim camora As New Camera(PictureBox1)
Private Sub CamoraForm_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load

End Sub
Private Sub CommendStart_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles CommendStart.Click

camora.CreateCaptureWindow(PictureBox1, 0, 0, PictureBox1.Width, PictureBox1.Height, 0)
End Sub

Private Sub CommendStop_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles CommendStop.Click

camora.StopKinescope()
camora.Disconnect()
End Sub

Private Sub CommendTake_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles CommendTake.Click
Me.PictureBox2.BackgroundImage = camora.GrabImage()
End Sub

Private Sub CommendSave_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles CommendSave.Click
Dim pic_path As String = "D:\\cam_pic.jpg"
PictureBox2.BackgroundImage.Save(pic_path)
'PictureBox2.Image.Save(pic_path)
End Sub
End Class

...全文
1435 2 打赏 收藏 转发到动态 举报
写回复
用AI写文章
2 条回复
切换为时间正序
请发表友善的回复…
发表回复
ILOVEYOUVB 2018-07-14
  • 打赏
  • 举报
回复
外置相机利用配套软件连接下,然后用该程序就可获取了。
gussie 2018-05-17
  • 打赏
  • 举报
回复
那么多牛人,多多帮忙啊!

16,552

社区成员

发帖
与我相关
我的任务
社区描述
VB技术相关讨论,主要为经典vb,即VB6.0
社区管理员
  • VB.NET
  • 水哥阿乐
  • 无·法
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

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