vb摄像头源码

① 谁能用vb编写摄像头拍照程序

用 VFW 函数集即可实现
都是系统提供的 不算是第三方

步骤比较简单 只需要几步调用即可
VFW 提供了抓拍动态视频和静态图片的函数

详细的 VFW 函数调用方法 请查一下 MSDN
都是 cap 开头的函数
比如 capCreateCaptureWindow 等等

② 谁能给个用VB调用摄像头并保存的代码

运用这段简单的代码，可以用VB轻松地打开摄像头拍照，改动后可实现后台拍照！模块代码

"avicap32.dll"_
Alias"capCreateCaptureWindowA"(_
ByVallpszWindowNameAsString,_
ByValdwStyleAsLong,_
ByValxAsLong,_
ByValyAsLong,_
ByValnWidthAsLong,_
ByValnHeightAsLong,_
ByValhWndParentAsLong,_
ByValnIDAsLong)AsLong
PrivateConstWS_CHILD=&H40000000
PrivateConstWS_VISIBLE=&H10000000
PrivateConstWM_USER=&H400
PrivateConstWM_CAP_START=&H400
PrivateConstWM_CAP_EDIT_COPY=(WM_CAP_START+30)
PrivateConstWM_CAP_DRIVER_CONNECT=(WM_CAP_START+10)
PrivateConstWM_CAP_SET_PREVIEWRATE=(WM_CAP_START+52)
PrivateConstWM_CAP_SET_OVERLAY=(WM_CAP_START+51)
PrivateConstWM_CAP_SET_PREVIEW=(WM_CAP_START+50)
PrivateConstWM_CAP_DRIVER_DISCONNECT=(WM_CAP_START+11)
"user32"_
Alias"SendMessageA"(_
ByValhwndAsLong,_
ByValwMsgAsLong,_
ByValwParamAsLong,_
lParamAsAny)AsLong
PrivatePreview_HandleAsLong
(_
hWndParentAsLong,_
OptionalxAsLong=0,_
OptionalyAsLong=0,_
OptionalnWidthAsLong=320,_
OptionalnHeightAsLong=240,_
OptionalnCameraIDAsLong=0)AsLong
Preview_Handle=capCreateCaptureWindow("Video",_
WS_CHILD+WS_VISIBLE,x,y,_
nWidth,nHeight,hWndParent,1)
SendMessagePreview_Handle,WM_CAP_DRIVER_CONNECT,nCameraID,0
SendMessagePreview_Handle,WM_CAP_SET_PREVIEWRATE,30,0
SendMessagePreview_Handle,WM_CAP_SET_OVERLAY,1,0
SendMessagePreview_Handle,WM_CAP_SET_PREVIEW,1,0
CreateCaptureWindow=Preview_Handle
EndFunction
PublicFunctionCapturePicture(nCaptureHandleAsLong)AsStdPicture
Clipboard.Clear
SendMessagenCaptureHandle,WM_CAP_EDIT_COPY,0,0
SetCapturePicture=Clipboard.GetData
EndFunction
PublicSubDisconnect(nCaptureHandleAsLong,_
OptionalnCameraID=0)
SendMessagenCaptureHandle,WM_CAP_DRIVER_DISCONNECT,_
nCameraID,0
EndSub
'在form上添加一个PictureBox,名称改为PicCapture,一个按钮,名称为Command1。
DimVideo_HandleAsLong
PrivateSubForm_Load()
Video_Handle=CreateCaptureWindow(PicCapture.hwnd)
EndSub
PrivateSubCommand1_Click()
DimxAsStdPicture
Setx=CapturePicture(Video_Handle)
SavePicturex,"c:a.bmp"'拍照保存
EndSub
PrivateSubForm_Unload(CancelAsInteger)
DisconnectVideo_Handle
EndSub

③ 使用VB语言编写，在界面上画个框，里面显示摄像头里的图像

就是用摄像头来拍个照嘛...

'一个VB制作摄像头拍照的源码，如下：
"avicap32.dll"_
Alias"capCreateCaptureWindowA"(_
ByVallpszWindowNameAsString,_
ByValdwStyleAsLong,_
ByValxAsLong,_
ByValyAsLong,_
ByValnWidthAsLong,_
ByValnHeightAsLong,_
ByValhWndParentAsLong,_
ByValnIDAsLong)AsLong
PrivateConstWS_CHILD=&H40000000
PrivateConstWS_VISIBLE=&H10000000
PrivateConstWM_USER=&H400
PrivateConstWM_CAP_START=&H400
PrivateConstWM_CAP_EDIT_COPY=(WM_CAP_START+30)
PrivateConstWM_CAP_DRIVER_CONNECT=(WM_CAP_START+10)
PrivateConstWM_CAP_SET_PREVIEWRATE=(WM_CAP_START+52)
PrivateConstWM_CAP_SET_OVERLAY=(WM_CAP_START+51)
PrivateConstWM_CAP_SET_PREVIEW=(WM_CAP_START+50)
PrivateConstWM_CAP_DRIVER_DISCONNECT=(WM_CAP_START+11)
PrivatePreview_HandleAsLong
"user32"_
Alias"SendMessageA"(_
ByValhwndAsLong,_
ByValwMsgAsLong,_
ByValwParamAsLong,_
lParamAsAny)AsLong
PrivateFunctionCapturePicture(nCaptureHandleAsLong)AsStdPicture
Clipboard.Clear
SendMessagenCaptureHandle,WM_CAP_EDIT_COPY,0,0
SetCapturePicture=Clipboard.GetData
EndFunction
PrivateSubcmdCap_Click()
Picture1.Picture=CapturePicture(Preview_Handle)
EndSub
PrivateSubcmdSave_Click()
OnErrorResumeNext
SavePicturePicture1.Picture,"C:"&Format(Date,"dd-MM-yyyy")&""&Format(Time,"hh-mm-ss")&".bmp"
EndSub
PrivateSubForm_Load()
Preview_Handle=capCreateCaptureWindow("Video",WS_CHILD+WS_VISIBLE,2,2,320,240,Me.hwnd,1)
SendMessagePreview_Handle,WM_CAP_DRIVER_CONNECT,0,0
SendMessagePreview_Handle,WM_CAP_SET_PREVIEWRATE,1,0
SendMessagePreview_Handle,WM_CAP_SET_PREVIEW,1,0
EndSub
PrivateSubForm_Unload(CancelAsInteger)
SendMessagePreview_Handle,WM_CAP_DRIVER_DISCONNECT,0,0
EndSub

④ 求教如何用vb程序实现打开自己摄像头，要全代码

最简单的一个

Private Const WS_CHILD = &H40000000
Private Const WS_VISIBLE = &H10000000

Private Const WM_CAP_START = &H400
Private Const WM_CAP_DRIVER_CONNECT = WM_CAP_START + 10
Private Const WM_CAP_SET_SCALE = WM_CAP_START + 53
Private Const WM_CAP_SET_PREVIEWRATE = WM_CAP_START + 52
Private Const WM_CAP_SET_PREVIEW = WM_CAP_START + 50

Private Declare Function capCreateCaptureWindowA Lib "avicap32.dll" ( _
ByVal lpszWindowName As String, _
ByVal dwStyle As Long, _
ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Integer, _
ByVal hWndParent As Long, ByVal nID As Long) As Long

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Integer, ByVal lParam As Long) As Long

Private Sub Form_Load()
'建立采集窗口（不显示窗口，处理后显示到PIC控件）
uwndc = capCreateCaptureWindowA("", WS_VISIBLE Or WS_CHILD, 0, 0, 320, 240, Me.hWnd, 0)
'连接
SendMessage uwndc, WM_CAP_DRIVER_CONNECT, 0, 0
'Scale开
SendMessage uwndc, WM_CAP_SET_SCALE, True, 0
'显示刷新MS
SendMessage uwndc, WM_CAP_SET_PREVIEWRATE, 40, 0
'用予览方式显示(特殊需要，不显示予缆）
SendMessage uwndc, WM_CAP_SET_PREVIEW, True, 0
End Sub

⑤ vb6 无驱摄像头编程 求源码

发下是我几年前写的(参照)一个VB驱动摄像头的代码,不知道现在还能不能用,因为文件总的很长,这只是其中的一小部分,希望对你有所用.(要不就和我联系,给你源码)
Private Sub Form_Load()
On Error Resume Next
Dim retVal As Boolean
Dim numDevs As Long
bCaramaPlaying = True
'load trivial settings first
Me.BackColor = Val(GetSetting(App.Title, "preferences", "backcolor", "&H404040")) 'default to dk gray

numDevs = VBEnumCapDrivers(Me)
If 0 = numDevs Then
MsgBox "没有找到视频捕捉设备!", vbCritical, App.Title
' frmPlayer.Visible = True
' If bIsVisible = True And vbPlayFormIsVisible = True And vbFrmPlayFrameHided = False Then
' frmPlayFrame.Visible = True
' End If
Unload Me
Exit Sub
End If
nDriverIndex = Val(GetSetting(App.Title, "driver", "index", "0"))
'if invalid entry is in registry use default (0)
If mnuDriver.UBound < nDriverIndex Then
nDriverIndex = 0
End If
mnuDriver(nDriverIndex).Checked = True
'//Create Capture Window
'Call capGetDriverDescription( nDriverIndex, lpszName, 100, lpszVer, 100 '// Retrieves driver info
hCapWnd = capCreateCaptureWindow("VB CAP WINDOW", WS_CHILD Or WS_VISIBLE, 0, 0, 160, 120, Me.hWnd, 0)
If 0 = hCapWnd Then
MsgBox "不能创建捕捉窗口!", vbCritical, App.Title
Exit Sub
End If
retVal = ConnectCapDriver(hCapWnd, nDriverIndex)
If False = retVal Then
MsgBox "不能连接到视频设备!", vbInformation, App.Title
Else
#If USECALLBACKS = 1 Then
' if we have a valid capwnd we can enable our status callback function
Call capSetCallbackOnStatus(hCapWnd, AddressOf StatusProc)
Debug.Print "---Callback set on capture status---"
#End If
End If
'// Set the video stream callback function
' capSetCallbackOnVideoStream lwndC, AddressOf MyVideoStreamCallback
' capSetCallbackOnFrame lwndC, AddressOf MyFrameCallback

Dim bPlayFrameTop As Boolean
bPlayFrameTop = GetSetting(MyName, "setting" & "-" & Trim(Str(App.Major)) & "-" & Trim(Str(App.Minor)), "bPlayFrameTop", "False")
If bPlayFrameTop = True Then
Me.mnuOptionTop.Checked = True
'放在最前
SetWindowPos Me.hWnd, HWND_TOPMOST, Me.Left / Screen.TwipsPerPixelX, Me.Top / Screen.TwipsPerPixelY, Me.Width / Screen.TwipsPerPixelX, Me.Height / Screen.TwipsPerPixelY, &H20
Else
Me.mnuOptionTop.Checked = False
'不放在最前
SetWindowPos Me.hWnd, HWND_NOTOPMOST, Me.Left / Screen.TwipsPerPixelX, Me.Top / Screen.TwipsPerPixelY, Me.Width / Screen.TwipsPerPixelX, Me.Height / Screen.TwipsPerPixelY, &H20
End If
Me.Left = (Screen.Width - Me.Width) / 2
Me.Top = (Screen.Height - Me.Height) / 2
Me.picShowMenu.ZOrder 0

End Sub

'以下是一个模块文件
Option Explicit

'application specific routines are here

Public Const ONE_MEGABYTE As Long = 1048576
'Public Const MMSYSERR_NOERROR As Long = 0
Public Const INDEX_15_MINUTES As Long = 27000 '(30fps * 60sec * 15min)
Public Const INDEX_3_HOURS As Long = 324000 ' (30fps * 60sec * 60min * 3hr)

Public Function GetFreeSpace() As Long
'this function gets the amount of free disk space and adds the size
'of the current capture file
Dim freedisk As Long
Dim path As String

'get Cap File length
path = capFileGetCaptureFile(frmCaramaMain.capwnd)
If path <> "" Then
On Error Resume Next
freedisk = FileLen(path)
freedisk = freedisk / ONE_MEGABYTE
End If

'now get free disk space from that drive
path = Left$(path, 3)
GetFreeSpace = freedisk + vbGetAvailableMBytes(path)

End Function

Sub ResizeCaptureWindow(ByVal hCapWnd As Long)
Dim retVal As Boolean
Dim capStat As CAPSTATUS

'Get the capture window attributes
retVal = capGetStatus(hCapWnd, capStat)

If retVal Then
'Resize the main form to fit
Call SetWindowPos(frmCaramaMain.hWnd, _
0&, _
0&, _
0&, _
capStat.uiImageWidth + (frmCaramaMain.XBorder * 2), _
capStat.uiImageHeight + (frmCaramaMain.YBorder * 4) _
+ frmCaramaMain.CaptionHeight + frmCaramaMain.MenuHeight, _
Swp_nomove Or SWP_NOZORDER Or SWP_NOSENDCHANGING)
'Resize the capture window to format size
Call SetWindowPos(hCapWnd, _
0&, _
0&, _
0&, _
capStat.uiImageWidth, _
capStat.uiImageHeight, _
Swp_nomove Or SWP_NOZORDER Or SWP_NOSENDCHANGING)
End If
Call frmCaramaMain.Form_Resize
End Sub

Public Function VBEnumCapDrivers(ByRef frm As frmCaramaMain) As Long
'/*
' * Enumerate the potential capture drivers and add the list to the Options
' * menu. This function is only called once at startup.
' * Returns 0 if no drivers are available.
' */
Const MAXVIDDRIVERS As Long = 9
Const CAP_STRING_MAX As Long = 128
Dim numDrivers As Long
Dim driverStrings(0 To MAXVIDDRIVERS - 1) As String
Dim Index As Long
Dim Device As String
Dim Version As String
Dim menu As VB.menu

Device = String$(CAP_STRING_MAX, 0)
Version = String$(CAP_STRING_MAX, 0)
numDrivers = 0
For Index = 0 To (MAXVIDDRIVERS - 1) Step 1
If 0 <> capGetDriverDescription(Index, _
Device, _
CAP_STRING_MAX, _
Version, _
CAP_STRING_MAX) _
Then
'extend the menu
If Index > 0 Then
Load frm.mnuDriver(Index)
End If
Set menu = frm.mnuDriver(Index) 'get an object pointer to the new menu
'Concatenate the device name and version strings to the new menu item
menu.Caption = Left$(Device, InStr(Device, vbNullChar) - 1)
menu.Caption = menu.Caption & " "
menu.Caption = menu.Caption & Left$(Version, InStr(Version, vbNullChar) - 1)
menu.Enabled = True
numDrivers = numDrivers + 1
End If

Next
VBEnumCapDrivers = numDrivers
End Function

Public Function ConnectCapDriver(ByVal hCapWnd As Long, ByVal nDriverIndex As Long) As Boolean
Dim retVal As Boolean
Dim Caps As CAPDRIVERCAPS
Dim i As Long

Debug.Assert (nDriverIndex < 10) And (nDriverIndex >= 0)
'// Connect the capture window to the driver
retVal = capDriverConnect(hCapWnd, nDriverIndex)
If False = retVal Then
'return False
Exit Function
End If
'// Get the capabilities of the capture driver
retVal = capDriverGetCaps(hCapWnd, Caps)

If False <> retVal Then
'reset menus (very app-specific)
With frmCaramaMain
For i = 0 To .mnuDriver.UBound
.mnuDriver(i).Checked = False 'make sure all drivers are unchecked
Next
.mnuDriver(nDriverIndex).Checked = True 'then check the new driver
'disable all hardware feature menu items
.mnuSource.Enabled = False
.mnuFormat.Enabled = False
.mnuDisplay.Enabled = False
.mnuOverlay.Enabled = False
'Then enable the ones which are supported by the new driver
If Caps.fHasDlgVideoSource <> 0 Then .mnuSource.Enabled = True
If Caps.fHasDlgVideoFormat <> 0 Then .mnuFormat.Enabled = True
If Caps.fHasDlgVideoDisplay <> 0 Then .mnuDisplay.Enabled = True
If Caps.fHasOverlay <> 0 Then .mnuOverlay.Enabled = True

End With
End If
'// Set the preview rate in milliseconds
Call capPreviewRate(hCapWnd, 66) '15 FPS

'// Start previewing the image from the camera
Call capPreview(hCapWnd, True)
'default to showing a preview each time
frmCaramaMain.mnuPreview.Checked = True

'// Resize the capture window to show the whole image
Call ResizeCaptureWindow(hCapWnd)
ConnectCapDriver = True
End Function
Public Function StatusProc(ByVal hCapWnd As Long, ByVal StatusCode As Long, ByVal lpStatusString As Long) As Long
Select Case StatusCode
Case 0 'this is recommended in docs
'when zero is sent, clear old status messages
'frmCaramaMain.Caption = App.Title
Case IDS_CAP_END ' Video Capture has finished
frmCaramaMain.Caption = App.Title
Case IDS_CAP_STAT_VIDEOAUDIO, IDS_CAP_STAT_VIDEOONLY
MsgBox LPSTRtoVBString(lpStatusString), vbInformation, App.Title
Case Else
'use this function if you need a real VB string
'frmCaramaMain.Caption = LPSTRtoVBString(lpStatusString)

'or, just pass the LPCSTR to a WINAPI function
Call SetWindowTextAsLong(frmCaramaMain.hWnd, lpStatusString)
End Select
Debug.Print "Driver returned code " & StatusCode & " to StatusProc"
StatusProc = -(True) '- converts Boolean to C BOOL
End Function

⑥ vb 制作摄像头视频拍照程序

以面代码是我以前用的,win7应该也支持你试试

Private Declare Function SendMessage Lib "USER32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function capCreateCaptureWindow Lib "avicap32.dll" Alias "capCreateCaptureWindowA" (ByVal lpszWindowName As String, ByVal dwStyle As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hwndParent As Long, ByVal nID As Long) As Long
Private Const GET_FRAME As Long = 1084
Private Const COPY As Long = 1054
Private Const CONNECT As Long = 1034
Private Const DISCONNECT As Long = 1035
Private CapHwnd As Long
Private Sub Command1_Click() '截图按钮
On Error Resume Next
SendMessage CapHwnd, GET_FRAME, 0, 0
SendMessage CapHwnd, COPY, 0, 0
Image2.Picture = Clipboard.GetData
Clipboard.Clear
End Sub
Private Sub Form_Load()
'打开摄像头
CapHwnd = capCreateCaptureWindow("WebcamCapture", 0, 0, 0, 320, 240, Me.hwnd, 0)
DoEvents
SendMessage CapHwnd, CONNECT, 0, 0
Timer1.Enabled = True
End Sub
Private Sub Form_Unload(Cancel As Integer)
'停止摄像头
DoEvents: SendMessage CapHwnd, DISCONNECT, 0, 0
Timer1.Enabled = False
End Sub
Private Sub Timer1_Timer() 'timer1.Interval=50
On Error Resume Next
SendMessage CapHwnd, GET_FRAME, 0, 0
SendMessage CapHwnd, COPY, 0, 0
Image1.Picture = Clipboard.GetData
Clipboard.Clear
End Sub
'
'Private Sub Timer2_Timer()
'Static z
'z = z + 1
'SavePicture Image1.Picture, "c:\1\" & z & ".BMP" ' 将图片保存到文件。
'
'End Sub

⑦ 我想问下，用vb编写一个后台打开摄像头的代码应该怎么写或者直接打开，不需要后台，该怎么编写希望

编写程序需要用到API，主要代码如下：

Private Declare Function capCreateCaptureWindow Lib "avicap32.dll" _
Alias "capCreateCaptureWindowA" ( _
ByVal lpszWindowName As String, _
ByVal dwStyle As Long, _
ByVal x As Long, _
ByVal y As Long, _
ByVal nWidth As Long, _
ByVal nHeight As Long, _
ByVal hWndParent As Long, _
ByVal nID As Long) As Long

Private Const WS_CHILD = &H40000000
Private Const WS_VISIBLE = &H10000000
Private Const WM_USER = &H400
Private Const WM_CAP_START = &H400
Private Const WM_CAP_EDIT_COPY = (WM_CAP_START + 30)
Private Const WM_CAP_DRIVER_CONNECT = (WM_CAP_START + 10)
Private Const WM_CAP_SET_PREVIEWRATE = (WM_CAP_START + 52)
Private Const WM_CAP_SET_OVERLAY = (WM_CAP_START + 51)
Private Const WM_CAP_SET_PREVIEW = (WM_CAP_START + 50)
Private Const WM_CAP_DRIVER_DISCONNECT = (WM_CAP_START + 11)

Private Preview_Handle As Long

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

Private Function CapturePicture(nCaptureHandle As Long) As StdPicture
Clipboard.Clear
SendMessage nCaptureHandle, WM_CAP_EDIT_COPY, 0, 0
Set CapturePicture = Clipboard.GetData
End Function

Private Sub Command1_Click()
SavePicture Picture1.Picture, "c:\a.bmp"
End Sub

Private Sub Command2_Click()
Picture1.Picture = CapturePicture(Preview_Handle)
End Sub

Private Sub Form_Load()
Preview_Handle = capCreateCaptureWindow("Video", WS_CHILD + WS_VISIBLE, 2, 2, 220, 156, Me.hwnd, 1)
SendMessage Preview_Handle, WM_CAP_DRIVER_CONNECT, 0, 0
SendMessage Preview_Handle, WM_CAP_SET_PREVIEWRATE, 1, 0
SendMessage Preview_Handle, WM_CAP_SET_PREVIEW, 1, 0
End Sub

Private Sub Form_Unload(Cancel As Integer)
SendMessage Preview_Handle, WM_CAP_DRIVER_DISCONNECT, 0, 0
End Sub

参考：http://blog.csdn.net/kalision/article/details/8057246

⑧ 有关用vb调摄像头的程序代码。真的看不懂~555……

代的代码没问题
把最后三行去掉
VB控制摄像头
Private Declare Function SendMessage Lib "USER32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function capCreateCaptureWindow Lib "avicap32.dll"
这三行

⑨ 求VB监控程序源代码（使用用摄像头）

摄像头源代码:
http://www.vbgood.com/viewthread.php?tid=49742&highlight=%C9%E3%CF%F1%CD%B7

⑩ 一个VB制作摄像头拍照的问题

Preview_Handle = capCreateCaptureWindow("Video", WS_CHILD + WS_VISIBLE, 2, 2, 320, 240, Me.hwnd, 1)

320.240改